glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {.$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {.$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {.$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     tfAlpha12,
 782     tfAlpha16,
 783
 784     tfLuminance4,
 785     tfLuminance8,
 786     tfLuminance12,
 787     tfLuminance16,
 788
 789     tfLuminance4Alpha4,
 790     tfLuminance6Alpha2,
 791     tfLuminance8Alpha8,
 792     tfLuminance12Alpha4,
 793     tfLuminance12Alpha12,
 794     tfLuminance16Alpha16,
 795
 796     tfR3G3B2,
 797     tfRGB4,
 798     tfR5G6B5,
 799     tfRGB5,
 800     tfRGB8,
 801     tfRGB10,
 802     tfRGB12,
 803     tfRGB16,
 804
 805     tfRGBA2,
 806     tfRGBA4,
 807     tfRGB5A1,
 808     tfRGBA8,
 809     tfRGB10A2,
 810     tfRGBA12,
 811     tfRGBA16,
 812
 813     tfBGR4,
 814     tfB5G6R5,
 815     tfBGR5,
 816     tfBGR8,
 817     tfBGR10,
 818     tfBGR12,
 819     tfBGR16,
 820
 821     tfBGRA2,
 822     tfBGRA4,
 823     tfBGR5A1,
 824     tfBGRA8,
 825     tfBGR10A2,
 826     tfBGRA12,
 827     tfBGRA16,
 828
 829     tfDepth16,
 830     tfDepth24,
 831     tfDepth32,
 832
 833     tfS3tcDtx1RGBA,
 834     tfS3tcDtx3RGBA,
 835     tfS3tcDtx5RGBA
 836   );
 837
 838   TglBitmapFileType = (
 839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 841      ftDDS,
 842      ftTGA,
 843      ftBMP);
 844    TglBitmapFileTypes = set of TglBitmapFileType;
 845
 846    TglBitmapMipMap = (
 847      mmNone,
 848      mmMipmap,
 849      mmMipmapGlu);
 850
 851    TglBitmapNormalMapFunc = (
 852      nm4Samples,
 853      nmSobel,
 854      nm3x3,
 855      nm5x5);
 856
 857  ////////////////////////////////////////////////////////////////////////////////////////////////////
 858    EglBitmap                  = class(Exception);
 859    EglBitmapNotSupported      = class(Exception);
 860    EglBitmapSizeToLarge       = class(EglBitmap);
 861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 862    EglBitmapUnsupportedFormat = class(EglBitmap)
 863    public
 864      constructor Create(const aFormat: TglBitmapFormat); overload;
 865      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 866    end;
 867
 868 ////////////////////////////////////////////////////////////////////////////////////////////////////
 869   TglBitmapColorRec = packed record
 870   case Integer of
 871     0: (r, g, b, a: Cardinal);
 872     1: (arr: array[0..3] of Cardinal);
 873   end;
 874
 875   TglBitmapPixelData = packed record
 876     Data, Range: TglBitmapColorRec;
 877     Format: TglBitmapFormat;
 878   end;
 879   PglBitmapPixelData = ^TglBitmapPixelData;
 880
 881 ////////////////////////////////////////////////////////////////////////////////////////////////////
 882   TglBitmapPixelPositionFields = set of (ffX, ffY);
 883   TglBitmapPixelPosition = record
 884     Fields : TglBitmapPixelPositionFields;
 885     X : Word;
 886     Y : Word;
 887   end;
 888
 889   TglBitmapFormatDescriptor = class(TObject)
 890   protected
 891     function GetIsCompressed: Boolean; virtual; abstract;
 892     function GetHasAlpha:     Boolean; virtual; abstract;
 893
 894     function GetglDataFormat:     GLenum;  virtual; abstract;
 895     function GetglFormat:         GLenum;  virtual; abstract;
 896     function GetglInternalFormat: GLenum;  virtual; abstract;
 897   public
 898     property IsCompressed: Boolean read GetIsCompressed;
 899     property HasAlpha:     Boolean read GetHasAlpha;
 900
 901     property glFormat:         GLenum  read GetglFormat;
 902     property glInternalFormat: GLenum  read GetglInternalFormat;
 903     property glDataFormat:     GLenum  read GetglDataFormat;
 904   end;
 905
 906 ////////////////////////////////////////////////////////////////////////////////////////////////////
 907   TglBitmap = class;
 908   TglBitmapFunctionRec = record
 909     Sender:   TglBitmap;
 910     Size:     TglBitmapPixelPosition;
 911     Position: TglBitmapPixelPosition;
 912     Source:   TglBitmapPixelData;
 913     Dest:     TglBitmapPixelData;
 914     Args:     Pointer;
 915   end;
 916   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 917
 918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 919   TglBitmap = class
 920   private
 921     function GetFormatDesc: TglBitmapFormatDescriptor;
 922   protected
 923     fID: GLuint;
 924     fTarget: GLuint;
 925     fAnisotropic: Integer;
 926     fDeleteTextureOnFree: Boolean;
 927     fFreeDataOnDestroy: Boolean;
 928     fFreeDataAfterGenTexture: Boolean;
 929     fData: PByte;
 930     fIsResident: Boolean;
 931     fBorderColor: array[0..3] of Single;
 932
 933     fDimension: TglBitmapPixelPosition;
 934     fMipMap: TglBitmapMipMap;
 935     fFormat: TglBitmapFormat;
 936
 937     // Mapping
 938     fPixelSize: Integer;
 939     fRowSize: Integer;
 940
 941     // Filtering
 942     fFilterMin: GLenum;
 943     fFilterMag: GLenum;
 944
 945     // TexturWarp
 946     fWrapS: GLenum;
 947     fWrapT: GLenum;
 948     fWrapR: GLenum;
 949
 950     //Swizzle
 951     fSwizzle: array[0..3] of GLenum;
 952
 953     // CustomData
 954     fFilename: String;
 955     fCustomName: String;
 956     fCustomNameW: WideString;
 957     fCustomData: Pointer;
 958
 959     //Getter
 960     function GetWidth:  Integer; virtual;
 961     function GetHeight: Integer; virtual;
 962
 963     function GetFileWidth:  Integer; virtual;
 964     function GetFileHeight: Integer; virtual;
 965
 966     //Setter
 967     procedure SetCustomData(const aValue: Pointer);
 968     procedure SetCustomName(const aValue: String);
 969     procedure SetCustomNameW(const aValue: WideString);
 970     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 971     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 972     procedure SetFormat(const aValue: TglBitmapFormat);
 973     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 974     procedure SetID(const aValue: Cardinal);
 975     procedure SetMipMap(const aValue: TglBitmapMipMap);
 976     procedure SetTarget(const aValue: Cardinal);
 977     procedure SetAnisotropic(const aValue: Integer);
 978
 979     procedure CreateID;
 980     procedure SetupParameters(out aBuildWithGlu: Boolean);
 981     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 982       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 983     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 984
 985     function FlipHorz: Boolean; virtual;
 986     function FlipVert: Boolean; virtual;
 987
 988     property Width:  Integer read GetWidth;
 989     property Height: Integer read GetHeight;
 990
 991     property FileWidth:  Integer read GetFileWidth;
 992     property FileHeight: Integer read GetFileHeight;
 993   public
 994     //Properties
 995     property ID:           Cardinal        read fID          write SetID;
 996     property Target:       Cardinal        read fTarget      write SetTarget;
 997     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 998     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 999     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1000
1001     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1002
1003     property Filename:    String     read fFilename;
1004     property CustomName:  String     read fCustomName  write SetCustomName;
1005     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1006     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1007
1008     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1009     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1010     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1011
1012     property Dimension:  TglBitmapPixelPosition  read fDimension;
1013     property Data:       PByte                   read fData;
1014     property IsResident: Boolean                 read fIsResident;
1015
1016     procedure AfterConstruction; override;
1017     procedure BeforeDestruction; override;
1018
1019     procedure PrepareResType(var aResource: String; var aResType: PChar);
1020
1021     //Load
1022     procedure LoadFromFile(const aFilename: String);
1023     procedure LoadFromStream(const aStream: TStream); virtual;
1024     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1025       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1026     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1027     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1028
1029     //Save
1030     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1031     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1032
1033     //Convert
1034     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1035     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1036       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1037   public
1038     //Alpha & Co
1039     {$IFDEF GLB_SDL}
1040     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1041     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1042     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1043     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1044       const aArgs: Pointer = nil): Boolean;
1045     {$ENDIF}
1046
1047     {$IFDEF GLB_DELPHI}
1048     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1049     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1050     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1051     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1052       const aArgs: Pointer = nil): Boolean;
1053     {$ENDIF}
1054
1055     {$IFDEF GLB_LAZARUS}
1056     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1057     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1058     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1059     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1060       const aArgs: Pointer = nil): Boolean;
1061     {$ENDIF}
1062
1063     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1064       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1065     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1066       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067
1068     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1069     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1070     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1071     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1072
1073     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1074     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1075     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1076
1077     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1078     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1079     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1080
1081     function RemoveAlpha: Boolean; virtual;
1082   public
1083     //Common
1084     function Clone: TglBitmap;
1085     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1086     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1087     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1088     procedure FreeData;
1089
1090     //ColorFill
1091     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1092     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1093     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1094
1095     //TexParameters
1096     procedure SetFilter(const aMin, aMag: GLenum);
1097     procedure SetWrap(
1098       const S: GLenum = GL_CLAMP_TO_EDGE;
1099       const T: GLenum = GL_CLAMP_TO_EDGE;
1100       const R: GLenum = GL_CLAMP_TO_EDGE);
1101     procedure SetSwizzle(const r, g, b, a: GLenum);
1102
1103     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1104     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1105
1106     //Constructors
1107     constructor Create; overload;
1108     constructor Create(const aFileName: String); overload;
1109     constructor Create(const aStream: TStream); overload;
1110     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1111     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1112     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1113     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1114   private
1115     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1116     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1117
1118     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1119     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1120
1121     function LoadBMP(const aStream: TStream): Boolean; virtual;
1122     procedure SaveBMP(const aStream: TStream); virtual;
1123
1124     function LoadTGA(const aStream: TStream): Boolean; virtual;
1125     procedure SaveTGA(const aStream: TStream); virtual;
1126
1127     function LoadDDS(const aStream: TStream): Boolean; virtual;
1128     procedure SaveDDS(const aStream: TStream); virtual;
1129   end;
1130
1131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1132   TglBitmap1D = class(TglBitmap)
1133   protected
1134     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1135       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1136     procedure UploadData(const aBuildWithGlu: Boolean);
1137   public
1138     property Width;
1139     procedure AfterConstruction; override;
1140     function FlipHorz: Boolean; override;
1141     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1142   end;
1143
1144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1145   TglBitmap2D = class(TglBitmap)
1146   protected
1147     fLines: array of PByte;
1148     function GetScanline(const aIndex: Integer): Pointer;
1149     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1150       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1151     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1152   public
1153     property Width;
1154     property Height;
1155     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1156
1157     procedure AfterConstruction; override;
1158
1159     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1160     procedure GetDataFromTexture;
1161     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1162
1163     function FlipHorz: Boolean; override;
1164     function FlipVert: Boolean; override;
1165
1166     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1167       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1168   end;
1169
1170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1171   TglBitmapCubeMap = class(TglBitmap2D)
1172   protected
1173     fGenMode: Integer;
1174     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1175   public
1176     procedure AfterConstruction; override;
1177     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1178     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1179     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1180   end;
1181
1182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1183   TglBitmapNormalMap = class(TglBitmapCubeMap)
1184   public
1185     procedure AfterConstruction; override;
1186     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1187   end;
1188
1189 const
1190   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1191
1192 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1193 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1194 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1195 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1196 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1197 procedure glBitmapSetDefaultWrap(
1198   const S: Cardinal = GL_CLAMP_TO_EDGE;
1199   const T: Cardinal = GL_CLAMP_TO_EDGE;
1200   const R: Cardinal = GL_CLAMP_TO_EDGE);
1201
1202 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1203 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1204 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1205 function glBitmapGetDefaultFormat: TglBitmapFormat;
1206 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1207 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1208
1209 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1210 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1211 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1212
1213 var
1214   glBitmapDefaultDeleteTextureOnFree: Boolean;
1215   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1216   glBitmapDefaultFormat: TglBitmapFormat;
1217   glBitmapDefaultMipmap: TglBitmapMipMap;
1218   glBitmapDefaultFilterMin: Cardinal;
1219   glBitmapDefaultFilterMag: Cardinal;
1220   glBitmapDefaultWrapS: Cardinal;
1221   glBitmapDefaultWrapT: Cardinal;
1222   glBitmapDefaultWrapR: Cardinal;
1223   glDefaultSwizzle: array[0..3] of GLenum;
1224
1225 {$IFDEF GLB_DELPHI}
1226 function CreateGrayPalette: HPALETTE;
1227 {$ENDIF}
1228
1229 implementation
1230
1231 uses
1232   Math, syncobjs, typinfo
1233   {$IFDEF GLB_DELPHI}, Types{$ENDIF};
1234
1235 type
1236 {$IFNDEF fpc}
1237   QWord   = System.UInt64;
1238   PQWord  = ^QWord;
1239
1240   PtrInt  = Longint;
1241   PtrUInt = DWord;
1242 {$ENDIF}
1243
1244 ////////////////////////////////////////////////////////////////////////////////////////////////////
1245   TShiftRec = packed record
1246   case Integer of
1247     0: (r, g, b, a: Byte);
1248     1: (arr: array[0..3] of Byte);
1249   end;
1250
1251   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1252   private
1253     function GetRedMask: QWord;
1254     function GetGreenMask: QWord;
1255     function GetBlueMask: QWord;
1256     function GetAlphaMask: QWord;
1257   protected
1258     fFormat: TglBitmapFormat;
1259     fWithAlpha: TglBitmapFormat;
1260     fWithoutAlpha: TglBitmapFormat;
1261     fRGBInverted: TglBitmapFormat;
1262     fUncompressed: TglBitmapFormat;
1263     fPixelSize: Single;
1264     fIsCompressed: Boolean;
1265
1266     fRange: TglBitmapColorRec;
1267     fShift: TShiftRec;
1268
1269     fglFormat:         GLenum;
1270     fglInternalFormat: GLenum;
1271     fglDataFormat:     GLenum;
1272
1273     function GetIsCompressed: Boolean; override;
1274     function GetHasAlpha: Boolean; override;
1275
1276     function GetglFormat: GLenum; override;
1277     function GetglInternalFormat: GLenum; override;
1278     function GetglDataFormat: GLenum; override;
1279
1280     function GetComponents: Integer; virtual;
1281   public
1282     property Format:       TglBitmapFormat read fFormat;
1283     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1284     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1285     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1286     property Components:   Integer         read GetComponents;
1287     property PixelSize:    Single          read fPixelSize;
1288
1289     property Range: TglBitmapColorRec read fRange;
1290     property Shift: TShiftRec         read fShift;
1291
1292     property RedMask:   QWord read GetRedMask;
1293     property GreenMask: QWord read GetGreenMask;
1294     property BlueMask:  QWord read GetBlueMask;
1295     property AlphaMask: QWord read GetAlphaMask;
1296
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1299
1300     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1301     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1302
1303     function CreateMappingData: Pointer; virtual;
1304     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1305
1306     function IsEmpty:  Boolean; virtual;
1307     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1308
1309     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1310
1311     constructor Create; virtual;
1312   public
1313     class procedure Init;
1314     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1315     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1316     class procedure Clear;
1317     class procedure Finalize;
1318   end;
1319   TFormatDescriptorClass = class of TFormatDescriptor;
1320
1321   TfdEmpty = class(TFormatDescriptor);
1322
1323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1324   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327     constructor Create; override;
1328   end;
1329
1330   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333     constructor Create; override;
1334   end;
1335
1336   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1337     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1338     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1339     constructor Create; override;
1340   end;
1341
1342   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1343     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1344     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1345     constructor Create; override;
1346   end;
1347
1348   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1349     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1350     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1351     constructor Create; override;
1352   end;
1353
1354   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357     constructor Create; override;
1358   end;
1359
1360   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363     constructor Create; override;
1364   end;
1365
1366   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369     constructor Create; override;
1370   end;
1371
1372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1373   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376     constructor Create; override;
1377   end;
1378
1379   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382     constructor Create; override;
1383   end;
1384
1385   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388     constructor Create; override;
1389   end;
1390
1391   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394     constructor Create; override;
1395   end;
1396
1397   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400     constructor Create; override;
1401   end;
1402
1403   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1404     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1405     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1406     constructor Create; override;
1407   end;
1408
1409   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1410     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1411     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1412     constructor Create; override;
1413   end;
1414
1415   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1416     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1417     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1418     constructor Create; override;
1419   end;
1420
1421   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1422     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1423     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1424     constructor Create; override;
1425   end;
1426
1427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1428   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431     constructor Create; override;
1432   end;
1433
1434   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1435     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1436     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1437     constructor Create; override;
1438   end;
1439
1440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1441   TfdAlpha4 = class(TfdAlpha_UB1)
1442     constructor Create; override;
1443   end;
1444
1445   TfdAlpha8 = class(TfdAlpha_UB1)
1446     constructor Create; override;
1447   end;
1448
1449   TfdAlpha12 = class(TfdAlpha_US1)
1450     constructor Create; override;
1451   end;
1452
1453   TfdAlpha16 = class(TfdAlpha_US1)
1454     constructor Create; override;
1455   end;
1456
1457   TfdLuminance4 = class(TfdLuminance_UB1)
1458     constructor Create; override;
1459   end;
1460
1461   TfdLuminance8 = class(TfdLuminance_UB1)
1462     constructor Create; override;
1463   end;
1464
1465   TfdLuminance12 = class(TfdLuminance_US1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdLuminance16 = class(TfdLuminance_US1)
1470     constructor Create; override;
1471   end;
1472
1473   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1474     constructor Create; override;
1475   end;
1476
1477   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1478     constructor Create; override;
1479   end;
1480
1481   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1482     constructor Create; override;
1483   end;
1484
1485   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1486     constructor Create; override;
1487   end;
1488
1489   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1490     constructor Create; override;
1491   end;
1492
1493   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1494     constructor Create; override;
1495   end;
1496
1497   TfdR3G3B2 = class(TfdUniversal_UB1)
1498     constructor Create; override;
1499   end;
1500
1501   TfdRGB4 = class(TfdUniversal_US1)
1502     constructor Create; override;
1503   end;
1504
1505   TfdR5G6B5 = class(TfdUniversal_US1)
1506     constructor Create; override;
1507   end;
1508
1509   TfdRGB5 = class(TfdUniversal_US1)
1510     constructor Create; override;
1511   end;
1512
1513   TfdRGB8 = class(TfdRGB_UB3)
1514     constructor Create; override;
1515   end;
1516
1517   TfdRGB10 = class(TfdUniversal_UI1)
1518     constructor Create; override;
1519   end;
1520
1521   TfdRGB12 = class(TfdRGB_US3)
1522     constructor Create; override;
1523   end;
1524
1525   TfdRGB16 = class(TfdRGB_US3)
1526     constructor Create; override;
1527   end;
1528
1529   TfdRGBA2 = class(TfdRGBA_UB4)
1530     constructor Create; override;
1531   end;
1532
1533   TfdRGBA4 = class(TfdUniversal_US1)
1534     constructor Create; override;
1535   end;
1536
1537   TfdRGB5A1 = class(TfdUniversal_US1)
1538     constructor Create; override;
1539   end;
1540
1541   TfdRGBA8 = class(TfdRGBA_UB4)
1542     constructor Create; override;
1543   end;
1544
1545   TfdRGB10A2 = class(TfdUniversal_UI1)
1546     constructor Create; override;
1547   end;
1548
1549   TfdRGBA12 = class(TfdRGBA_US4)
1550     constructor Create; override;
1551   end;
1552
1553   TfdRGBA16 = class(TfdRGBA_US4)
1554     constructor Create; override;
1555   end;
1556
1557   TfdBGR4 = class(TfdUniversal_US1)
1558     constructor Create; override;
1559   end;
1560
1561   TfdB5G6R5 = class(TfdUniversal_US1)
1562     constructor Create; override;
1563   end;
1564
1565   TfdBGR5 = class(TfdUniversal_US1)
1566     constructor Create; override;
1567   end;
1568
1569   TfdBGR8 = class(TfdBGR_UB3)
1570     constructor Create; override;
1571   end;
1572
1573   TfdBGR10 = class(TfdUniversal_UI1)
1574     constructor Create; override;
1575   end;
1576
1577   TfdBGR12 = class(TfdBGR_US3)
1578     constructor Create; override;
1579   end;
1580
1581   TfdBGR16 = class(TfdBGR_US3)
1582     constructor Create; override;
1583   end;
1584
1585   TfdBGRA2 = class(TfdBGRA_UB4)
1586     constructor Create; override;
1587   end;
1588
1589   TfdBGRA4 = class(TfdUniversal_US1)
1590     constructor Create; override;
1591   end;
1592
1593   TfdBGR5A1 = class(TfdUniversal_US1)
1594     constructor Create; override;
1595   end;
1596
1597   TfdBGRA8 = class(TfdBGRA_UB4)
1598     constructor Create; override;
1599   end;
1600
1601   TfdBGR10A2 = class(TfdUniversal_UI1)
1602     constructor Create; override;
1603   end;
1604
1605   TfdBGRA12 = class(TfdBGRA_US4)
1606     constructor Create; override;
1607   end;
1608
1609   TfdBGRA16 = class(TfdBGRA_US4)
1610     constructor Create; override;
1611   end;
1612
1613   TfdDepth16 = class(TfdDepth_US1)
1614     constructor Create; override;
1615   end;
1616
1617   TfdDepth24 = class(TfdDepth_UI1)
1618     constructor Create; override;
1619   end;
1620
1621   TfdDepth32 = class(TfdDepth_UI1)
1622     constructor Create; override;
1623   end;
1624
1625   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1626     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1627     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1628     constructor Create; override;
1629   end;
1630
1631   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1632     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1633     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1634     constructor Create; override;
1635   end;
1636
1637   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1638     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1639     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1640     constructor Create; override;
1641   end;
1642
1643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1644   TbmpBitfieldFormat = class(TFormatDescriptor)
1645   private
1646     procedure SetRedMask  (const aValue: QWord);
1647     procedure SetGreenMask(const aValue: QWord);
1648     procedure SetBlueMask (const aValue: QWord);
1649     procedure SetAlphaMask(const aValue: QWord);
1650
1651     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1652   public
1653     property RedMask:   QWord read GetRedMask   write SetRedMask;
1654     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1655     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1656     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1657
1658     property PixelSize: Single read fPixelSize write fPixelSize;
1659
1660     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1661     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1662   end;
1663
1664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1665   TbmpColorTableEnty = packed record
1666     b, g, r, a: Byte;
1667   end;
1668   TbmpColorTable = array of TbmpColorTableEnty;
1669   TbmpColorTableFormat = class(TFormatDescriptor)
1670   private
1671     fColorTable: TbmpColorTable;
1672   public
1673     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1674     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1675     property Range:      TglBitmapColorRec read fRange      write fRange;
1676     property Shift:      TShiftRec         read fShift      write fShift;
1677     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1678
1679     procedure CreateColorTable;
1680
1681     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1682     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1683     destructor Destroy; override;
1684   end;
1685
1686 const
1687   LUMINANCE_WEIGHT_R = 0.30;
1688   LUMINANCE_WEIGHT_G = 0.59;
1689   LUMINANCE_WEIGHT_B = 0.11;
1690
1691   ALPHA_WEIGHT_R = 0.30;
1692   ALPHA_WEIGHT_G = 0.59;
1693   ALPHA_WEIGHT_B = 0.11;
1694
1695   DEPTH_WEIGHT_R = 0.333333333;
1696   DEPTH_WEIGHT_G = 0.333333333;
1697   DEPTH_WEIGHT_B = 0.333333333;
1698
1699   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1700
1701   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1702     TfdEmpty,
1703
1704     TfdAlpha4,
1705     TfdAlpha8,
1706     TfdAlpha12,
1707     TfdAlpha16,
1708
1709     TfdLuminance4,
1710     TfdLuminance8,
1711     TfdLuminance12,
1712     TfdLuminance16,
1713
1714     TfdLuminance4Alpha4,
1715     TfdLuminance6Alpha2,
1716     TfdLuminance8Alpha8,
1717     TfdLuminance12Alpha4,
1718     TfdLuminance12Alpha12,
1719     TfdLuminance16Alpha16,
1720
1721     TfdR3G3B2,
1722     TfdRGB4,
1723     TfdR5G6B5,
1724     TfdRGB5,
1725     TfdRGB8,
1726     TfdRGB10,
1727     TfdRGB12,
1728     TfdRGB16,
1729
1730     TfdRGBA2,
1731     TfdRGBA4,
1732     TfdRGB5A1,
1733     TfdRGBA8,
1734     TfdRGB10A2,
1735     TfdRGBA12,
1736     TfdRGBA16,
1737
1738     TfdBGR4,
1739     TfdB5G6R5,
1740     TfdBGR5,
1741     TfdBGR8,
1742     TfdBGR10,
1743     TfdBGR12,
1744     TfdBGR16,
1745
1746     TfdBGRA2,
1747     TfdBGRA4,
1748     TfdBGR5A1,
1749     TfdBGRA8,
1750     TfdBGR10A2,
1751     TfdBGRA12,
1752     TfdBGRA16,
1753
1754     TfdDepth16,
1755     TfdDepth24,
1756     TfdDepth32,
1757
1758     TfdS3tcDtx1RGBA,
1759     TfdS3tcDtx3RGBA,
1760     TfdS3tcDtx5RGBA
1761   );
1762
1763 var
1764   FormatDescriptorCS: TCriticalSection;
1765   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1766
1767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1768 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1769 begin
1770   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1771 end;
1772
1773 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1775 begin
1776   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1777 end;
1778
1779 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1780 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1781 begin
1782   result.Fields := [];
1783
1784   if X >= 0 then
1785     result.Fields := result.Fields + [ffX];
1786   if Y >= 0 then
1787     result.Fields := result.Fields + [ffY];
1788
1789   result.X := Max(0, X);
1790   result.Y := Max(0, Y);
1791 end;
1792
1793 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1794 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1795 begin
1796   result.r := r;
1797   result.g := g;
1798   result.b := b;
1799   result.a := a;
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1804 var
1805   i: Integer;
1806 begin
1807   result := false;
1808   for i := 0 to high(r1.arr) do
1809     if (r1.arr[i] <> r2.arr[i]) then
1810       exit;
1811   result := true;
1812 end;
1813
1814 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1815 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1816 begin
1817   result.r := r;
1818   result.g := g;
1819   result.b := b;
1820   result.a := a;
1821 end;
1822
1823 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1824 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1825 begin
1826   result := [];
1827
1828   if (aFormat in [
1829         //4 bbp
1830         tfLuminance4,
1831
1832         //8bpp
1833         tfR3G3B2, tfLuminance8,
1834
1835         //16bpp
1836         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1837         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1838
1839         //24bpp
1840         tfBGR8, tfRGB8,
1841
1842         //32bpp
1843         tfRGB10, tfRGB10A2, tfRGBA8,
1844         tfBGR10, tfBGR10A2, tfBGRA8]) then
1845     result := result + [ftBMP];
1846
1847   if (aFormat in [
1848         //8 bpp
1849         tfLuminance8, tfAlpha8,
1850
1851         //16 bpp
1852         tfLuminance16, tfLuminance8Alpha8,
1853         tfRGB5, tfRGB5A1, tfRGBA4,
1854         tfBGR5, tfBGR5A1, tfBGRA4,
1855
1856         //24 bpp
1857         tfRGB8, tfBGR8,
1858
1859         //32 bpp
1860         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1861     result := result + [ftTGA];
1862
1863   if (aFormat in [
1864         //8 bpp
1865         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1866         tfR3G3B2, tfRGBA2, tfBGRA2,
1867
1868         //16 bpp
1869         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1870         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1871         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1872
1873         //24 bpp
1874         tfRGB8, tfBGR8,
1875
1876         //32 bbp
1877         tfLuminance16Alpha16,
1878         tfRGBA8, tfRGB10A2,
1879         tfBGRA8, tfBGR10A2,
1880
1881         //compressed
1882         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1883     result := result + [ftDDS];
1884
1885   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1886   if aFormat in [
1887       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1888       tfRGB8, tfRGBA8,
1889       tfBGR8, tfBGRA8] then
1890     result := result + [ftPNG];
1891   {$ENDIF}
1892
1893   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1894   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1895     result := result + [ftJPEG];
1896   {$ENDIF}
1897 end;
1898
1899 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1900 function IsPowerOfTwo(aNumber: Integer): Boolean;
1901 begin
1902   while (aNumber and 1) = 0 do
1903     aNumber := aNumber shr 1;
1904   result := aNumber = 1;
1905 end;
1906
1907 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1908 function GetTopMostBit(aBitSet: QWord): Integer;
1909 begin
1910   result := 0;
1911   while aBitSet > 0 do begin
1912     inc(result);
1913     aBitSet := aBitSet shr 1;
1914   end;
1915 end;
1916
1917 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1918 function CountSetBits(aBitSet: QWord): Integer;
1919 begin
1920   result := 0;
1921   while aBitSet > 0 do begin
1922     if (aBitSet and 1) = 1 then
1923       inc(result);
1924     aBitSet := aBitSet shr 1;
1925   end;
1926 end;
1927
1928 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1929 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1930 begin
1931   result := Trunc(
1932     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1933     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1934     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1935 end;
1936
1937 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1938 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1939 begin
1940   result := Trunc(
1941     DEPTH_WEIGHT_R * aPixel.Data.r +
1942     DEPTH_WEIGHT_G * aPixel.Data.g +
1943     DEPTH_WEIGHT_B * aPixel.Data.b);
1944 end;
1945
1946 {$IFDEF GLB_NATIVE_OGL}
1947 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1948 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1950 var
1951   GL_LibHandle: Pointer = nil;
1952
1953 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1954 begin
1955   if not Assigned(aLibHandle) then
1956     aLibHandle := GL_LibHandle;
1957
1958 {$IF DEFINED(GLB_WIN)}
1959   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1960   if Assigned(result) then
1961     exit;
1962
1963   if Assigned(wglGetProcAddress) then
1964     result := wglGetProcAddress(aProcName);
1965 {$ELSEIF DEFINED(GLB_LINUX)}
1966   if Assigned(glXGetProcAddress) then begin
1967     result := glXGetProcAddress(aProcName);
1968     if Assigned(result) then
1969       exit;
1970   end;
1971
1972   if Assigned(glXGetProcAddressARB) then begin
1973     result := glXGetProcAddressARB(aProcName);
1974     if Assigned(result) then
1975       exit;
1976   end;
1977
1978   result := dlsym(aLibHandle, aProcName);
1979 {$IFEND}
1980   if not Assigned(result) and aRaiseOnErr then
1981     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1982 end;
1983
1984 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1985 var
1986   GLU_LibHandle: Pointer = nil;
1987   OpenGLInitialized: Boolean;
1988   InitOpenGLCS: TCriticalSection;
1989
1990 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1991 procedure glbInitOpenGL;
1992
1993   ////////////////////////////////////////////////////////////////////////////////
1994   function glbLoadLibrary(const aName: PChar): Pointer;
1995   begin
1996     {$IF DEFINED(GLB_WIN)}
1997     result := {%H-}Pointer(LoadLibrary(aName));
1998     {$ELSEIF DEFINED(GLB_LINUX)}
1999     result := dlopen(Name, RTLD_LAZY);
2000     {$ELSE}
2001     result := nil;
2002     {$IFEND}
2003   end;
2004
2005   ////////////////////////////////////////////////////////////////////////////////
2006   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2007   begin
2008     result := false;
2009     if not Assigned(aLibHandle) then
2010       exit;
2011
2012     {$IF DEFINED(GLB_WIN)}
2013     Result := FreeLibrary({%H-}HINST(aLibHandle));
2014     {$ELSEIF DEFINED(GLB_LINUX)}
2015     Result := dlclose(aLibHandle) = 0;
2016     {$IFEND}
2017   end;
2018
2019 begin
2020   if Assigned(GL_LibHandle) then
2021     glbFreeLibrary(GL_LibHandle);
2022
2023   if Assigned(GLU_LibHandle) then
2024     glbFreeLibrary(GLU_LibHandle);
2025
2026   GL_LibHandle := glbLoadLibrary(libopengl);
2027   if not Assigned(GL_LibHandle) then
2028     raise EglBitmap.Create('unable to load library: ' + libopengl);
2029
2030   GLU_LibHandle := glbLoadLibrary(libglu);
2031   if not Assigned(GLU_LibHandle) then
2032     raise EglBitmap.Create('unable to load library: ' + libglu);
2033
2034 {$IF DEFINED(GLB_WIN)}
2035   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2036 {$ELSEIF DEFINED(GLB_LINUX)}
2037   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2038   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2039 {$IFEND}
2040
2041   glEnable := glbGetProcAddress('glEnable');
2042   glDisable := glbGetProcAddress('glDisable');
2043   glGetString := glbGetProcAddress('glGetString');
2044   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2045   glTexParameteri := glbGetProcAddress('glTexParameteri');
2046   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2047   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2048   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2049   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2050   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2051   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2052   glTexGeni := glbGetProcAddress('glTexGeni');
2053   glGenTextures := glbGetProcAddress('glGenTextures');
2054   glBindTexture := glbGetProcAddress('glBindTexture');
2055   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2056   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2057   glReadPixels := glbGetProcAddress('glReadPixels');
2058   glPixelStorei := glbGetProcAddress('glPixelStorei');
2059   glTexImage1D := glbGetProcAddress('glTexImage1D');
2060   glTexImage2D := glbGetProcAddress('glTexImage2D');
2061   glGetTexImage := glbGetProcAddress('glGetTexImage');
2062
2063   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2064   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2065 end;
2066 {$ENDIF}
2067
2068 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 procedure glbReadOpenGLExtensions;
2070 var
2071   Buffer: AnsiString;
2072   MajorVersion, MinorVersion: Integer;
2073
2074   ///////////////////////////////////////////////////////////////////////////////////////////
2075   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2076   var
2077     Separator: Integer;
2078   begin
2079     aMinor := 0;
2080     aMajor := 0;
2081
2082     Separator := Pos(AnsiString('.'), aBuffer);
2083     if (Separator > 1) and (Separator < Length(aBuffer)) and
2084        (aBuffer[Separator - 1] in ['0'..'9']) and
2085        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2086
2087       Dec(Separator);
2088       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2089         Dec(Separator);
2090
2091       Delete(aBuffer, 1, Separator);
2092       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2093
2094       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2095         Inc(Separator);
2096
2097       Delete(aBuffer, Separator, 255);
2098       Separator := Pos(AnsiString('.'), aBuffer);
2099
2100       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2101       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2102     end;
2103   end;
2104
2105   ///////////////////////////////////////////////////////////////////////////////////////////
2106   function CheckExtension(const Extension: AnsiString): Boolean;
2107   var
2108     ExtPos: Integer;
2109   begin
2110     ExtPos := Pos(Extension, Buffer);
2111     result := ExtPos > 0;
2112     if result then
2113       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2114   end;
2115
2116   ///////////////////////////////////////////////////////////////////////////////////////////
2117   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2118   begin
2119     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2120   end;
2121
2122 begin
2123 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2124   InitOpenGLCS.Enter;
2125   try
2126     if not OpenGLInitialized then begin
2127       glbInitOpenGL;
2128       OpenGLInitialized := true;
2129     end;
2130   finally
2131     InitOpenGLCS.Leave;
2132   end;
2133 {$ENDIF}
2134
2135   // Version
2136   Buffer := glGetString(GL_VERSION);
2137   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2138
2139   GL_VERSION_1_2 := CheckVersion(1, 2);
2140   GL_VERSION_1_3 := CheckVersion(1, 3);
2141   GL_VERSION_1_4 := CheckVersion(1, 4);
2142   GL_VERSION_2_0 := CheckVersion(2, 0);
2143   GL_VERSION_3_3 := CheckVersion(3, 3);
2144
2145   // Extensions
2146   Buffer := glGetString(GL_EXTENSIONS);
2147   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2148   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2149   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2150   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2151   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2152   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2153   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2154   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2155   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2156   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2157   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2158   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2159   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2160   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2161
2162   if GL_VERSION_1_3 then begin
2163     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2164     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2165     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2166   end else begin
2167     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2168     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2169     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2170   end;
2171 end;
2172 {$ENDIF}
2173
2174 {$IFDEF GLB_SDL_IMAGE}
2175 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2176 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2177 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2178 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2179 begin
2180   result := TStream(context^.unknown.data1).Seek(offset, whence);
2181 end;
2182
2183 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2184 begin
2185   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2186 end;
2187
2188 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2189 begin
2190   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2191 end;
2192
2193 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2194 begin
2195   result := 0;
2196 end;
2197
2198 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2199 begin
2200   result := SDL_AllocRW;
2201
2202   if result = nil then
2203     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2204
2205   result^.seek := glBitmapRWseek;
2206   result^.read := glBitmapRWread;
2207   result^.write := glBitmapRWwrite;
2208   result^.close := glBitmapRWclose;
2209   result^.unknown.data1 := Stream;
2210 end;
2211 {$ENDIF}
2212
2213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2214 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2215 begin
2216   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2217 end;
2218
2219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2221 begin
2222   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2223 end;
2224
2225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2226 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2227 begin
2228   glBitmapDefaultMipmap := aValue;
2229 end;
2230
2231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2232 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2233 begin
2234   glBitmapDefaultFormat := aFormat;
2235 end;
2236
2237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2238 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2239 begin
2240   glBitmapDefaultFilterMin := aMin;
2241   glBitmapDefaultFilterMag := aMag;
2242 end;
2243
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2246 begin
2247   glBitmapDefaultWrapS := S;
2248   glBitmapDefaultWrapT := T;
2249   glBitmapDefaultWrapR := R;
2250 end;
2251
2252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2254 begin
2255   glDefaultSwizzle[0] := r;
2256   glDefaultSwizzle[1] := g;
2257   glDefaultSwizzle[2] := b;
2258   glDefaultSwizzle[3] := a;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2263 begin
2264   result := glBitmapDefaultDeleteTextureOnFree;
2265 end;
2266
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2269 begin
2270   result := glBitmapDefaultFreeDataAfterGenTextures;
2271 end;
2272
2273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2274 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2275 begin
2276   result := glBitmapDefaultMipmap;
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 function glBitmapGetDefaultFormat: TglBitmapFormat;
2281 begin
2282   result := glBitmapDefaultFormat;
2283 end;
2284
2285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2286 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2287 begin
2288   aMin := glBitmapDefaultFilterMin;
2289   aMag := glBitmapDefaultFilterMag;
2290 end;
2291
2292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2293 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2294 begin
2295   S := glBitmapDefaultWrapS;
2296   T := glBitmapDefaultWrapT;
2297   R := glBitmapDefaultWrapR;
2298 end;
2299
2300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2301 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2302 begin
2303   r := glDefaultSwizzle[0];
2304   g := glDefaultSwizzle[1];
2305   b := glDefaultSwizzle[2];
2306   a := glDefaultSwizzle[3];
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 function TFormatDescriptor.GetRedMask: QWord;
2313 begin
2314   result := fRange.r shl fShift.r;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function TFormatDescriptor.GetGreenMask: QWord;
2319 begin
2320   result := fRange.g shl fShift.g;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function TFormatDescriptor.GetBlueMask: QWord;
2325 begin
2326   result := fRange.b shl fShift.b;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function TFormatDescriptor.GetAlphaMask: QWord;
2331 begin
2332   result := fRange.a shl fShift.a;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function TFormatDescriptor.GetIsCompressed: Boolean;
2337 begin
2338   result := fIsCompressed;
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 function TFormatDescriptor.GetHasAlpha: Boolean;
2343 begin
2344   result := (fRange.a > 0);
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 function TFormatDescriptor.GetglFormat: GLenum;
2349 begin
2350   result := fglFormat;
2351 end;
2352
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 function TFormatDescriptor.GetglInternalFormat: GLenum;
2355 begin
2356   result := fglInternalFormat;
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 function TFormatDescriptor.GetglDataFormat: GLenum;
2361 begin
2362   result := fglDataFormat;
2363 end;
2364
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 function TFormatDescriptor.GetComponents: Integer;
2367 var
2368   i: Integer;
2369 begin
2370   result := 0;
2371   for i := 0 to 3 do
2372     if (fRange.arr[i] > 0) then
2373       inc(result);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2378 var
2379   w, h: Integer;
2380 begin
2381   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2382     w := Max(1, aSize.X);
2383     h := Max(1, aSize.Y);
2384     result := GetSize(w, h);
2385   end else
2386     result := 0;
2387 end;
2388
2389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2390 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2391 begin
2392   result := 0;
2393   if (aWidth <= 0) or (aHeight <= 0) then
2394     exit;
2395   result := Ceil(aWidth * aHeight * fPixelSize);
2396 end;
2397
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 function TFormatDescriptor.CreateMappingData: Pointer;
2400 begin
2401   result := nil;
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2406 begin
2407   //DUMMY
2408 end;
2409
2410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2411 function TFormatDescriptor.IsEmpty: Boolean;
2412 begin
2413   result := (fFormat = tfEmpty);
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2418 begin
2419   result := false;
2420   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2421     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2422   if (aRedMask   <> RedMask) then
2423     exit;
2424   if (aGreenMask <> GreenMask) then
2425     exit;
2426   if (aBlueMask  <> BlueMask) then
2427     exit;
2428   if (aAlphaMask <> AlphaMask) then
2429     exit;
2430   result := true;
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2435 begin
2436   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2437   aPixel.Data   := fRange;
2438   aPixel.Range  := fRange;
2439   aPixel.Format := fFormat;
2440 end;
2441
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 constructor TFormatDescriptor.Create;
2444 begin
2445   inherited Create;
2446
2447   fFormat       := tfEmpty;
2448   fWithAlpha    := tfEmpty;
2449   fWithoutAlpha := tfEmpty;
2450   fRGBInverted  := tfEmpty;
2451   fUncompressed := tfEmpty;
2452   fPixelSize    := 0.0;
2453   fIsCompressed := false;
2454
2455   fglFormat         := 0;
2456   fglInternalFormat := 0;
2457   fglDataFormat     := 0;
2458
2459   FillChar(fRange, 0, SizeOf(fRange));
2460   FillChar(fShift, 0, SizeOf(fShift));
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2467 begin
2468   aData^ := aPixel.Data.a;
2469   inc(aData);
2470 end;
2471
2472 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2473 begin
2474   aPixel.Data.r := 0;
2475   aPixel.Data.g := 0;
2476   aPixel.Data.b := 0;
2477   aPixel.Data.a := aData^;
2478   inc(aData);
2479 end;
2480
2481 constructor TfdAlpha_UB1.Create;
2482 begin
2483   inherited Create;
2484   fPixelSize        := 1.0;
2485   fRange.a          := $FF;
2486   fglFormat         := GL_ALPHA;
2487   fglDataFormat     := GL_UNSIGNED_BYTE;
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2494 begin
2495   aData^ := LuminanceWeight(aPixel);
2496   inc(aData);
2497 end;
2498
2499 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.r := aData^;
2502   aPixel.Data.g := aData^;
2503   aPixel.Data.b := aData^;
2504   aPixel.Data.a := 0;
2505   inc(aData);
2506 end;
2507
2508 constructor TfdLuminance_UB1.Create;
2509 begin
2510   inherited Create;
2511   fPixelSize        := 1.0;
2512   fRange.r          := $FF;
2513   fRange.g          := $FF;
2514   fRange.b          := $FF;
2515   fglFormat         := GL_LUMINANCE;
2516   fglDataFormat     := GL_UNSIGNED_BYTE;
2517 end;
2518
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 var
2524   i: Integer;
2525 begin
2526   aData^ := 0;
2527   for i := 0 to 3 do
2528     if (fRange.arr[i] > 0) then
2529       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2530   inc(aData);
2531 end;
2532
2533 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2534 var
2535   i: Integer;
2536 begin
2537   for i := 0 to 3 do
2538     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2539   inc(aData);
2540 end;
2541
2542 constructor TfdUniversal_UB1.Create;
2543 begin
2544   inherited Create;
2545   fPixelSize := 1.0;
2546 end;
2547
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2552 begin
2553   inherited Map(aPixel, aData, aMapData);
2554   aData^ := aPixel.Data.a;
2555   inc(aData);
2556 end;
2557
2558 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2559 begin
2560   inherited Unmap(aData, aPixel, aMapData);
2561   aPixel.Data.a := aData^;
2562   inc(aData);
2563 end;
2564
2565 constructor TfdLuminanceAlpha_UB2.Create;
2566 begin
2567   inherited Create;
2568   fPixelSize        := 2.0;
2569   fRange.a          := $FF;
2570   fShift.a          :=   8;
2571   fglFormat         := GL_LUMINANCE_ALPHA;
2572   fglDataFormat     := GL_UNSIGNED_BYTE;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   aData^ := aPixel.Data.r;
2581   inc(aData);
2582   aData^ := aPixel.Data.g;
2583   inc(aData);
2584   aData^ := aPixel.Data.b;
2585   inc(aData);
2586 end;
2587
2588 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2589 begin
2590   aPixel.Data.r := aData^;
2591   inc(aData);
2592   aPixel.Data.g := aData^;
2593   inc(aData);
2594   aPixel.Data.b := aData^;
2595   inc(aData);
2596   aPixel.Data.a := 0;
2597 end;
2598
2599 constructor TfdRGB_UB3.Create;
2600 begin
2601   inherited Create;
2602   fPixelSize        := 3.0;
2603   fRange.r          := $FF;
2604   fRange.g          := $FF;
2605   fRange.b          := $FF;
2606   fShift.r          :=   0;
2607   fShift.g          :=   8;
2608   fShift.b          :=  16;
2609   fglFormat         := GL_RGB;
2610   fglDataFormat     := GL_UNSIGNED_BYTE;
2611 end;
2612
2613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2617 begin
2618   aData^ := aPixel.Data.b;
2619   inc(aData);
2620   aData^ := aPixel.Data.g;
2621   inc(aData);
2622   aData^ := aPixel.Data.r;
2623   inc(aData);
2624 end;
2625
2626 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2627 begin
2628   aPixel.Data.b := aData^;
2629   inc(aData);
2630   aPixel.Data.g := aData^;
2631   inc(aData);
2632   aPixel.Data.r := aData^;
2633   inc(aData);
2634   aPixel.Data.a := 0;
2635 end;
2636
2637 constructor TfdBGR_UB3.Create;
2638 begin
2639   fPixelSize        := 3.0;
2640   fRange.r          := $FF;
2641   fRange.g          := $FF;
2642   fRange.b          := $FF;
2643   fShift.r          :=  16;
2644   fShift.g          :=   8;
2645   fShift.b          :=   0;
2646   fglFormat         := GL_BGR;
2647   fglDataFormat     := GL_UNSIGNED_BYTE;
2648 end;
2649
2650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2651 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2653 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2654 begin
2655   inherited Map(aPixel, aData, aMapData);
2656   aData^ := aPixel.Data.a;
2657   inc(aData);
2658 end;
2659
2660 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2661 begin
2662   inherited Unmap(aData, aPixel, aMapData);
2663   aPixel.Data.a := aData^;
2664   inc(aData);
2665 end;
2666
2667 constructor TfdRGBA_UB4.Create;
2668 begin
2669   inherited Create;
2670   fPixelSize        := 4.0;
2671   fRange.a          := $FF;
2672   fShift.a          :=  24;
2673   fglFormat         := GL_RGBA;
2674   fglDataFormat     := GL_UNSIGNED_BYTE;
2675 end;
2676
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 procedure TfdBGRA_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 TfdBGRA_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 TfdBGRA_UB4.Create;
2695 begin
2696   inherited Create;
2697   fPixelSize        := 4.0;
2698   fRange.a          := $FF;
2699   fShift.a          :=  24;
2700   fglFormat         := GL_BGRA;
2701   fglDataFormat     := GL_UNSIGNED_BYTE;
2702 end;
2703
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2708 begin
2709   PWord(aData)^ := aPixel.Data.a;
2710   inc(aData, 2);
2711 end;
2712
2713 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2714 begin
2715   aPixel.Data.r := 0;
2716   aPixel.Data.g := 0;
2717   aPixel.Data.b := 0;
2718   aPixel.Data.a := PWord(aData)^;
2719   inc(aData, 2);
2720 end;
2721
2722 constructor TfdAlpha_US1.Create;
2723 begin
2724   inherited Create;
2725   fPixelSize        := 2.0;
2726   fRange.a          := $FFFF;
2727   fglFormat         := GL_ALPHA;
2728   fglDataFormat     := GL_UNSIGNED_SHORT;
2729 end;
2730
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2735 begin
2736   PWord(aData)^ := LuminanceWeight(aPixel);
2737   inc(aData, 2);
2738 end;
2739
2740 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2741 begin
2742   aPixel.Data.r := PWord(aData)^;
2743   aPixel.Data.g := PWord(aData)^;
2744   aPixel.Data.b := PWord(aData)^;
2745   aPixel.Data.a := 0;
2746   inc(aData, 2);
2747 end;
2748
2749 constructor TfdLuminance_US1.Create;
2750 begin
2751   inherited Create;
2752   fPixelSize        := 2.0;
2753   fRange.r          := $FFFF;
2754   fRange.g          := $FFFF;
2755   fRange.b          := $FFFF;
2756   fglFormat         := GL_LUMINANCE;
2757   fglDataFormat     := GL_UNSIGNED_SHORT;
2758 end;
2759
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2764 var
2765   i: Integer;
2766 begin
2767   PWord(aData)^ := 0;
2768   for i := 0 to 3 do
2769     if (fRange.arr[i] > 0) then
2770       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2771   inc(aData, 2);
2772 end;
2773
2774 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2775 var
2776   i: Integer;
2777 begin
2778   for i := 0 to 3 do
2779     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2780   inc(aData, 2);
2781 end;
2782
2783 constructor TfdUniversal_US1.Create;
2784 begin
2785   inherited Create;
2786   fPixelSize := 2.0;
2787 end;
2788
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2793 begin
2794   PWord(aData)^ := DepthWeight(aPixel);
2795   inc(aData, 2);
2796 end;
2797
2798 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2799 begin
2800   aPixel.Data.r := PWord(aData)^;
2801   aPixel.Data.g := PWord(aData)^;
2802   aPixel.Data.b := PWord(aData)^;
2803   aPixel.Data.a := 0;
2804   inc(aData, 2);
2805 end;
2806
2807 constructor TfdDepth_US1.Create;
2808 begin
2809   inherited Create;
2810   fPixelSize        := 2.0;
2811   fRange.r          := $FFFF;
2812   fRange.g          := $FFFF;
2813   fRange.b          := $FFFF;
2814   fglFormat         := GL_DEPTH_COMPONENT;
2815   fglDataFormat     := GL_UNSIGNED_SHORT;
2816 end;
2817
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2822 begin
2823   inherited Map(aPixel, aData, aMapData);
2824   PWord(aData)^ := aPixel.Data.a;
2825   inc(aData, 2);
2826 end;
2827
2828 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2829 begin
2830   inherited Unmap(aData, aPixel, aMapData);
2831   aPixel.Data.a := PWord(aData)^;
2832   inc(aData, 2);
2833 end;
2834
2835 constructor TfdLuminanceAlpha_US2.Create;
2836 begin
2837   inherited Create;
2838   fPixelSize        :=   4.0;
2839   fRange.a          := $FFFF;
2840   fShift.a          :=    16;
2841   fglFormat         := GL_LUMINANCE_ALPHA;
2842   fglDataFormat     := GL_UNSIGNED_SHORT;
2843 end;
2844
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2849 begin
2850   PWord(aData)^ := aPixel.Data.r;
2851   inc(aData, 2);
2852   PWord(aData)^ := aPixel.Data.g;
2853   inc(aData, 2);
2854   PWord(aData)^ := aPixel.Data.b;
2855   inc(aData, 2);
2856 end;
2857
2858 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2859 begin
2860   aPixel.Data.r := PWord(aData)^;
2861   inc(aData, 2);
2862   aPixel.Data.g := PWord(aData)^;
2863   inc(aData, 2);
2864   aPixel.Data.b := PWord(aData)^;
2865   inc(aData, 2);
2866   aPixel.Data.a := 0;
2867 end;
2868
2869 constructor TfdRGB_US3.Create;
2870 begin
2871   inherited Create;
2872   fPixelSize        :=   6.0;
2873   fRange.r          := $FFFF;
2874   fRange.g          := $FFFF;
2875   fRange.b          := $FFFF;
2876   fShift.r          :=     0;
2877   fShift.g          :=    16;
2878   fShift.b          :=    32;
2879   fglFormat         := GL_RGB;
2880   fglDataFormat     := GL_UNSIGNED_SHORT;
2881 end;
2882
2883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2886 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2887 begin
2888   PWord(aData)^ := aPixel.Data.b;
2889   inc(aData, 2);
2890   PWord(aData)^ := aPixel.Data.g;
2891   inc(aData, 2);
2892   PWord(aData)^ := aPixel.Data.r;
2893   inc(aData, 2);
2894 end;
2895
2896 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2897 begin
2898   aPixel.Data.b := PWord(aData)^;
2899   inc(aData, 2);
2900   aPixel.Data.g := PWord(aData)^;
2901   inc(aData, 2);
2902   aPixel.Data.r := PWord(aData)^;
2903   inc(aData, 2);
2904   aPixel.Data.a := 0;
2905 end;
2906
2907 constructor TfdBGR_US3.Create;
2908 begin
2909   inherited Create;
2910   fPixelSize        :=   6.0;
2911   fRange.r          := $FFFF;
2912   fRange.g          := $FFFF;
2913   fRange.b          := $FFFF;
2914   fShift.r          :=    32;
2915   fShift.g          :=    16;
2916   fShift.b          :=     0;
2917   fglFormat         := GL_BGR;
2918   fglDataFormat     := GL_UNSIGNED_SHORT;
2919 end;
2920
2921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2922 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2924 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2925 begin
2926   inherited Map(aPixel, aData, aMapData);
2927   PWord(aData)^ := aPixel.Data.a;
2928   inc(aData, 2);
2929 end;
2930
2931 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 begin
2933   inherited Unmap(aData, aPixel, aMapData);
2934   aPixel.Data.a := PWord(aData)^;
2935   inc(aData, 2);
2936 end;
2937
2938 constructor TfdRGBA_US4.Create;
2939 begin
2940   inherited Create;
2941   fPixelSize        :=   8.0;
2942   fRange.a          := $FFFF;
2943   fShift.a          :=    48;
2944   fglFormat         := GL_RGBA;
2945   fglDataFormat     := GL_UNSIGNED_SHORT;
2946 end;
2947
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 procedure TfdBGRA_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 TfdBGRA_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 TfdBGRA_US4.Create;
2966 begin
2967   inherited Create;
2968   fPixelSize        :=   8.0;
2969   fRange.a          := $FFFF;
2970   fShift.a          :=    48;
2971   fglFormat         := GL_BGRA;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2979 var
2980   i: Integer;
2981 begin
2982   PCardinal(aData)^ := 0;
2983   for i := 0 to 3 do
2984     if (fRange.arr[i] > 0) then
2985       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2986   inc(aData, 4);
2987 end;
2988
2989 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2990 var
2991   i: Integer;
2992 begin
2993   for i := 0 to 3 do
2994     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2995   inc(aData, 2);
2996 end;
2997
2998 constructor TfdUniversal_UI1.Create;
2999 begin
3000   inherited Create;
3001   fPixelSize := 4.0;
3002 end;
3003
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3007 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3008 begin
3009   PCardinal(aData)^ := DepthWeight(aPixel);
3010   inc(aData, 4);
3011 end;
3012
3013 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3014 begin
3015   aPixel.Data.r := PCardinal(aData)^;
3016   aPixel.Data.g := PCardinal(aData)^;
3017   aPixel.Data.b := PCardinal(aData)^;
3018   aPixel.Data.a := 0;
3019   inc(aData, 4);
3020 end;
3021
3022 constructor TfdDepth_UI1.Create;
3023 begin
3024   inherited Create;
3025   fPixelSize        := 4.0;
3026   fRange.r          := $FFFFFFFF;
3027   fRange.g          := $FFFFFFFF;
3028   fRange.b          := $FFFFFFFF;
3029   fglFormat         := GL_DEPTH_COMPONENT;
3030   fglDataFormat     := GL_UNSIGNED_INT;
3031 end;
3032
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 constructor TfdAlpha4.Create;
3037 begin
3038   inherited Create;
3039   fFormat           := tfAlpha4;
3040   fWithAlpha        := tfAlpha4;
3041   fglInternalFormat := GL_ALPHA4;
3042 end;
3043
3044 constructor TfdAlpha8.Create;
3045 begin
3046   inherited Create;
3047   fFormat           := tfAlpha8;
3048   fWithAlpha        := tfAlpha8;
3049   fglInternalFormat := GL_ALPHA8;
3050 end;
3051
3052 constructor TfdAlpha12.Create;
3053 begin
3054   inherited Create;
3055   fFormat           := tfAlpha12;
3056   fWithAlpha        := tfAlpha12;
3057   fglInternalFormat := GL_ALPHA12;
3058 end;
3059
3060 constructor TfdAlpha16.Create;
3061 begin
3062   inherited Create;
3063   fFormat           := tfAlpha16;
3064   fWithAlpha        := tfAlpha16;
3065   fglInternalFormat := GL_ALPHA16;
3066 end;
3067
3068 constructor TfdLuminance4.Create;
3069 begin
3070   inherited Create;
3071   fFormat           := tfLuminance4;
3072   fWithAlpha        := tfLuminance4Alpha4;
3073   fWithoutAlpha     := tfLuminance4;
3074   fglInternalFormat := GL_LUMINANCE4;
3075 end;
3076
3077 constructor TfdLuminance8.Create;
3078 begin
3079   inherited Create;
3080   fFormat           := tfLuminance8;
3081   fWithAlpha        := tfLuminance8Alpha8;
3082   fWithoutAlpha     := tfLuminance8;
3083   fglInternalFormat := GL_LUMINANCE8;
3084 end;
3085
3086 constructor TfdLuminance12.Create;
3087 begin
3088   inherited Create;
3089   fFormat           := tfLuminance12;
3090   fWithAlpha        := tfLuminance12Alpha12;
3091   fWithoutAlpha     := tfLuminance12;
3092   fglInternalFormat := GL_LUMINANCE12;
3093 end;
3094
3095 constructor TfdLuminance16.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfLuminance16;
3099   fWithAlpha        := tfLuminance16Alpha16;
3100   fWithoutAlpha     := tfLuminance16;
3101   fglInternalFormat := GL_LUMINANCE16;
3102 end;
3103
3104 constructor TfdLuminance4Alpha4.Create;
3105 begin
3106   inherited Create;
3107   fFormat           := tfLuminance4Alpha4;
3108   fWithAlpha        := tfLuminance4Alpha4;
3109   fWithoutAlpha     := tfLuminance4;
3110   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3111 end;
3112
3113 constructor TfdLuminance6Alpha2.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfLuminance6Alpha2;
3117   fWithAlpha        := tfLuminance6Alpha2;
3118   fWithoutAlpha     := tfLuminance8;
3119   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3120 end;
3121
3122 constructor TfdLuminance8Alpha8.Create;
3123 begin
3124   inherited Create;
3125   fFormat           := tfLuminance8Alpha8;
3126   fWithAlpha        := tfLuminance8Alpha8;
3127   fWithoutAlpha     := tfLuminance8;
3128   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3129 end;
3130
3131 constructor TfdLuminance12Alpha4.Create;
3132 begin
3133   inherited Create;
3134   fFormat           := tfLuminance12Alpha4;
3135   fWithAlpha        := tfLuminance12Alpha4;
3136   fWithoutAlpha     := tfLuminance12;
3137   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3138 end;
3139
3140 constructor TfdLuminance12Alpha12.Create;
3141 begin
3142   inherited Create;
3143   fFormat           := tfLuminance12Alpha12;
3144   fWithAlpha        := tfLuminance12Alpha12;
3145   fWithoutAlpha     := tfLuminance12;
3146   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3147 end;
3148
3149 constructor TfdLuminance16Alpha16.Create;
3150 begin
3151   inherited Create;
3152   fFormat           := tfLuminance16Alpha16;
3153   fWithAlpha        := tfLuminance16Alpha16;
3154   fWithoutAlpha     := tfLuminance16;
3155   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3156 end;
3157
3158 constructor TfdR3G3B2.Create;
3159 begin
3160   inherited Create;
3161   fFormat           := tfR3G3B2;
3162   fWithAlpha        := tfRGBA2;
3163   fWithoutAlpha     := tfR3G3B2;
3164   fRange.r          := $7;
3165   fRange.g          := $7;
3166   fRange.b          := $3;
3167   fShift.r          :=  0;
3168   fShift.g          :=  3;
3169   fShift.b          :=  6;
3170   fglFormat         := GL_RGB;
3171   fglInternalFormat := GL_R3_G3_B2;
3172   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3173 end;
3174
3175 constructor TfdRGB4.Create;
3176 begin
3177   inherited Create;
3178   fFormat           := tfRGB4;
3179   fWithAlpha        := tfRGBA4;
3180   fWithoutAlpha     := tfRGB4;
3181   fRGBInverted      := tfBGR4;
3182   fRange.r          := $F;
3183   fRange.g          := $F;
3184   fRange.b          := $F;
3185   fShift.r          :=  0;
3186   fShift.g          :=  4;
3187   fShift.b          :=  8;
3188   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3189   fglInternalFormat := GL_RGB4;
3190   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3191 end;
3192
3193 constructor TfdR5G6B5.Create;
3194 begin
3195   inherited Create;
3196   fFormat           := tfR5G6B5;
3197   fWithAlpha        := tfRGBA4;
3198   fWithoutAlpha     := tfR5G6B5;
3199   fRGBInverted      := tfB5G6R5;
3200   fRange.r          := $1F;
3201   fRange.g          := $3F;
3202   fRange.b          := $1F;
3203   fShift.r          :=   0;
3204   fShift.g          :=   5;
3205   fShift.b          :=  11;
3206   fglFormat         := GL_RGB;
3207   fglInternalFormat := GL_RGB565;
3208   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3209 end;
3210
3211 constructor TfdRGB5.Create;
3212 begin
3213   inherited Create;
3214   fFormat           := tfRGB5;
3215   fWithAlpha        := tfRGB5A1;
3216   fWithoutAlpha     := tfRGB5;
3217   fRGBInverted      := tfBGR5;
3218   fRange.r          := $1F;
3219   fRange.g          := $1F;
3220   fRange.b          := $1F;
3221   fShift.r          :=   0;
3222   fShift.g          :=   5;
3223   fShift.b          :=  10;
3224   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3225   fglInternalFormat := GL_RGB5;
3226   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3227 end;
3228
3229 constructor TfdRGB8.Create;
3230 begin
3231   inherited Create;
3232   fFormat           := tfRGB8;
3233   fWithAlpha        := tfRGBA8;
3234   fWithoutAlpha     := tfRGB8;
3235   fRGBInverted      := tfBGR8;
3236   fglInternalFormat := GL_RGB8;
3237 end;
3238
3239 constructor TfdRGB10.Create;
3240 begin
3241   inherited Create;
3242   fFormat           := tfRGB10;
3243   fWithAlpha        := tfRGB10A2;
3244   fWithoutAlpha     := tfRGB10;
3245   fRGBInverted      := tfBGR10;
3246   fRange.r          := $3FF;
3247   fRange.g          := $3FF;
3248   fRange.b          := $3FF;
3249   fShift.r          :=    0;
3250   fShift.g          :=   10;
3251   fShift.b          :=   20;
3252   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3253   fglInternalFormat := GL_RGB10;
3254   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3255 end;
3256
3257 constructor TfdRGB12.Create;
3258 begin
3259   inherited Create;
3260   fFormat           := tfRGB12;
3261   fWithAlpha        := tfRGBA12;
3262   fWithoutAlpha     := tfRGB12;
3263   fRGBInverted      := tfBGR12;
3264   fglInternalFormat := GL_RGB12;
3265 end;
3266
3267 constructor TfdRGB16.Create;
3268 begin
3269   inherited Create;
3270   fFormat           := tfRGB16;
3271   fWithAlpha        := tfRGBA16;
3272   fWithoutAlpha     := tfRGB16;
3273   fRGBInverted      := tfBGR16;
3274   fglInternalFormat := GL_RGB16;
3275 end;
3276
3277 constructor TfdRGBA2.Create;
3278 begin
3279   inherited Create;
3280   fFormat           := tfRGBA2;
3281   fWithAlpha        := tfRGBA2;
3282   fWithoutAlpha     := tfR3G3B2;
3283   fRGBInverted      := tfBGRA2;
3284   fglInternalFormat := GL_RGBA2;
3285 end;
3286
3287 constructor TfdRGBA4.Create;
3288 begin
3289   inherited Create;
3290   fFormat           := tfRGBA4;
3291   fWithAlpha        := tfRGBA4;
3292   fWithoutAlpha     := tfRGB4;
3293   fRGBInverted      := tfBGRA4;
3294   fRange.r          := $F;
3295   fRange.g          := $F;
3296   fRange.b          := $F;
3297   fRange.a          := $F;
3298   fShift.r          :=  0;
3299   fShift.g          :=  4;
3300   fShift.b          :=  8;
3301   fShift.a          := 12;
3302   fglFormat         := GL_RGBA;
3303   fglInternalFormat := GL_RGBA4;
3304   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3305 end;
3306
3307 constructor TfdRGB5A1.Create;
3308 begin
3309   inherited Create;
3310   fFormat           := tfRGB5A1;
3311   fWithAlpha        := tfRGB5A1;
3312   fWithoutAlpha     := tfRGB5;
3313   fRGBInverted      := tfBGR5A1;
3314   fRange.r          := $1F;
3315   fRange.g          := $1F;
3316   fRange.b          := $1F;
3317   fRange.a          := $01;
3318   fShift.r          :=   0;
3319   fShift.g          :=   5;
3320   fShift.b          :=  10;
3321   fShift.a          :=  15;
3322   fglFormat         := GL_RGBA;
3323   fglInternalFormat := GL_RGB5_A1;
3324   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3325 end;
3326
3327 constructor TfdRGBA8.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfRGBA8;
3331   fWithAlpha        := tfRGBA8;
3332   fWithoutAlpha     := tfRGB8;
3333   fRGBInverted      := tfBGRA8;
3334   fglInternalFormat := GL_RGBA8;
3335 end;
3336
3337 constructor TfdRGB10A2.Create;
3338 begin
3339   inherited Create;
3340   fFormat           := tfRGB10A2;
3341   fWithAlpha        := tfRGB10A2;
3342   fWithoutAlpha     := tfRGB10;
3343   fRGBInverted      := tfBGR10A2;
3344   fRange.r          := $3FF;
3345   fRange.g          := $3FF;
3346   fRange.b          := $3FF;
3347   fRange.a          := $003;
3348   fShift.r          :=    0;
3349   fShift.g          :=   10;
3350   fShift.b          :=   20;
3351   fShift.a          :=   30;
3352   fglFormat         := GL_RGBA;
3353   fglInternalFormat := GL_RGB10_A2;
3354   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3355 end;
3356
3357 constructor TfdRGBA12.Create;
3358 begin
3359   inherited Create;
3360   fFormat           := tfRGBA12;
3361   fWithAlpha        := tfRGBA12;
3362   fWithoutAlpha     := tfRGB12;
3363   fRGBInverted      := tfBGRA12;
3364   fglInternalFormat := GL_RGBA12;
3365 end;
3366
3367 constructor TfdRGBA16.Create;
3368 begin
3369   inherited Create;
3370   fFormat           := tfRGBA16;
3371   fWithAlpha        := tfRGBA16;
3372   fWithoutAlpha     := tfRGB16;
3373   fRGBInverted      := tfBGRA16;
3374   fglInternalFormat := GL_RGBA16;
3375 end;
3376
3377 constructor TfdBGR4.Create;
3378 begin
3379   inherited Create;
3380   fPixelSize        := 2.0;
3381   fFormat           := tfBGR4;
3382   fWithAlpha        := tfBGRA4;
3383   fWithoutAlpha     := tfBGR4;
3384   fRGBInverted      := tfRGB4;
3385   fRange.r          := $F;
3386   fRange.g          := $F;
3387   fRange.b          := $F;
3388   fRange.a          := $0;
3389   fShift.r          :=  8;
3390   fShift.g          :=  4;
3391   fShift.b          :=  0;
3392   fShift.a          :=  0;
3393   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3394   fglInternalFormat := GL_RGB4;
3395   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3396 end;
3397
3398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3401 constructor TfdB5G6R5.Create;
3402 begin
3403   inherited Create;
3404   fFormat           := tfB5G6R5;
3405   fWithAlpha        := tfBGRA4;
3406   fWithoutAlpha     := tfB5G6R5;
3407   fRGBInverted      := tfR5G6B5;
3408   fRange.r          := $1F;
3409   fRange.g          := $3F;
3410   fRange.b          := $1F;
3411   fShift.r          :=  11;
3412   fShift.g          :=   5;
3413   fShift.b          :=   0;
3414   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3415   fglInternalFormat := GL_RGB8;
3416   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3417 end;
3418
3419 constructor TfdBGR5.Create;
3420 begin
3421   inherited Create;
3422   fPixelSize        := 2.0;
3423   fFormat           := tfBGR5;
3424   fWithAlpha        := tfBGR5A1;
3425   fWithoutAlpha     := tfBGR5;
3426   fRGBInverted      := tfRGB5;
3427   fRange.r          := $1F;
3428   fRange.g          := $1F;
3429   fRange.b          := $1F;
3430   fRange.a          := $00;
3431   fShift.r          :=  10;
3432   fShift.g          :=   5;
3433   fShift.b          :=   0;
3434   fShift.a          :=   0;
3435   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3436   fglInternalFormat := GL_RGB5;
3437   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3438 end;
3439
3440 constructor TfdBGR8.Create;
3441 begin
3442   inherited Create;
3443   fFormat           := tfBGR8;
3444   fWithAlpha        := tfBGRA8;
3445   fWithoutAlpha     := tfBGR8;
3446   fRGBInverted      := tfRGB8;
3447   fglInternalFormat := GL_RGB8;
3448 end;
3449
3450 constructor TfdBGR10.Create;
3451 begin
3452   inherited Create;
3453   fFormat           := tfBGR10;
3454   fWithAlpha        := tfBGR10A2;
3455   fWithoutAlpha     := tfBGR10;
3456   fRGBInverted      := tfRGB10;
3457   fRange.r          := $3FF;
3458   fRange.g          := $3FF;
3459   fRange.b          := $3FF;
3460   fRange.a          := $000;
3461   fShift.r          :=   20;
3462   fShift.g          :=   10;
3463   fShift.b          :=    0;
3464   fShift.a          :=    0;
3465   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3466   fglInternalFormat := GL_RGB10;
3467   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3468 end;
3469
3470 constructor TfdBGR12.Create;
3471 begin
3472   inherited Create;
3473   fFormat           := tfBGR12;
3474   fWithAlpha        := tfBGRA12;
3475   fWithoutAlpha     := tfBGR12;
3476   fRGBInverted      := tfRGB12;
3477   fglInternalFormat := GL_RGB12;
3478 end;
3479
3480 constructor TfdBGR16.Create;
3481 begin
3482   inherited Create;
3483   fFormat           := tfBGR16;
3484   fWithAlpha        := tfBGRA16;
3485   fWithoutAlpha     := tfBGR16;
3486   fRGBInverted      := tfRGB16;
3487   fglInternalFormat := GL_RGB16;
3488 end;
3489
3490 constructor TfdBGRA2.Create;
3491 begin
3492   inherited Create;
3493   fFormat           := tfBGRA2;
3494   fWithAlpha        := tfBGRA4;
3495   fWithoutAlpha     := tfBGR4;
3496   fRGBInverted      := tfRGBA2;
3497   fglInternalFormat := GL_RGBA2;
3498 end;
3499
3500 constructor TfdBGRA4.Create;
3501 begin
3502   inherited Create;
3503   fFormat           := tfBGRA4;
3504   fWithAlpha        := tfBGRA4;
3505   fWithoutAlpha     := tfBGR4;
3506   fRGBInverted      := tfRGBA4;
3507   fRange.r          := $F;
3508   fRange.g          := $F;
3509   fRange.b          := $F;
3510   fRange.a          := $F;
3511   fShift.r          :=  8;
3512   fShift.g          :=  4;
3513   fShift.b          :=  0;
3514   fShift.a          := 12;
3515   fglFormat         := GL_BGRA;
3516   fglInternalFormat := GL_RGBA4;
3517   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3518 end;
3519
3520 constructor TfdBGR5A1.Create;
3521 begin
3522   inherited Create;
3523   fFormat           := tfBGR5A1;
3524   fWithAlpha        := tfBGR5A1;
3525   fWithoutAlpha     := tfBGR5;
3526   fRGBInverted      := tfRGB5A1;
3527   fRange.r          := $1F;
3528   fRange.g          := $1F;
3529   fRange.b          := $1F;
3530   fRange.a          := $01;
3531   fShift.r          :=  10;
3532   fShift.g          :=   5;
3533   fShift.b          :=   0;
3534   fShift.a          :=  15;
3535   fglFormat         := GL_BGRA;
3536   fglInternalFormat := GL_RGB5_A1;
3537   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3538 end;
3539
3540 constructor TfdBGRA8.Create;
3541 begin
3542   inherited Create;
3543   fFormat           := tfBGRA8;
3544   fWithAlpha        := tfBGRA8;
3545   fWithoutAlpha     := tfBGR8;
3546   fRGBInverted      := tfRGBA8;
3547   fglInternalFormat := GL_RGBA8;
3548 end;
3549
3550 constructor TfdBGR10A2.Create;
3551 begin
3552   inherited Create;
3553   fFormat           := tfBGR10A2;
3554   fWithAlpha        := tfBGR10A2;
3555   fWithoutAlpha     := tfBGR10;
3556   fRGBInverted      := tfRGB10A2;
3557   fRange.r          := $3FF;
3558   fRange.g          := $3FF;
3559   fRange.b          := $3FF;
3560   fRange.a          := $003;
3561   fShift.r          :=   20;
3562   fShift.g          :=   10;
3563   fShift.b          :=    0;
3564   fShift.a          :=   30;
3565   fglFormat         := GL_BGRA;
3566   fglInternalFormat := GL_RGB10_A2;
3567   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3568 end;
3569
3570 constructor TfdBGRA12.Create;
3571 begin
3572   inherited Create;
3573   fFormat           := tfBGRA12;
3574   fWithAlpha        := tfBGRA12;
3575   fWithoutAlpha     := tfBGR12;
3576   fRGBInverted      := tfRGBA12;
3577   fglInternalFormat := GL_RGBA12;
3578 end;
3579
3580 constructor TfdBGRA16.Create;
3581 begin
3582   inherited Create;
3583   fFormat           := tfBGRA16;
3584   fWithAlpha        := tfBGRA16;
3585   fWithoutAlpha     := tfBGR16;
3586   fRGBInverted      := tfRGBA16;
3587   fglInternalFormat := GL_RGBA16;
3588 end;
3589
3590 constructor TfdDepth16.Create;
3591 begin
3592   inherited Create;
3593   fFormat           := tfDepth16;
3594   fWithAlpha        := tfEmpty;
3595   fWithoutAlpha     := tfDepth16;
3596   fglInternalFormat := GL_DEPTH_COMPONENT16;
3597 end;
3598
3599 constructor TfdDepth24.Create;
3600 begin
3601   inherited Create;
3602   fFormat           := tfDepth24;
3603   fWithAlpha        := tfEmpty;
3604   fWithoutAlpha     := tfDepth24;
3605   fglInternalFormat := GL_DEPTH_COMPONENT24;
3606 end;
3607
3608 constructor TfdDepth32.Create;
3609 begin
3610   inherited Create;
3611   fFormat           := tfDepth32;
3612   fWithAlpha        := tfEmpty;
3613   fWithoutAlpha     := tfDepth32;
3614   fglInternalFormat := GL_DEPTH_COMPONENT32;
3615 end;
3616
3617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3618 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3620 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3621 begin
3622   raise EglBitmap.Create('mapping for compressed formats is not supported');
3623 end;
3624
3625 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3626 begin
3627   raise EglBitmap.Create('mapping for compressed formats is not supported');
3628 end;
3629
3630 constructor TfdS3tcDtx1RGBA.Create;
3631 begin
3632   inherited Create;
3633   fFormat           := tfS3tcDtx1RGBA;
3634   fWithAlpha        := tfS3tcDtx1RGBA;
3635   fUncompressed     := tfRGB5A1;
3636   fPixelSize        := 0.5;
3637   fIsCompressed     := true;
3638   fglFormat         := GL_COMPRESSED_RGBA;
3639   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3640   fglDataFormat     := GL_UNSIGNED_BYTE;
3641 end;
3642
3643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3646 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3647 begin
3648   raise EglBitmap.Create('mapping for compressed formats is not supported');
3649 end;
3650
3651 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3652 begin
3653   raise EglBitmap.Create('mapping for compressed formats is not supported');
3654 end;
3655
3656 constructor TfdS3tcDtx3RGBA.Create;
3657 begin
3658   inherited Create;
3659   fFormat           := tfS3tcDtx3RGBA;
3660   fWithAlpha        := tfS3tcDtx3RGBA;
3661   fUncompressed     := tfRGBA8;
3662   fPixelSize        := 1.0;
3663   fIsCompressed     := true;
3664   fglFormat         := GL_COMPRESSED_RGBA;
3665   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3666   fglDataFormat     := GL_UNSIGNED_BYTE;
3667 end;
3668
3669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3673 begin
3674   raise EglBitmap.Create('mapping for compressed formats is not supported');
3675 end;
3676
3677 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3678 begin
3679   raise EglBitmap.Create('mapping for compressed formats is not supported');
3680 end;
3681
3682 constructor TfdS3tcDtx5RGBA.Create;
3683 begin
3684   inherited Create;
3685   fFormat           := tfS3tcDtx3RGBA;
3686   fWithAlpha        := tfS3tcDtx3RGBA;
3687   fUncompressed     := tfRGBA8;
3688   fPixelSize        := 1.0;
3689   fIsCompressed     := true;
3690   fglFormat         := GL_COMPRESSED_RGBA;
3691   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3692   fglDataFormat     := GL_UNSIGNED_BYTE;
3693 end;
3694
3695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3698 class procedure TFormatDescriptor.Init;
3699 begin
3700   if not Assigned(FormatDescriptorCS) then
3701     FormatDescriptorCS := TCriticalSection.Create;
3702 end;
3703
3704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3706 begin
3707   FormatDescriptorCS.Enter;
3708   try
3709     result := FormatDescriptors[aFormat];
3710     if not Assigned(result) then begin
3711       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3712       FormatDescriptors[aFormat] := result;
3713     end;
3714   finally
3715     FormatDescriptorCS.Leave;
3716   end;
3717 end;
3718
3719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3721 begin
3722   result := Get(Get(aFormat).WithAlpha);
3723 end;
3724
3725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 class procedure TFormatDescriptor.Clear;
3727 var
3728   f: TglBitmapFormat;
3729 begin
3730   FormatDescriptorCS.Enter;
3731   try
3732     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3733       FreeAndNil(FormatDescriptors[f]);
3734   finally
3735     FormatDescriptorCS.Leave;
3736   end;
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 class procedure TFormatDescriptor.Finalize;
3741 begin
3742   Clear;
3743   FreeAndNil(FormatDescriptorCS);
3744 end;
3745
3746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3750 begin
3751   Update(aValue, fRange.r, fShift.r);
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3756 begin
3757   Update(aValue, fRange.g, fShift.g);
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3762 begin
3763   Update(aValue, fRange.b, fShift.b);
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3768 begin
3769   Update(aValue, fRange.a, fShift.a);
3770 end;
3771
3772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3773 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3774   aShift: Byte);
3775 begin
3776   aShift := 0;
3777   aRange := 0;
3778   if (aMask = 0) then
3779     exit;
3780   while (aMask > 0) and ((aMask and 1) = 0) do begin
3781     inc(aShift);
3782     aMask := aMask shr 1;
3783   end;
3784   aRange := 1;
3785   while (aMask > 0) do begin
3786     aRange := aRange shl 1;
3787     aMask  := aMask  shr 1;
3788   end;
3789   dec(aRange);
3790
3791   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3792 end;
3793
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3796 var
3797   data: QWord;
3798   s: Integer;
3799 begin
3800   data :=
3801     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3802     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3803     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3804     ((aPixel.Data.a and fRange.a) shl fShift.a);
3805   s := Round(fPixelSize);
3806   case s of
3807     1:           aData^  := data;
3808     2:     PWord(aData)^ := data;
3809     4: PCardinal(aData)^ := data;
3810     8:    PQWord(aData)^ := data;
3811   else
3812     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3813   end;
3814   inc(aData, s);
3815 end;
3816
3817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3818 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3819 var
3820   data: QWord;
3821   s, i: Integer;
3822 begin
3823   s := Round(fPixelSize);
3824   case s of
3825     1: data :=           aData^;
3826     2: data :=     PWord(aData)^;
3827     4: data := PCardinal(aData)^;
3828     8: data :=    PQWord(aData)^;
3829   else
3830     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3831   end;
3832   for i := 0 to 3 do
3833     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3834   inc(aData, s);
3835 end;
3836
3837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3838 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3840 procedure TbmpColorTableFormat.CreateColorTable;
3841 var
3842   i: Integer;
3843 begin
3844   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3845     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3846
3847   if (Format = tfLuminance4) then
3848     SetLength(fColorTable, 16)
3849   else
3850     SetLength(fColorTable, 256);
3851
3852   case Format of
3853     tfLuminance4: begin
3854       for i := 0 to High(fColorTable) do begin
3855         fColorTable[i].r := 16 * i;
3856         fColorTable[i].g := 16 * i;
3857         fColorTable[i].b := 16 * i;
3858         fColorTable[i].a := 0;
3859       end;
3860     end;
3861
3862     tfLuminance8: begin
3863       for i := 0 to High(fColorTable) do begin
3864         fColorTable[i].r := i;
3865         fColorTable[i].g := i;
3866         fColorTable[i].b := i;
3867         fColorTable[i].a := 0;
3868       end;
3869     end;
3870
3871     tfR3G3B2: begin
3872       for i := 0 to High(fColorTable) do begin
3873         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3874         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3875         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3876         fColorTable[i].a := 0;
3877       end;
3878     end;
3879   end;
3880 end;
3881
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3884 var
3885   d: Byte;
3886 begin
3887   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3888     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3889
3890   case Format of
3891     tfLuminance4: begin
3892       if (aMapData = nil) then
3893         aData^ := 0;
3894       d := LuminanceWeight(aPixel) and Range.r;
3895       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3896       inc(PByte(aMapData), 4);
3897       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3898         inc(aData);
3899         aMapData := nil;
3900       end;
3901     end;
3902
3903     tfLuminance8: begin
3904       aData^ := LuminanceWeight(aPixel) and Range.r;
3905       inc(aData);
3906     end;
3907
3908     tfR3G3B2: begin
3909       aData^ := Round(
3910         ((aPixel.Data.r and Range.r) shl Shift.r) or
3911         ((aPixel.Data.g and Range.g) shl Shift.g) or
3912         ((aPixel.Data.b and Range.b) shl Shift.b));
3913       inc(aData);
3914     end;
3915   end;
3916 end;
3917
3918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3919 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3920 var
3921   idx: QWord;
3922   s: Integer;
3923   bits: Byte;
3924   f: Single;
3925 begin
3926   s    := Trunc(fPixelSize);
3927   f    := fPixelSize - s;
3928   bits := Round(8 * f);
3929   case s of
3930     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3931     1: idx :=           aData^;
3932     2: idx :=     PWord(aData)^;
3933     4: idx := PCardinal(aData)^;
3934     8: idx :=    PQWord(aData)^;
3935   else
3936     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3937   end;
3938   if (idx >= Length(fColorTable)) then
3939     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3940   with fColorTable[idx] do begin
3941     aPixel.Data.r := r;
3942     aPixel.Data.g := g;
3943     aPixel.Data.b := b;
3944     aPixel.Data.a := a;
3945   end;
3946   inc(PByte(aMapData), bits);
3947   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3948     inc(aData, 1);
3949     dec(PByte(aMapData), 8);
3950   end;
3951   inc(aData, s);
3952 end;
3953
3954 destructor TbmpColorTableFormat.Destroy;
3955 begin
3956   SetLength(fColorTable, 0);
3957   inherited Destroy;
3958 end;
3959
3960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3961 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3963 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3964 var
3965   i: Integer;
3966 begin
3967   for i := 0 to 3 do begin
3968     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3969       if (aSourceFD.Range.arr[i] > 0) then
3970         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3971       else
3972         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3973     end;
3974   end;
3975 end;
3976
3977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3978 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3979 begin
3980   with aFuncRec do begin
3981     if (Source.Range.r   > 0) then
3982       Dest.Data.r := Source.Data.r;
3983     if (Source.Range.g > 0) then
3984       Dest.Data.g := Source.Data.g;
3985     if (Source.Range.b  > 0) then
3986       Dest.Data.b := Source.Data.b;
3987     if (Source.Range.a > 0) then
3988       Dest.Data.a := Source.Data.a;
3989   end;
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3994 var
3995   i: Integer;
3996 begin
3997   with aFuncRec do begin
3998     for i := 0 to 3 do
3999       if (Source.Range.arr[i] > 0) then
4000         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4001   end;
4002 end;
4003
4004 type
4005   TShiftData = packed record
4006     case Integer of
4007       0: (r, g, b, a: SmallInt);
4008       1: (arr: array[0..3] of SmallInt);
4009   end;
4010   PShiftData = ^TShiftData;
4011
4012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4013 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4014 var
4015   i: Integer;
4016 begin
4017   with aFuncRec do
4018     for i := 0 to 3 do
4019       if (Source.Range.arr[i] > 0) then
4020         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4021 end;
4022
4023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4024 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4025 begin
4026   with aFuncRec do begin
4027     Dest.Data := Source.Data;
4028     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4029       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4030       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4031       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4032     end;
4033     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4034       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4035     end;
4036   end;
4037 end;
4038
4039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4040 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4041 var
4042   i: Integer;
4043 begin
4044   with aFuncRec do begin
4045     for i := 0 to 3 do
4046       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4047   end;
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4052 var
4053   Temp: Single;
4054 begin
4055   with FuncRec do begin
4056     if (FuncRec.Args = nil) then begin //source has no alpha
4057       Temp :=
4058         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4059         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4060         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4061       Dest.Data.a := Round(Dest.Range.a * Temp);
4062     end else
4063       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4064   end;
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4069 type
4070   PglBitmapPixelData = ^TglBitmapPixelData;
4071 begin
4072   with FuncRec do begin
4073     Dest.Data.r := Source.Data.r;
4074     Dest.Data.g := Source.Data.g;
4075     Dest.Data.b := Source.Data.b;
4076
4077     with PglBitmapPixelData(Args)^ do
4078       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4079           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4080           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4081         Dest.Data.a := 0
4082       else
4083         Dest.Data.a := Dest.Range.a;
4084   end;
4085 end;
4086
4087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4088 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4089 begin
4090   with FuncRec do begin
4091     Dest.Data.r := Source.Data.r;
4092     Dest.Data.g := Source.Data.g;
4093     Dest.Data.b := Source.Data.b;
4094     Dest.Data.a := PCardinal(Args)^;
4095   end;
4096 end;
4097
4098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4100 type
4101   PRGBPix = ^TRGBPix;
4102   TRGBPix = array [0..2] of byte;
4103 var
4104   Temp: Byte;
4105 begin
4106   while aWidth > 0 do begin
4107     Temp := PRGBPix(aData)^[0];
4108     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4109     PRGBPix(aData)^[2] := Temp;
4110
4111     if aHasAlpha then
4112       Inc(aData, 4)
4113     else
4114       Inc(aData, 3);
4115     dec(aWidth);
4116   end;
4117 end;
4118
4119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4123 begin
4124   result := TFormatDescriptor.Get(Format);
4125 end;
4126
4127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4128 function TglBitmap.GetWidth: Integer;
4129 begin
4130   if (ffX in fDimension.Fields) then
4131     result := fDimension.X
4132   else
4133     result := -1;
4134 end;
4135
4136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4137 function TglBitmap.GetHeight: Integer;
4138 begin
4139   if (ffY in fDimension.Fields) then
4140     result := fDimension.Y
4141   else
4142     result := -1;
4143 end;
4144
4145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 function TglBitmap.GetFileWidth: Integer;
4147 begin
4148   result := Max(1, Width);
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 function TglBitmap.GetFileHeight: Integer;
4153 begin
4154   result := Max(1, Height);
4155 end;
4156
4157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4158 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4159 begin
4160   if fCustomData = aValue then
4161     exit;
4162   fCustomData := aValue;
4163 end;
4164
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 procedure TglBitmap.SetCustomName(const aValue: String);
4167 begin
4168   if fCustomName = aValue then
4169     exit;
4170   fCustomName := aValue;
4171 end;
4172
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4175 begin
4176   if fCustomNameW = aValue then
4177     exit;
4178   fCustomNameW := aValue;
4179 end;
4180
4181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4182 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4183 begin
4184   if fFreeDataOnDestroy = aValue then
4185     exit;
4186   fFreeDataOnDestroy := aValue;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4191 begin
4192   if fDeleteTextureOnFree = aValue then
4193     exit;
4194   fDeleteTextureOnFree := aValue;
4195 end;
4196
4197 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4198 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4199 begin
4200   if fFormat = aValue then
4201     exit;
4202   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4203     raise EglBitmapUnsupportedFormat.Create(Format);
4204   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4205 end;
4206
4207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4208 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4209 begin
4210   if fFreeDataAfterGenTexture = aValue then
4211     exit;
4212   fFreeDataAfterGenTexture := aValue;
4213 end;
4214
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 procedure TglBitmap.SetID(const aValue: Cardinal);
4217 begin
4218   if fID = aValue then
4219     exit;
4220   fID := aValue;
4221 end;
4222
4223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4224 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4225 begin
4226   if fMipMap = aValue then
4227     exit;
4228   fMipMap := aValue;
4229 end;
4230
4231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4232 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4233 begin
4234   if fTarget = aValue then
4235     exit;
4236   fTarget := aValue;
4237 end;
4238
4239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4240 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4241 var
4242   MaxAnisotropic: Integer;
4243 begin
4244   fAnisotropic := aValue;
4245   if (ID > 0) then begin
4246     if GL_EXT_texture_filter_anisotropic then begin
4247       if fAnisotropic > 0 then begin
4248         Bind(false);
4249         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4250         if aValue > MaxAnisotropic then
4251           fAnisotropic := MaxAnisotropic;
4252         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4253       end;
4254     end else begin
4255       fAnisotropic := 0;
4256     end;
4257   end;
4258 end;
4259
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 procedure TglBitmap.CreateID;
4262 begin
4263   if (ID <> 0) then
4264     glDeleteTextures(1, @fID);
4265   glGenTextures(1, @fID);
4266   Bind(false);
4267 end;
4268
4269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4270 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4271 begin
4272   // Set Up Parameters
4273   SetWrap(fWrapS, fWrapT, fWrapR);
4274   SetFilter(fFilterMin, fFilterMag);
4275   SetAnisotropic(fAnisotropic);
4276   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4277
4278   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4279     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4280
4281   // Mip Maps Generation Mode
4282   aBuildWithGlu := false;
4283   if (MipMap = mmMipmap) then begin
4284     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4285       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4286     else
4287       aBuildWithGlu := true;
4288   end else if (MipMap = mmMipmapGlu) then
4289     aBuildWithGlu := true;
4290 end;
4291
4292 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4293 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4294   const aWidth: Integer; const aHeight: Integer);
4295 var
4296   s: Single;
4297 begin
4298   if (Data <> aData) then begin
4299     if (Assigned(Data)) then
4300       FreeMem(Data);
4301     fData := aData;
4302   end;
4303
4304   if not Assigned(fData) then begin
4305     fPixelSize := 0;
4306     fRowSize   := 0;
4307   end else begin
4308     FillChar(fDimension, SizeOf(fDimension), 0);
4309     if aWidth <> -1 then begin
4310       fDimension.Fields := fDimension.Fields + [ffX];
4311       fDimension.X := aWidth;
4312     end;
4313
4314     if aHeight <> -1 then begin
4315       fDimension.Fields := fDimension.Fields + [ffY];
4316       fDimension.Y := aHeight;
4317     end;
4318
4319     s := TFormatDescriptor.Get(aFormat).PixelSize;
4320     fFormat    := aFormat;
4321     fPixelSize := Ceil(s);
4322     fRowSize   := Ceil(s * aWidth);
4323   end;
4324 end;
4325
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 function TglBitmap.FlipHorz: Boolean;
4328 begin
4329   result := false;
4330 end;
4331
4332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4333 function TglBitmap.FlipVert: Boolean;
4334 begin
4335   result := false;
4336 end;
4337
4338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4339 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4341 procedure TglBitmap.AfterConstruction;
4342 begin
4343   inherited AfterConstruction;
4344
4345   fID         := 0;
4346   fTarget     := 0;
4347   fIsResident := false;
4348
4349   fMipMap                  := glBitmapDefaultMipmap;
4350   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4351   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4352
4353   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4354   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4355   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4356 end;
4357
4358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4359 procedure TglBitmap.BeforeDestruction;
4360 var
4361   NewData: PByte;
4362 begin
4363   if fFreeDataOnDestroy then begin
4364     NewData := nil;
4365     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4366   end;
4367   if (fID > 0) and fDeleteTextureOnFree then
4368     glDeleteTextures(1, @fID);
4369   inherited BeforeDestruction;
4370 end;
4371
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4374 var
4375   TempPos: Integer;
4376 begin
4377   if not Assigned(aResType) then begin
4378     TempPos   := Pos('.', aResource);
4379     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4380     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4381   end;
4382 end;
4383
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure TglBitmap.LoadFromFile(const aFilename: String);
4386 var
4387   fs: TFileStream;
4388 begin
4389   if not FileExists(aFilename) then
4390     raise EglBitmap.Create('file does not exist: ' + aFilename);
4391   fFilename := aFilename;
4392   fs := TFileStream.Create(fFilename, fmOpenRead);
4393   try
4394     fs.Position := 0;
4395     LoadFromStream(fs);
4396   finally
4397     fs.Free;
4398   end;
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4403 begin
4404   {$IFDEF GLB_SUPPORT_PNG_READ}
4405   if not LoadPNG(aStream) then
4406   {$ENDIF}
4407   {$IFDEF GLB_SUPPORT_JPEG_READ}
4408   if not LoadJPEG(aStream) then
4409   {$ENDIF}
4410   if not LoadDDS(aStream) then
4411   if not LoadTGA(aStream) then
4412   if not LoadBMP(aStream) then
4413     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4418   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4419 var
4420   tmpData: PByte;
4421   size: Integer;
4422 begin
4423   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4424   GetMem(tmpData, size);
4425   try
4426     FillChar(tmpData^, size, #$FF);
4427     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4428   except
4429     if Assigned(tmpData) then
4430       FreeMem(tmpData);
4431     raise;
4432   end;
4433   AddFunc(Self, aFunc, false, aFormat, aArgs);
4434 end;
4435
4436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4437 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4438 var
4439   rs: TResourceStream;
4440 begin
4441   PrepareResType(aResource, aResType);
4442   rs := TResourceStream.Create(aInstance, aResource, aResType);
4443   try
4444     LoadFromStream(rs);
4445   finally
4446     rs.Free;
4447   end;
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4452 var
4453   rs: TResourceStream;
4454 begin
4455   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4456   try
4457     LoadFromStream(rs);
4458   finally
4459     rs.Free;
4460   end;
4461 end;
4462
4463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4464 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4465 var
4466   fs: TFileStream;
4467 begin
4468   fs := TFileStream.Create(aFileName, fmCreate);
4469   try
4470     fs.Position := 0;
4471     SaveToStream(fs, aFileType);
4472   finally
4473     fs.Free;
4474   end;
4475 end;
4476
4477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4478 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4479 begin
4480   case aFileType of
4481     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4482     ftPNG:  SavePNG(aStream);
4483     {$ENDIF}
4484     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4485     ftJPEG: SaveJPEG(aStream);
4486     {$ENDIF}
4487     ftDDS:  SaveDDS(aStream);
4488     ftTGA:  SaveTGA(aStream);
4489     ftBMP:  SaveBMP(aStream);
4490   end;
4491 end;
4492
4493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4494 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4495 begin
4496   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4497 end;
4498
4499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4500 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4501   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4502 var
4503   DestData, TmpData, SourceData: pByte;
4504   TempHeight, TempWidth: Integer;
4505   SourceFD, DestFD: TFormatDescriptor;
4506   SourceMD, DestMD: Pointer;
4507
4508   FuncRec: TglBitmapFunctionRec;
4509 begin
4510   Assert(Assigned(Data));
4511   Assert(Assigned(aSource));
4512   Assert(Assigned(aSource.Data));
4513
4514   result := false;
4515   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4516     SourceFD := TFormatDescriptor.Get(aSource.Format);
4517     DestFD   := TFormatDescriptor.Get(aFormat);
4518
4519     if (SourceFD.IsCompressed) then
4520       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4521     if (DestFD.IsCompressed) then
4522       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4523
4524     // inkompatible Formats so CreateTemp
4525     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4526       aCreateTemp := true;
4527
4528     // Values
4529     TempHeight := Max(1, aSource.Height);
4530     TempWidth  := Max(1, aSource.Width);
4531
4532     FuncRec.Sender := Self;
4533     FuncRec.Args   := aArgs;
4534
4535     TmpData := nil;
4536     if aCreateTemp then begin
4537       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4538       DestData := TmpData;
4539     end else
4540       DestData := Data;
4541
4542     try
4543       SourceFD.PreparePixel(FuncRec.Source);
4544       DestFD.PreparePixel  (FuncRec.Dest);
4545
4546       SourceMD := SourceFD.CreateMappingData;
4547       DestMD   := DestFD.CreateMappingData;
4548
4549       FuncRec.Size            := aSource.Dimension;
4550       FuncRec.Position.Fields := FuncRec.Size.Fields;
4551
4552       try
4553         SourceData := aSource.Data;
4554         FuncRec.Position.Y := 0;
4555         while FuncRec.Position.Y < TempHeight do begin
4556           FuncRec.Position.X := 0;
4557           while FuncRec.Position.X < TempWidth do begin
4558             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4559             aFunc(FuncRec);
4560             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4561             inc(FuncRec.Position.X);
4562           end;
4563           inc(FuncRec.Position.Y);
4564         end;
4565
4566         // Updating Image or InternalFormat
4567         if aCreateTemp then
4568           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4569         else if (aFormat <> fFormat) then
4570           Format := aFormat;
4571
4572         result := true;
4573       finally
4574         SourceFD.FreeMappingData(SourceMD);
4575         DestFD.FreeMappingData(DestMD);
4576       end;
4577     except
4578       if aCreateTemp and Assigned(TmpData) then
4579         FreeMem(TmpData);
4580       raise;
4581     end;
4582   end;
4583 end;
4584
4585 {$IFDEF GLB_SDL}
4586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4587 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4588 var
4589   Row, RowSize: Integer;
4590   SourceData, TmpData: PByte;
4591   TempDepth: Integer;
4592   FormatDesc: TFormatDescriptor;
4593
4594   function GetRowPointer(Row: Integer): pByte;
4595   begin
4596     result := aSurface.pixels;
4597     Inc(result, Row * RowSize);
4598   end;
4599
4600 begin
4601   result := false;
4602
4603   FormatDesc := TFormatDescriptor.Get(Format);
4604   if FormatDesc.IsCompressed then
4605     raise EglBitmapUnsupportedFormat.Create(Format);
4606
4607   if Assigned(Data) then begin
4608     case Trunc(FormatDesc.PixelSize) of
4609       1: TempDepth :=  8;
4610       2: TempDepth := 16;
4611       3: TempDepth := 24;
4612       4: TempDepth := 32;
4613     else
4614       raise EglBitmapUnsupportedFormat.Create(Format);
4615     end;
4616
4617     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4618       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4619     SourceData := Data;
4620     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4621
4622     for Row := 0 to FileHeight-1 do begin
4623       TmpData := GetRowPointer(Row);
4624       if Assigned(TmpData) then begin
4625         Move(SourceData^, TmpData^, RowSize);
4626         inc(SourceData, RowSize);
4627       end;
4628     end;
4629     result := true;
4630   end;
4631 end;
4632
4633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4634 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4635 var
4636   pSource, pData, pTempData: PByte;
4637   Row, RowSize, TempWidth, TempHeight: Integer;
4638   IntFormat: TglBitmapFormat;
4639   FormatDesc: TFormatDescriptor;
4640
4641   function GetRowPointer(Row: Integer): pByte;
4642   begin
4643     result := aSurface^.pixels;
4644     Inc(result, Row * RowSize);
4645   end;
4646
4647 begin
4648   result := false;
4649   if (Assigned(aSurface)) then begin
4650     with aSurface^.format^ do begin
4651       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4652         FormatDesc := TFormatDescriptor.Get(IntFormat);
4653         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4654           break;
4655       end;
4656       if (IntFormat = tfEmpty) then
4657         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4658     end;
4659
4660     TempWidth  := aSurface^.w;
4661     TempHeight := aSurface^.h;
4662     RowSize := FormatDesc.GetSize(TempWidth, 1);
4663     GetMem(pData, TempHeight * RowSize);
4664     try
4665       pTempData := pData;
4666       for Row := 0 to TempHeight -1 do begin
4667         pSource := GetRowPointer(Row);
4668         if (Assigned(pSource)) then begin
4669           Move(pSource^, pTempData^, RowSize);
4670           Inc(pTempData, RowSize);
4671         end;
4672       end;
4673       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4674       result := true;
4675     except
4676       if Assigned(pData) then
4677         FreeMem(pData);
4678       raise;
4679     end;
4680   end;
4681 end;
4682
4683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4684 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4685 var
4686   Row, Col, AlphaInterleave: Integer;
4687   pSource, pDest: PByte;
4688
4689   function GetRowPointer(Row: Integer): pByte;
4690   begin
4691     result := aSurface.pixels;
4692     Inc(result, Row * Width);
4693   end;
4694
4695 begin
4696   result := false;
4697   if Assigned(Data) then begin
4698     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4699       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4700
4701       AlphaInterleave := 0;
4702       case Format of
4703         tfLuminance8Alpha8:
4704           AlphaInterleave := 1;
4705         tfBGRA8, tfRGBA8:
4706           AlphaInterleave := 3;
4707       end;
4708
4709       pSource := Data;
4710       for Row := 0 to Height -1 do begin
4711         pDest := GetRowPointer(Row);
4712         if Assigned(pDest) then begin
4713           for Col := 0 to Width -1 do begin
4714             Inc(pSource, AlphaInterleave);
4715             pDest^ := pSource^;
4716             Inc(pDest);
4717             Inc(pSource);
4718           end;
4719         end;
4720       end;
4721       result := true;
4722     end;
4723   end;
4724 end;
4725
4726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4727 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4728 var
4729   bmp: TglBitmap2D;
4730 begin
4731   bmp := TglBitmap2D.Create;
4732   try
4733     bmp.AssignFromSurface(aSurface);
4734     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4735   finally
4736     bmp.Free;
4737   end;
4738 end;
4739 {$ENDIF}
4740
4741 {$IFDEF GLB_DELPHI}
4742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4743 function CreateGrayPalette: HPALETTE;
4744 var
4745   Idx: Integer;
4746   Pal: PLogPalette;
4747 begin
4748   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4749
4750   Pal.palVersion := $300;
4751   Pal.palNumEntries := 256;
4752
4753   for Idx := 0 to Pal.palNumEntries - 1 do begin
4754     Pal.palPalEntry[Idx].peRed   := Idx;
4755     Pal.palPalEntry[Idx].peGreen := Idx;
4756     Pal.palPalEntry[Idx].peBlue  := Idx;
4757     Pal.palPalEntry[Idx].peFlags := 0;
4758   end;
4759   Result := CreatePalette(Pal^);
4760   FreeMem(Pal);
4761 end;
4762
4763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4764 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4765 var
4766   Row: Integer;
4767   pSource, pData: PByte;
4768 begin
4769   result := false;
4770   if Assigned(Data) then begin
4771     if Assigned(aBitmap) then begin
4772       aBitmap.Width  := Width;
4773       aBitmap.Height := Height;
4774
4775       case Format of
4776         tfAlpha8, tfLuminance8: begin
4777           aBitmap.PixelFormat := pf8bit;
4778           aBitmap.Palette     := CreateGrayPalette;
4779         end;
4780         tfRGB5A1:
4781           aBitmap.PixelFormat := pf15bit;
4782         tfR5G6B5:
4783           aBitmap.PixelFormat := pf16bit;
4784         tfRGB8, tfBGR8:
4785           aBitmap.PixelFormat := pf24bit;
4786         tfRGBA8, tfBGRA8:
4787           aBitmap.PixelFormat := pf32bit;
4788       else
4789         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4790       end;
4791
4792       pSource := Data;
4793       for Row := 0 to FileHeight -1 do begin
4794         pData := aBitmap.Scanline[Row];
4795         Move(pSource^, pData^, fRowSize);
4796         Inc(pSource, fRowSize);
4797         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4798           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4799       end;
4800       result := true;
4801     end;
4802   end;
4803 end;
4804
4805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4806 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4807 var
4808   pSource, pData, pTempData: PByte;
4809   Row, RowSize, TempWidth, TempHeight: Integer;
4810   IntFormat: TglBitmapFormat;
4811 begin
4812   result := false;
4813
4814   if (Assigned(aBitmap)) then begin
4815     case aBitmap.PixelFormat of
4816       pf8bit:
4817         IntFormat := tfLuminance8;
4818       pf15bit:
4819         IntFormat := tfRGB5A1;
4820       pf16bit:
4821         IntFormat := tfR5G6B5;
4822       pf24bit:
4823         IntFormat := tfBGR8;
4824       pf32bit:
4825         IntFormat := tfBGRA8;
4826     else
4827       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4828     end;
4829
4830     TempWidth  := aBitmap.Width;
4831     TempHeight := aBitmap.Height;
4832     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4833     GetMem(pData, TempHeight * RowSize);
4834     try
4835       pTempData := pData;
4836       for Row := 0 to TempHeight -1 do begin
4837         pSource := aBitmap.Scanline[Row];
4838         if (Assigned(pSource)) then begin
4839           Move(pSource^, pTempData^, RowSize);
4840           Inc(pTempData, RowSize);
4841         end;
4842       end;
4843       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4844       result := true;
4845     except
4846       if Assigned(pData) then
4847         FreeMem(pData);
4848       raise;
4849     end;
4850   end;
4851 end;
4852
4853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4854 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4855 var
4856   Row, Col, AlphaInterleave: Integer;
4857   pSource, pDest: PByte;
4858 begin
4859   result := false;
4860
4861   if Assigned(Data) then begin
4862     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4863       if Assigned(aBitmap) then begin
4864         aBitmap.PixelFormat := pf8bit;
4865         aBitmap.Palette     := CreateGrayPalette;
4866         aBitmap.Width       := Width;
4867         aBitmap.Height      := Height;
4868
4869         case Format of
4870           tfLuminance8Alpha8:
4871             AlphaInterleave := 1;
4872           tfRGBA8, tfBGRA8:
4873             AlphaInterleave := 3;
4874           else
4875             AlphaInterleave := 0;
4876         end;
4877
4878         // Copy Data
4879         pSource := Data;
4880
4881         for Row := 0 to Height -1 do begin
4882           pDest := aBitmap.Scanline[Row];
4883           if Assigned(pDest) then begin
4884             for Col := 0 to Width -1 do begin
4885               Inc(pSource, AlphaInterleave);
4886               pDest^ := pSource^;
4887               Inc(pDest);
4888               Inc(pSource);
4889             end;
4890           end;
4891         end;
4892         result := true;
4893       end;
4894     end;
4895   end;
4896 end;
4897
4898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4899 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4900 var
4901   tex: TglBitmap2D;
4902 begin
4903   tex := TglBitmap2D.Create;
4904   try
4905     tex.AssignFromBitmap(ABitmap);
4906     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4907   finally
4908     tex.Free;
4909   end;
4910 end;
4911 {$ENDIF}
4912
4913 {$IFDEF GLB_LAZARUS}
4914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4915 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4916 var
4917   rid: TRawImageDescription;
4918   FormatDesc: TFormatDescriptor;
4919 begin
4920   result := false;
4921   if not Assigned(aImage) or (Format = tfEmpty) then
4922     exit;
4923   FormatDesc := TFormatDescriptor.Get(Format);
4924   if FormatDesc.IsCompressed then
4925     exit;
4926
4927   FillChar(rid{%H-}, SizeOf(rid), 0);
4928   if (Format in [
4929        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4930        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4931        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4932     rid.Format := ricfGray
4933   else
4934     rid.Format := ricfRGBA;
4935
4936   rid.Width        := Width;
4937   rid.Height       := Height;
4938   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4939   rid.BitOrder     := riboBitsInOrder;
4940   rid.ByteOrder    := riboLSBFirst;
4941   rid.LineOrder    := riloTopToBottom;
4942   rid.LineEnd      := rileTight;
4943   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4944   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4945   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4946   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4947   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4948   rid.RedShift     := FormatDesc.Shift.r;
4949   rid.GreenShift   := FormatDesc.Shift.g;
4950   rid.BlueShift    := FormatDesc.Shift.b;
4951   rid.AlphaShift   := FormatDesc.Shift.a;
4952
4953   rid.MaskBitsPerPixel  := 0;
4954   rid.PaletteColorCount := 0;
4955
4956   aImage.DataDescription := rid;
4957   aImage.CreateData;
4958
4959   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4960
4961   result := true;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4966 var
4967   f: TglBitmapFormat;
4968   FormatDesc: TFormatDescriptor;
4969   ImageData: PByte;
4970   ImageSize: Integer;
4971 begin
4972   result := false;
4973   if not Assigned(aImage) then
4974     exit;
4975   for f := High(f) downto Low(f) do begin
4976     FormatDesc := TFormatDescriptor.Get(f);
4977     with aImage.DataDescription do
4978       if FormatDesc.MaskMatch(
4979         (QWord(1 shl RedPrec  )-1) shl RedShift,
4980         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4981         (QWord(1 shl BluePrec )-1) shl BlueShift,
4982         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4983         break;
4984   end;
4985
4986   if (f = tfEmpty) then
4987     exit;
4988
4989   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4990   ImageData := GetMem(ImageSize);
4991   try
4992     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4993     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4994   except
4995     if Assigned(ImageData) then
4996       FreeMem(ImageData);
4997     raise;
4998   end;
4999
5000   result := true;
5001 end;
5002
5003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5004 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5005 var
5006   rid: TRawImageDescription;
5007   FormatDesc: TFormatDescriptor;
5008   Pixel: TglBitmapPixelData;
5009   x, y: Integer;
5010   srcMD: Pointer;
5011   src, dst: PByte;
5012 begin
5013   result := false;
5014   if not Assigned(aImage) or (Format = tfEmpty) then
5015     exit;
5016   FormatDesc := TFormatDescriptor.Get(Format);
5017   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5018     exit;
5019
5020   FillChar(rid{%H-}, SizeOf(rid), 0);
5021   rid.Format       := ricfGray;
5022   rid.Width        := Width;
5023   rid.Height       := Height;
5024   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5025   rid.BitOrder     := riboBitsInOrder;
5026   rid.ByteOrder    := riboLSBFirst;
5027   rid.LineOrder    := riloTopToBottom;
5028   rid.LineEnd      := rileTight;
5029   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5030   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5031   rid.GreenPrec    := 0;
5032   rid.BluePrec     := 0;
5033   rid.AlphaPrec    := 0;
5034   rid.RedShift     := 0;
5035   rid.GreenShift   := 0;
5036   rid.BlueShift    := 0;
5037   rid.AlphaShift   := 0;
5038
5039   rid.MaskBitsPerPixel  := 0;
5040   rid.PaletteColorCount := 0;
5041
5042   aImage.DataDescription := rid;
5043   aImage.CreateData;
5044
5045   srcMD := FormatDesc.CreateMappingData;
5046   try
5047     FormatDesc.PreparePixel(Pixel);
5048     src := Data;
5049     dst := aImage.PixelData;
5050     for y := 0 to Height-1 do
5051       for x := 0 to Width-1 do begin
5052         FormatDesc.Unmap(src, Pixel, srcMD);
5053         case rid.BitsPerPixel of
5054            8: begin
5055             dst^ := Pixel.Data.a;
5056             inc(dst);
5057           end;
5058           16: begin
5059             PWord(dst)^ := Pixel.Data.a;
5060             inc(dst, 2);
5061           end;
5062           24: begin
5063             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5064             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5065             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5066             inc(dst, 3);
5067           end;
5068           32: begin
5069             PCardinal(dst)^ := Pixel.Data.a;
5070             inc(dst, 4);
5071           end;
5072         else
5073           raise EglBitmapUnsupportedFormat.Create(Format);
5074         end;
5075       end;
5076   finally
5077     FormatDesc.FreeMappingData(srcMD);
5078   end;
5079   result := true;
5080 end;
5081
5082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5083 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5084 var
5085   tex: TglBitmap2D;
5086 begin
5087   tex := TglBitmap2D.Create;
5088   try
5089     tex.AssignFromLazIntfImage(aImage);
5090     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5091   finally
5092     tex.Free;
5093   end;
5094 end;
5095 {$ENDIF}
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5099   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5100 var
5101   rs: TResourceStream;
5102 begin
5103   PrepareResType(aResource, aResType);
5104   rs := TResourceStream.Create(aInstance, aResource, aResType);
5105   try
5106     result := AddAlphaFromStream(rs, aFunc, aArgs);
5107   finally
5108     rs.Free;
5109   end;
5110 end;
5111
5112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5113 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5114   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5115 var
5116   rs: TResourceStream;
5117 begin
5118   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5119   try
5120     result := AddAlphaFromStream(rs, aFunc, aArgs);
5121   finally
5122     rs.Free;
5123   end;
5124 end;
5125
5126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5127 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5128 begin
5129   if TFormatDescriptor.Get(Format).IsCompressed then
5130     raise EglBitmapUnsupportedFormat.Create(Format);
5131   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5132 end;
5133
5134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5135 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5136 var
5137   FS: TFileStream;
5138 begin
5139   FS := TFileStream.Create(aFileName, fmOpenRead);
5140   try
5141     result := AddAlphaFromStream(FS, aFunc, aArgs);
5142   finally
5143     FS.Free;
5144   end;
5145 end;
5146
5147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5148 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5149 var
5150   tex: TglBitmap2D;
5151 begin
5152   tex := TglBitmap2D.Create(aStream);
5153   try
5154     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5155   finally
5156     tex.Free;
5157   end;
5158 end;
5159
5160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5161 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5162 var
5163   DestData, DestData2, SourceData: pByte;
5164   TempHeight, TempWidth: Integer;
5165   SourceFD, DestFD: TFormatDescriptor;
5166   SourceMD, DestMD, DestMD2: Pointer;
5167
5168   FuncRec: TglBitmapFunctionRec;
5169 begin
5170   result := false;
5171
5172   Assert(Assigned(Data));
5173   Assert(Assigned(aBitmap));
5174   Assert(Assigned(aBitmap.Data));
5175
5176   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5177     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5178
5179     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5180     DestFD   := TFormatDescriptor.Get(Format);
5181
5182     if not Assigned(aFunc) then begin
5183       aFunc        := glBitmapAlphaFunc;
5184       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5185     end else
5186       FuncRec.Args := aArgs;
5187
5188     // Values
5189     TempHeight := aBitmap.FileHeight;
5190     TempWidth  := aBitmap.FileWidth;
5191
5192     FuncRec.Sender          := Self;
5193     FuncRec.Size            := Dimension;
5194     FuncRec.Position.Fields := FuncRec.Size.Fields;
5195
5196     DestData   := Data;
5197     DestData2  := Data;
5198     SourceData := aBitmap.Data;
5199
5200     // Mapping
5201     SourceFD.PreparePixel(FuncRec.Source);
5202     DestFD.PreparePixel  (FuncRec.Dest);
5203
5204     SourceMD := SourceFD.CreateMappingData;
5205     DestMD   := DestFD.CreateMappingData;
5206     DestMD2  := DestFD.CreateMappingData;
5207     try
5208       FuncRec.Position.Y := 0;
5209       while FuncRec.Position.Y < TempHeight do begin
5210         FuncRec.Position.X := 0;
5211         while FuncRec.Position.X < TempWidth do begin
5212           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5213           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5214           aFunc(FuncRec);
5215           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5216           inc(FuncRec.Position.X);
5217         end;
5218         inc(FuncRec.Position.Y);
5219       end;
5220     finally
5221       SourceFD.FreeMappingData(SourceMD);
5222       DestFD.FreeMappingData(DestMD);
5223       DestFD.FreeMappingData(DestMD2);
5224     end;
5225   end;
5226 end;
5227
5228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5229 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5230 begin
5231   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5232 end;
5233
5234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5235 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5236 var
5237   PixelData: TglBitmapPixelData;
5238 begin
5239   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5240   result := AddAlphaFromColorKeyFloat(
5241     aRed   / PixelData.Range.r,
5242     aGreen / PixelData.Range.g,
5243     aBlue  / PixelData.Range.b,
5244     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5245 end;
5246
5247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5248 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5249 var
5250   values: array[0..2] of Single;
5251   tmp: Cardinal;
5252   i: Integer;
5253   PixelData: TglBitmapPixelData;
5254 begin
5255   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5256   with PixelData do begin
5257     values[0] := aRed;
5258     values[1] := aGreen;
5259     values[2] := aBlue;
5260
5261     for i := 0 to 2 do begin
5262       tmp          := Trunc(Range.arr[i] * aDeviation);
5263       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5264       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5265     end;
5266     Data.a  := 0;
5267     Range.a := 0;
5268   end;
5269   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5270 end;
5271
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5274 begin
5275   result := AddAlphaFromValueFloat(aAlpha / $FF);
5276 end;
5277
5278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5279 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5280 var
5281   PixelData: TglBitmapPixelData;
5282 begin
5283   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5284   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5285 end;
5286
5287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5288 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5289 var
5290   PixelData: TglBitmapPixelData;
5291 begin
5292   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5293   with PixelData do
5294     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5295   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 function TglBitmap.RemoveAlpha: Boolean;
5300 var
5301   FormatDesc: TFormatDescriptor;
5302 begin
5303   result := false;
5304   FormatDesc := TFormatDescriptor.Get(Format);
5305   if Assigned(Data) then begin
5306     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5307       raise EglBitmapUnsupportedFormat.Create(Format);
5308     result := ConvertTo(FormatDesc.WithoutAlpha);
5309   end;
5310 end;
5311
5312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5313 function TglBitmap.Clone: TglBitmap;
5314 var
5315   Temp: TglBitmap;
5316   TempPtr: PByte;
5317   Size: Integer;
5318 begin
5319   result := nil;
5320   Temp := (ClassType.Create as TglBitmap);
5321   try
5322     // copy texture data if assigned
5323     if Assigned(Data) then begin
5324       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5325       GetMem(TempPtr, Size);
5326       try
5327         Move(Data^, TempPtr^, Size);
5328         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5329       except
5330         if Assigned(TempPtr) then
5331           FreeMem(TempPtr);
5332         raise;
5333       end;
5334     end else begin
5335       TempPtr := nil;
5336       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5337     end;
5338
5339         // copy properties
5340     Temp.fID                      := ID;
5341     Temp.fTarget                  := Target;
5342     Temp.fFormat                  := Format;
5343     Temp.fMipMap                  := MipMap;
5344     Temp.fAnisotropic             := Anisotropic;
5345     Temp.fBorderColor             := fBorderColor;
5346     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5347     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5348     Temp.fFilterMin               := fFilterMin;
5349     Temp.fFilterMag               := fFilterMag;
5350     Temp.fWrapS                   := fWrapS;
5351     Temp.fWrapT                   := fWrapT;
5352     Temp.fWrapR                   := fWrapR;
5353     Temp.fFilename                := fFilename;
5354     Temp.fCustomName              := fCustomName;
5355     Temp.fCustomNameW             := fCustomNameW;
5356     Temp.fCustomData              := fCustomData;
5357
5358     result := Temp;
5359   except
5360     FreeAndNil(Temp);
5361     raise;
5362   end;
5363 end;
5364
5365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5366 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5367 var
5368   SourceFD, DestFD: TFormatDescriptor;
5369   SourcePD, DestPD: TglBitmapPixelData;
5370   ShiftData: TShiftData;
5371
5372   function CanCopyDirect: Boolean;
5373   begin
5374     result :=
5375       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5376       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5377       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5378       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5379   end;
5380
5381   function CanShift: Boolean;
5382   begin
5383     result :=
5384       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5385       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5386       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5387       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5388   end;
5389
5390   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5391   begin
5392     result := 0;
5393     while (aSource > aDest) and (aSource > 0) do begin
5394       inc(result);
5395       aSource := aSource shr 1;
5396     end;
5397   end;
5398
5399 begin
5400   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5401     SourceFD := TFormatDescriptor.Get(Format);
5402     DestFD   := TFormatDescriptor.Get(aFormat);
5403
5404     SourceFD.PreparePixel(SourcePD);
5405     DestFD.PreparePixel  (DestPD);
5406
5407     if CanCopyDirect then
5408       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5409     else if CanShift then begin
5410       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5411       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5412       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5413       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5414       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5415     end else
5416       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5417   end else
5418     result := true;
5419 end;
5420
5421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5422 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5423 begin
5424   if aUseRGB or aUseAlpha then
5425     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5426       ((Byte(aUseAlpha) and 1) shl 1) or
5427        (Byte(aUseRGB)   and 1)      ));
5428 end;
5429
5430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5431 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5432 begin
5433   fBorderColor[0] := aRed;
5434   fBorderColor[1] := aGreen;
5435   fBorderColor[2] := aBlue;
5436   fBorderColor[3] := aAlpha;
5437   if (ID > 0) then begin
5438     Bind(false);
5439     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5440   end;
5441 end;
5442
5443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5444 procedure TglBitmap.FreeData;
5445 var
5446   TempPtr: PByte;
5447 begin
5448   TempPtr := nil;
5449   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5450 end;
5451
5452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5453 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5454   const aAlpha: Byte);
5455 begin
5456   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5457 end;
5458
5459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5460 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5461 var
5462   PixelData: TglBitmapPixelData;
5463 begin
5464   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5465   FillWithColorFloat(
5466     aRed   / PixelData.Range.r,
5467     aGreen / PixelData.Range.g,
5468     aBlue  / PixelData.Range.b,
5469     aAlpha / PixelData.Range.a);
5470 end;
5471
5472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5473 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5474 var
5475   PixelData: TglBitmapPixelData;
5476 begin
5477   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5478   with PixelData do begin
5479     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5480     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5481     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5482     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5483   end;
5484   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5485 end;
5486
5487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5488 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5489 begin
5490   //check MIN filter
5491   case aMin of
5492     GL_NEAREST:
5493       fFilterMin := GL_NEAREST;
5494     GL_LINEAR:
5495       fFilterMin := GL_LINEAR;
5496     GL_NEAREST_MIPMAP_NEAREST:
5497       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5498     GL_LINEAR_MIPMAP_NEAREST:
5499       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5500     GL_NEAREST_MIPMAP_LINEAR:
5501       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5502     GL_LINEAR_MIPMAP_LINEAR:
5503       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5504     else
5505       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5506   end;
5507
5508   //check MAG filter
5509   case aMag of
5510     GL_NEAREST:
5511       fFilterMag := GL_NEAREST;
5512     GL_LINEAR:
5513       fFilterMag := GL_LINEAR;
5514     else
5515       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5516   end;
5517
5518   //apply filter
5519   if (ID > 0) then begin
5520     Bind(false);
5521     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5522
5523     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5524       case fFilterMin of
5525         GL_NEAREST, GL_LINEAR:
5526           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5527         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5528           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5529         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5530           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5531       end;
5532     end else
5533       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5534   end;
5535 end;
5536
5537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5538 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5539
5540   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5541   begin
5542     case aValue of
5543       GL_CLAMP:
5544         aTarget := GL_CLAMP;
5545
5546       GL_REPEAT:
5547         aTarget := GL_REPEAT;
5548
5549       GL_CLAMP_TO_EDGE: begin
5550         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5551           aTarget := GL_CLAMP_TO_EDGE
5552         else
5553           aTarget := GL_CLAMP;
5554       end;
5555
5556       GL_CLAMP_TO_BORDER: begin
5557         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5558           aTarget := GL_CLAMP_TO_BORDER
5559         else
5560           aTarget := GL_CLAMP;
5561       end;
5562
5563       GL_MIRRORED_REPEAT: begin
5564         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5565           aTarget := GL_MIRRORED_REPEAT
5566         else
5567           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5568       end;
5569     else
5570       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5571     end;
5572   end;
5573
5574 begin
5575   CheckAndSetWrap(S, fWrapS);
5576   CheckAndSetWrap(T, fWrapT);
5577   CheckAndSetWrap(R, fWrapR);
5578
5579   if (ID > 0) then begin
5580     Bind(false);
5581     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5582     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5583     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5584   end;
5585 end;
5586
5587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5588 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5589
5590   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5591   begin
5592     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5593        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5594       fSwizzle[aIndex] := aValue
5595     else
5596       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5597   end;
5598
5599 begin
5600   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5601     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5602   CheckAndSetValue(r, 0);
5603   CheckAndSetValue(g, 1);
5604   CheckAndSetValue(b, 2);
5605   CheckAndSetValue(a, 3);
5606
5607   if (ID > 0) then begin
5608     Bind(false);
5609     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5610   end;
5611 end;
5612
5613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5614 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5615 begin
5616   if aEnableTextureUnit then
5617     glEnable(Target);
5618   if (ID > 0) then
5619     glBindTexture(Target, ID);
5620 end;
5621
5622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5623 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5624 begin
5625   if aDisableTextureUnit then
5626     glDisable(Target);
5627   glBindTexture(Target, 0);
5628 end;
5629
5630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5631 constructor TglBitmap.Create;
5632 begin
5633   if (ClassType = TglBitmap) then
5634     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5635 {$IFDEF GLB_NATIVE_OGL}
5636   glbReadOpenGLExtensions;
5637 {$ENDIF}
5638   inherited Create;
5639   fFormat            := glBitmapGetDefaultFormat;
5640   fFreeDataOnDestroy := true;
5641 end;
5642
5643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5644 constructor TglBitmap.Create(const aFileName: String);
5645 begin
5646   Create;
5647   LoadFromFile(aFileName);
5648 end;
5649
5650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5651 constructor TglBitmap.Create(const aStream: TStream);
5652 begin
5653   Create;
5654   LoadFromStream(aStream);
5655 end;
5656
5657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5658 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
5659 var
5660   ImageSize: Integer;
5661 begin
5662   Create;
5663   if not Assigned(aData) then begin
5664     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5665     GetMem(aData, ImageSize);
5666     try
5667       FillChar(aData^, ImageSize, #$FF);
5668       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5669     except
5670       if Assigned(aData) then
5671         FreeMem(aData);
5672       raise;
5673     end;
5674   end else begin
5675     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5676     fFreeDataOnDestroy := false;
5677   end;
5678 end;
5679
5680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5681 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5682 begin
5683   Create;
5684   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5685 end;
5686
5687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5688 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5689 begin
5690   Create;
5691   LoadFromResource(aInstance, aResource, aResType);
5692 end;
5693
5694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5695 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5696 begin
5697   Create;
5698   LoadFromResourceID(aInstance, aResourceID, aResType);
5699 end;
5700
5701 {$IFDEF GLB_SUPPORT_PNG_READ}
5702 {$IF DEFINED(GLB_LAZ_PNG)}
5703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5704 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5706 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5707 const
5708   MAGIC_LEN = 8;
5709   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5710 var
5711   png: TPortableNetworkGraphic;
5712   intf: TLazIntfImage;
5713   StreamPos: Int64;
5714   magic: String[MAGIC_LEN];
5715 begin
5716   result := true;
5717   StreamPos := aStream.Position;
5718
5719   SetLength(magic, MAGIC_LEN);
5720   aStream.Read(magic[1], MAGIC_LEN);
5721   aStream.Position := StreamPos;
5722   if (magic <> PNG_MAGIC) then begin
5723     result := false;
5724     exit;
5725   end;
5726
5727   png := TPortableNetworkGraphic.Create;
5728   try try
5729     png.LoadFromStream(aStream);
5730     intf := png.CreateIntfImage;
5731     try try
5732       AssignFromLazIntfImage(intf);
5733     except
5734       result := false;
5735       aStream.Position := StreamPos;
5736       exit;
5737     end;
5738     finally
5739       intf.Free;
5740     end;
5741   except
5742     result := false;
5743     aStream.Position := StreamPos;
5744     exit;
5745   end;
5746   finally
5747     png.Free;
5748   end;
5749 end;
5750
5751 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5753 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5754 var
5755   Surface: PSDL_Surface;
5756   RWops: PSDL_RWops;
5757 begin
5758   result := false;
5759   RWops := glBitmapCreateRWops(aStream);
5760   try
5761     if IMG_isPNG(RWops) > 0 then begin
5762       Surface := IMG_LoadPNG_RW(RWops);
5763       try
5764         AssignFromSurface(Surface);
5765         result := true;
5766       finally
5767         SDL_FreeSurface(Surface);
5768       end;
5769     end;
5770   finally
5771     SDL_FreeRW(RWops);
5772   end;
5773 end;
5774
5775 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5777 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5778 begin
5779   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5780 end;
5781
5782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5783 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5784 var
5785   StreamPos: Int64;
5786   signature: array [0..7] of byte;
5787   png: png_structp;
5788   png_info: png_infop;
5789
5790   TempHeight, TempWidth: Integer;
5791   Format: TglBitmapFormat;
5792
5793   png_data: pByte;
5794   png_rows: array of pByte;
5795   Row, LineSize: Integer;
5796 begin
5797   result := false;
5798
5799   if not init_libPNG then
5800     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5801
5802   try
5803     // signature
5804     StreamPos := aStream.Position;
5805     aStream.Read(signature{%H-}, 8);
5806     aStream.Position := StreamPos;
5807
5808     if png_check_sig(@signature, 8) <> 0 then begin
5809       // png read struct
5810       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5811       if png = nil then
5812         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5813
5814       // png info
5815       png_info := png_create_info_struct(png);
5816       if png_info = nil then begin
5817         png_destroy_read_struct(@png, nil, nil);
5818         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5819       end;
5820
5821       // set read callback
5822       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5823
5824       // read informations
5825       png_read_info(png, png_info);
5826
5827       // size
5828       TempHeight := png_get_image_height(png, png_info);
5829       TempWidth := png_get_image_width(png, png_info);
5830
5831       // format
5832       case png_get_color_type(png, png_info) of
5833         PNG_COLOR_TYPE_GRAY:
5834           Format := tfLuminance8;
5835         PNG_COLOR_TYPE_GRAY_ALPHA:
5836           Format := tfLuminance8Alpha8;
5837         PNG_COLOR_TYPE_RGB:
5838           Format := tfRGB8;
5839         PNG_COLOR_TYPE_RGB_ALPHA:
5840           Format := tfRGBA8;
5841         else
5842           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5843       end;
5844
5845       // cut upper 8 bit from 16 bit formats
5846       if png_get_bit_depth(png, png_info) > 8 then
5847         png_set_strip_16(png);
5848
5849       // expand bitdepth smaller than 8
5850       if png_get_bit_depth(png, png_info) < 8 then
5851         png_set_expand(png);
5852
5853       // allocating mem for scanlines
5854       LineSize := png_get_rowbytes(png, png_info);
5855       GetMem(png_data, TempHeight * LineSize);
5856       try
5857         SetLength(png_rows, TempHeight);
5858         for Row := Low(png_rows) to High(png_rows) do begin
5859           png_rows[Row] := png_data;
5860           Inc(png_rows[Row], Row * LineSize);
5861         end;
5862
5863         // read complete image into scanlines
5864         png_read_image(png, @png_rows[0]);
5865
5866         // read end
5867         png_read_end(png, png_info);
5868
5869         // destroy read struct
5870         png_destroy_read_struct(@png, @png_info, nil);
5871
5872         SetLength(png_rows, 0);
5873
5874         // set new data
5875         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5876
5877         result := true;
5878       except
5879         if Assigned(png_data) then
5880           FreeMem(png_data);
5881         raise;
5882       end;
5883     end;
5884   finally
5885     quit_libPNG;
5886   end;
5887 end;
5888
5889 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5891 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5892 var
5893   StreamPos: Int64;
5894   Png: TPNGObject;
5895   Header: String[8];
5896   Row, Col, PixSize, LineSize: Integer;
5897   NewImage, pSource, pDest, pAlpha: pByte;
5898   PngFormat: TglBitmapFormat;
5899   FormatDesc: TFormatDescriptor;
5900
5901 const
5902   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5903
5904 begin
5905   result := false;
5906
5907   StreamPos := aStream.Position;
5908   aStream.Read(Header[0], SizeOf(Header));
5909   aStream.Position := StreamPos;
5910
5911   {Test if the header matches}
5912   if Header = PngHeader then begin
5913     Png := TPNGObject.Create;
5914     try
5915       Png.LoadFromStream(aStream);
5916
5917       case Png.Header.ColorType of
5918         COLOR_GRAYSCALE:
5919           PngFormat := tfLuminance8;
5920         COLOR_GRAYSCALEALPHA:
5921           PngFormat := tfLuminance8Alpha8;
5922         COLOR_RGB:
5923           PngFormat := tfBGR8;
5924         COLOR_RGBALPHA:
5925           PngFormat := tfBGRA8;
5926         else
5927           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5928       end;
5929
5930       FormatDesc := TFormatDescriptor.Get(PngFormat);
5931       PixSize    := Round(FormatDesc.PixelSize);
5932       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5933
5934       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5935       try
5936         pDest := NewImage;
5937
5938         case Png.Header.ColorType of
5939           COLOR_RGB, COLOR_GRAYSCALE:
5940             begin
5941               for Row := 0 to Png.Height -1 do begin
5942                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5943                 Inc(pDest, LineSize);
5944               end;
5945             end;
5946           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5947             begin
5948               PixSize := PixSize -1;
5949
5950               for Row := 0 to Png.Height -1 do begin
5951                 pSource := Png.Scanline[Row];
5952                 pAlpha := pByte(Png.AlphaScanline[Row]);
5953
5954                 for Col := 0 to Png.Width -1 do begin
5955                   Move (pSource^, pDest^, PixSize);
5956                   Inc(pSource, PixSize);
5957                   Inc(pDest, PixSize);
5958
5959                   pDest^ := pAlpha^;
5960                   inc(pAlpha);
5961                   Inc(pDest);
5962                 end;
5963               end;
5964             end;
5965           else
5966             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5967         end;
5968
5969         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5970
5971         result := true;
5972       except
5973         if Assigned(NewImage) then
5974           FreeMem(NewImage);
5975         raise;
5976       end;
5977     finally
5978       Png.Free;
5979     end;
5980   end;
5981 end;
5982 {$IFEND}
5983 {$ENDIF}
5984
5985 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5986 {$IFDEF GLB_LIB_PNG}
5987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5988 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5989 begin
5990   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5991 end;
5992 {$ENDIF}
5993
5994 {$IF DEFINED(GLB_LAZ_PNG)}
5995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5996 procedure TglBitmap.SavePNG(const aStream: TStream);
5997 var
5998   png: TPortableNetworkGraphic;
5999   intf: TLazIntfImage;
6000   raw: TRawImage;
6001 begin
6002   png  := TPortableNetworkGraphic.Create;
6003   intf := TLazIntfImage.Create(0, 0);
6004   try
6005     if not AssignToLazIntfImage(intf) then
6006       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6007     intf.GetRawImage(raw);
6008     png.LoadFromRawImage(raw, false);
6009     png.SaveToStream(aStream);
6010   finally
6011     png.Free;
6012     intf.Free;
6013   end;
6014 end;
6015
6016 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6018 procedure TglBitmap.SavePNG(const aStream: TStream);
6019 var
6020   png: png_structp;
6021   png_info: png_infop;
6022   png_rows: array of pByte;
6023   LineSize: Integer;
6024   ColorType: Integer;
6025   Row: Integer;
6026   FormatDesc: TFormatDescriptor;
6027 begin
6028   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6029     raise EglBitmapUnsupportedFormat.Create(Format);
6030
6031   if not init_libPNG then
6032     raise Exception.Create('unable to initialize libPNG.');
6033
6034   try
6035     case Format of
6036       tfAlpha8, tfLuminance8:
6037         ColorType := PNG_COLOR_TYPE_GRAY;
6038       tfLuminance8Alpha8:
6039         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6040       tfBGR8, tfRGB8:
6041         ColorType := PNG_COLOR_TYPE_RGB;
6042       tfBGRA8, tfRGBA8:
6043         ColorType := PNG_COLOR_TYPE_RGBA;
6044       else
6045         raise EglBitmapUnsupportedFormat.Create(Format);
6046     end;
6047
6048     FormatDesc := TFormatDescriptor.Get(Format);
6049     LineSize := FormatDesc.GetSize(Width, 1);
6050
6051     // creating array for scanline
6052     SetLength(png_rows, Height);
6053     try
6054       for Row := 0 to Height - 1 do begin
6055         png_rows[Row] := Data;
6056         Inc(png_rows[Row], Row * LineSize)
6057       end;
6058
6059       // write struct
6060       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6061       if png = nil then
6062         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6063
6064       // create png info
6065       png_info := png_create_info_struct(png);
6066       if png_info = nil then begin
6067         png_destroy_write_struct(@png, nil);
6068         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6069       end;
6070
6071       // set read callback
6072       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6073
6074       // set compression
6075       png_set_compression_level(png, 6);
6076
6077       if Format in [tfBGR8, tfBGRA8] then
6078         png_set_bgr(png);
6079
6080       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6081       png_write_info(png, png_info);
6082       png_write_image(png, @png_rows[0]);
6083       png_write_end(png, png_info);
6084       png_destroy_write_struct(@png, @png_info);
6085     finally
6086       SetLength(png_rows, 0);
6087     end;
6088   finally
6089     quit_libPNG;
6090   end;
6091 end;
6092
6093 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6095 procedure TglBitmap.SavePNG(const aStream: TStream);
6096 var
6097   Png: TPNGObject;
6098
6099   pSource, pDest: pByte;
6100   X, Y, PixSize: Integer;
6101   ColorType: Cardinal;
6102   Alpha: Boolean;
6103
6104   pTemp: pByte;
6105   Temp: Byte;
6106 begin
6107   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6108     raise EglBitmapUnsupportedFormat.Create(Format);
6109
6110   case Format of
6111     tfAlpha8, tfLuminance8: begin
6112       ColorType := COLOR_GRAYSCALE;
6113       PixSize   := 1;
6114       Alpha     := false;
6115     end;
6116     tfLuminance8Alpha8: begin
6117       ColorType := COLOR_GRAYSCALEALPHA;
6118       PixSize   := 1;
6119       Alpha     := true;
6120     end;
6121     tfBGR8, tfRGB8: begin
6122       ColorType := COLOR_RGB;
6123       PixSize   := 3;
6124       Alpha     := false;
6125     end;
6126     tfBGRA8, tfRGBA8: begin
6127       ColorType := COLOR_RGBALPHA;
6128       PixSize   := 3;
6129       Alpha     := true
6130     end;
6131   else
6132     raise EglBitmapUnsupportedFormat.Create(Format);
6133   end;
6134
6135   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6136   try
6137     // Copy ImageData
6138     pSource := Data;
6139     for Y := 0 to Height -1 do begin
6140       pDest := png.ScanLine[Y];
6141       for X := 0 to Width -1 do begin
6142         Move(pSource^, pDest^, PixSize);
6143         Inc(pDest, PixSize);
6144         Inc(pSource, PixSize);
6145         if Alpha then begin
6146           png.AlphaScanline[Y]^[X] := pSource^;
6147           Inc(pSource);
6148         end;
6149       end;
6150
6151       // convert RGB line to BGR
6152       if Format in [tfRGB8, tfRGBA8] then begin
6153         pTemp := png.ScanLine[Y];
6154         for X := 0 to Width -1 do begin
6155           Temp := pByteArray(pTemp)^[0];
6156           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6157           pByteArray(pTemp)^[2] := Temp;
6158           Inc(pTemp, 3);
6159         end;
6160       end;
6161     end;
6162
6163     // Save to Stream
6164     Png.CompressionLevel := 6;
6165     Png.SaveToStream(aStream);
6166   finally
6167     FreeAndNil(Png);
6168   end;
6169 end;
6170 {$IFEND}
6171 {$ENDIF}
6172
6173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6174 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6176 {$IFDEF GLB_LIB_JPEG}
6177 type
6178   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6179   glBitmap_libJPEG_source_mgr = record
6180     pub: jpeg_source_mgr;
6181
6182     SrcStream: TStream;
6183     SrcBuffer: array [1..4096] of byte;
6184   end;
6185
6186   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6187   glBitmap_libJPEG_dest_mgr = record
6188     pub: jpeg_destination_mgr;
6189
6190     DestStream: TStream;
6191     DestBuffer: array [1..4096] of byte;
6192   end;
6193
6194 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6195 begin
6196   //DUMMY
6197 end;
6198
6199
6200 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6201 begin
6202   //DUMMY
6203 end;
6204
6205
6206 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6207 begin
6208   //DUMMY
6209 end;
6210
6211 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6212 begin
6213   //DUMMY
6214 end;
6215
6216
6217 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6218 begin
6219   //DUMMY
6220 end;
6221
6222
6223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6224 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6225 var
6226   src: glBitmap_libJPEG_source_mgr_ptr;
6227   bytes: integer;
6228 begin
6229   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6230
6231   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6232         if (bytes <= 0) then begin
6233                 src^.SrcBuffer[1] := $FF;
6234                 src^.SrcBuffer[2] := JPEG_EOI;
6235                 bytes := 2;
6236         end;
6237
6238         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6239         src^.pub.bytes_in_buffer := bytes;
6240
6241   result := true;
6242 end;
6243
6244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6245 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6246 var
6247   src: glBitmap_libJPEG_source_mgr_ptr;
6248 begin
6249   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6250
6251   if num_bytes > 0 then begin
6252     // wanted byte isn't in buffer so set stream position and read buffer
6253     if num_bytes > src^.pub.bytes_in_buffer then begin
6254       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6255       src^.pub.fill_input_buffer(cinfo);
6256     end else begin
6257       // wanted byte is in buffer so only skip
6258                 inc(src^.pub.next_input_byte, num_bytes);
6259                 dec(src^.pub.bytes_in_buffer, num_bytes);
6260     end;
6261   end;
6262 end;
6263
6264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6265 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6266 var
6267   dest: glBitmap_libJPEG_dest_mgr_ptr;
6268 begin
6269   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6270
6271   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6272     // write complete buffer
6273     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6274
6275     // reset buffer
6276     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6277     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6278   end;
6279
6280   result := true;
6281 end;
6282
6283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6284 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6285 var
6286   Idx: Integer;
6287   dest: glBitmap_libJPEG_dest_mgr_ptr;
6288 begin
6289   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6290
6291   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6292     // check for endblock
6293     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6294       // write endblock
6295       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6296
6297       // leave
6298       break;
6299     end else
6300       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6301   end;
6302 end;
6303 {$ENDIF}
6304
6305 {$IFDEF GLB_SUPPORT_JPEG_READ}
6306 {$IF DEFINED(GLB_LAZ_JPEG)}
6307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6308 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6309 const
6310   MAGIC_LEN = 2;
6311   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6312 var
6313   jpeg: TJPEGImage;
6314   intf: TLazIntfImage;
6315   StreamPos: Int64;
6316   magic: String[MAGIC_LEN];
6317 begin
6318   result := true;
6319   StreamPos := aStream.Position;
6320
6321   SetLength(magic, MAGIC_LEN);
6322   aStream.Read(magic[1], MAGIC_LEN);
6323   aStream.Position := StreamPos;
6324   if (magic <> JPEG_MAGIC) then begin
6325     result := false;
6326     exit;
6327   end;
6328
6329   jpeg := TJPEGImage.Create;
6330   try try
6331     jpeg.LoadFromStream(aStream);
6332     intf := TLazIntfImage.Create(0, 0);
6333     try try
6334       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6335       AssignFromLazIntfImage(intf);
6336     except
6337       result := false;
6338       aStream.Position := StreamPos;
6339       exit;
6340     end;
6341     finally
6342       intf.Free;
6343     end;
6344   except
6345     result := false;
6346     aStream.Position := StreamPos;
6347     exit;
6348   end;
6349   finally
6350     jpeg.Free;
6351   end;
6352 end;
6353
6354 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6356 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6357 var
6358   Surface: PSDL_Surface;
6359   RWops: PSDL_RWops;
6360 begin
6361   result := false;
6362
6363   RWops := glBitmapCreateRWops(aStream);
6364   try
6365     if IMG_isJPG(RWops) > 0 then begin
6366       Surface := IMG_LoadJPG_RW(RWops);
6367       try
6368         AssignFromSurface(Surface);
6369         result := true;
6370       finally
6371         SDL_FreeSurface(Surface);
6372       end;
6373     end;
6374   finally
6375     SDL_FreeRW(RWops);
6376   end;
6377 end;
6378
6379 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6381 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6382 var
6383   StreamPos: Int64;
6384   Temp: array[0..1]of Byte;
6385
6386   jpeg: jpeg_decompress_struct;
6387   jpeg_err: jpeg_error_mgr;
6388
6389   IntFormat: TglBitmapFormat;
6390   pImage: pByte;
6391   TempHeight, TempWidth: Integer;
6392
6393   pTemp: pByte;
6394   Row: Integer;
6395
6396   FormatDesc: TFormatDescriptor;
6397 begin
6398   result := false;
6399
6400   if not init_libJPEG then
6401     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6402
6403   try
6404     // reading first two bytes to test file and set cursor back to begin
6405     StreamPos := aStream.Position;
6406     aStream.Read({%H-}Temp[0], 2);
6407     aStream.Position := StreamPos;
6408
6409     // if Bitmap then read file.
6410     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6411       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6412       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6413
6414       // error managment
6415       jpeg.err := jpeg_std_error(@jpeg_err);
6416       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6417       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6418
6419       // decompression struct
6420       jpeg_create_decompress(@jpeg);
6421
6422       // allocation space for streaming methods
6423       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6424
6425       // seeting up custom functions
6426       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6427         pub.init_source       := glBitmap_libJPEG_init_source;
6428         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6429         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6430         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6431         pub.term_source       := glBitmap_libJPEG_term_source;
6432
6433         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6434         pub.next_input_byte := nil;   // until buffer loaded
6435
6436         SrcStream := aStream;
6437       end;
6438
6439       // set global decoding state
6440       jpeg.global_state := DSTATE_START;
6441
6442       // read header of jpeg
6443       jpeg_read_header(@jpeg, false);
6444
6445       // setting output parameter
6446       case jpeg.jpeg_color_space of
6447         JCS_GRAYSCALE:
6448           begin
6449             jpeg.out_color_space := JCS_GRAYSCALE;
6450             IntFormat := tfLuminance8;
6451           end;
6452         else
6453           jpeg.out_color_space := JCS_RGB;
6454           IntFormat := tfRGB8;
6455       end;
6456
6457       // reading image
6458       jpeg_start_decompress(@jpeg);
6459
6460       TempHeight := jpeg.output_height;
6461       TempWidth := jpeg.output_width;
6462
6463       FormatDesc := TFormatDescriptor.Get(IntFormat);
6464
6465       // creating new image
6466       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6467       try
6468         pTemp := pImage;
6469
6470         for Row := 0 to TempHeight -1 do begin
6471           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6472           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6473         end;
6474
6475         // finish decompression
6476         jpeg_finish_decompress(@jpeg);
6477
6478         // destroy decompression
6479         jpeg_destroy_decompress(@jpeg);
6480
6481         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6482
6483         result := true;
6484       except
6485         if Assigned(pImage) then
6486           FreeMem(pImage);
6487         raise;
6488       end;
6489     end;
6490   finally
6491     quit_libJPEG;
6492   end;
6493 end;
6494
6495 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6497 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6498 var
6499   bmp: TBitmap;
6500   jpg: TJPEGImage;
6501   StreamPos: Int64;
6502   Temp: array[0..1]of Byte;
6503 begin
6504   result := false;
6505
6506   // reading first two bytes to test file and set cursor back to begin
6507   StreamPos := aStream.Position;
6508   aStream.Read(Temp[0], 2);
6509   aStream.Position := StreamPos;
6510
6511   // if Bitmap then read file.
6512   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6513     bmp := TBitmap.Create;
6514     try
6515       jpg := TJPEGImage.Create;
6516       try
6517         jpg.LoadFromStream(aStream);
6518         bmp.Assign(jpg);
6519         result := AssignFromBitmap(bmp);
6520       finally
6521         jpg.Free;
6522       end;
6523     finally
6524       bmp.Free;
6525     end;
6526   end;
6527 end;
6528 {$IFEND}
6529 {$ENDIF}
6530
6531 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6532 {$IF DEFINED(GLB_LAZ_JPEG)}
6533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6534 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6535 var
6536   jpeg: TJPEGImage;
6537   intf: TLazIntfImage;
6538   raw: TRawImage;
6539 begin
6540   jpeg := TJPEGImage.Create;
6541   intf := TLazIntfImage.Create(0, 0);
6542   try
6543     if not AssignToLazIntfImage(intf) then
6544       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6545     intf.GetRawImage(raw);
6546     jpeg.LoadFromRawImage(raw, false);
6547     jpeg.SaveToStream(aStream);
6548   finally
6549     intf.Free;
6550     jpeg.Free;
6551   end;
6552 end;
6553
6554 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6556 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6557 var
6558   jpeg: jpeg_compress_struct;
6559   jpeg_err: jpeg_error_mgr;
6560   Row: Integer;
6561   pTemp, pTemp2: pByte;
6562
6563   procedure CopyRow(pDest, pSource: pByte);
6564   var
6565     X: Integer;
6566   begin
6567     for X := 0 to Width - 1 do begin
6568       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6569       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6570       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6571       Inc(pDest, 3);
6572       Inc(pSource, 3);
6573     end;
6574   end;
6575
6576 begin
6577   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6578     raise EglBitmapUnsupportedFormat.Create(Format);
6579
6580   if not init_libJPEG then
6581     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6582
6583   try
6584     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6585     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6586
6587     // error managment
6588     jpeg.err := jpeg_std_error(@jpeg_err);
6589     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6590     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6591
6592     // compression struct
6593     jpeg_create_compress(@jpeg);
6594
6595     // allocation space for streaming methods
6596     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6597
6598     // seeting up custom functions
6599     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6600       pub.init_destination    := glBitmap_libJPEG_init_destination;
6601       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6602       pub.term_destination    := glBitmap_libJPEG_term_destination;
6603
6604       pub.next_output_byte  := @DestBuffer[1];
6605       pub.free_in_buffer    := Length(DestBuffer);
6606
6607       DestStream := aStream;
6608     end;
6609
6610     // very important state
6611     jpeg.global_state := CSTATE_START;
6612     jpeg.image_width  := Width;
6613     jpeg.image_height := Height;
6614     case Format of
6615       tfAlpha8, tfLuminance8: begin
6616         jpeg.input_components := 1;
6617         jpeg.in_color_space   := JCS_GRAYSCALE;
6618       end;
6619       tfRGB8, tfBGR8: begin
6620         jpeg.input_components := 3;
6621         jpeg.in_color_space   := JCS_RGB;
6622       end;
6623     end;
6624
6625     jpeg_set_defaults(@jpeg);
6626     jpeg_set_quality(@jpeg, 95, true);
6627     jpeg_start_compress(@jpeg, true);
6628     pTemp := Data;
6629
6630     if Format = tfBGR8 then
6631       GetMem(pTemp2, fRowSize)
6632     else
6633       pTemp2 := pTemp;
6634
6635     try
6636       for Row := 0 to jpeg.image_height -1 do begin
6637         // prepare row
6638         if Format = tfBGR8 then
6639           CopyRow(pTemp2, pTemp)
6640         else
6641           pTemp2 := pTemp;
6642
6643         // write row
6644         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6645         inc(pTemp, fRowSize);
6646       end;
6647     finally
6648       // free memory
6649       if Format = tfBGR8 then
6650         FreeMem(pTemp2);
6651     end;
6652     jpeg_finish_compress(@jpeg);
6653     jpeg_destroy_compress(@jpeg);
6654   finally
6655     quit_libJPEG;
6656   end;
6657 end;
6658
6659 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6661 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6662 var
6663   Bmp: TBitmap;
6664   Jpg: TJPEGImage;
6665 begin
6666   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6667     raise EglBitmapUnsupportedFormat.Create(Format);
6668
6669   Bmp := TBitmap.Create;
6670   try
6671     Jpg := TJPEGImage.Create;
6672     try
6673       AssignToBitmap(Bmp);
6674       if (Format in [tfAlpha8, tfLuminance8]) then begin
6675         Jpg.Grayscale   := true;
6676         Jpg.PixelFormat := jf8Bit;
6677       end;
6678       Jpg.Assign(Bmp);
6679       Jpg.SaveToStream(aStream);
6680     finally
6681       FreeAndNil(Jpg);
6682     end;
6683   finally
6684     FreeAndNil(Bmp);
6685   end;
6686 end;
6687 {$IFEND}
6688 {$ENDIF}
6689
6690 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6691 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6693 const
6694   BMP_MAGIC          = $4D42;
6695
6696   BMP_COMP_RGB       = 0;
6697   BMP_COMP_RLE8      = 1;
6698   BMP_COMP_RLE4      = 2;
6699   BMP_COMP_BITFIELDS = 3;
6700
6701 type
6702   TBMPHeader = packed record
6703     bfType: Word;
6704     bfSize: Cardinal;
6705     bfReserved1: Word;
6706     bfReserved2: Word;
6707     bfOffBits: Cardinal;
6708   end;
6709
6710   TBMPInfo = packed record
6711     biSize: Cardinal;
6712     biWidth: Longint;
6713     biHeight: Longint;
6714     biPlanes: Word;
6715     biBitCount: Word;
6716     biCompression: Cardinal;
6717     biSizeImage: Cardinal;
6718     biXPelsPerMeter: Longint;
6719     biYPelsPerMeter: Longint;
6720     biClrUsed: Cardinal;
6721     biClrImportant: Cardinal;
6722   end;
6723
6724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6725 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6726
6727   //////////////////////////////////////////////////////////////////////////////////////////////////
6728   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6729   begin
6730     result := tfEmpty;
6731     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6732     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6733
6734     //Read Compression
6735     case aInfo.biCompression of
6736       BMP_COMP_RLE4,
6737       BMP_COMP_RLE8: begin
6738         raise EglBitmap.Create('RLE compression is not supported');
6739       end;
6740       BMP_COMP_BITFIELDS: begin
6741         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6742           aStream.Read(aMask.r, SizeOf(aMask.r));
6743           aStream.Read(aMask.g, SizeOf(aMask.g));
6744           aStream.Read(aMask.b, SizeOf(aMask.b));
6745           aStream.Read(aMask.a, SizeOf(aMask.a));
6746         end else
6747           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6748       end;
6749     end;
6750
6751     //get suitable format
6752     case aInfo.biBitCount of
6753        8: result := tfLuminance8;
6754       16: result := tfBGR5;
6755       24: result := tfBGR8;
6756       32: result := tfBGRA8;
6757     end;
6758   end;
6759
6760   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6761   var
6762     i, c: Integer;
6763     ColorTable: TbmpColorTable;
6764   begin
6765     result := nil;
6766     if (aInfo.biBitCount >= 16) then
6767       exit;
6768     aFormat := tfLuminance8;
6769     c := aInfo.biClrUsed;
6770     if (c = 0) then
6771       c := 1 shl aInfo.biBitCount;
6772     SetLength(ColorTable, c);
6773     for i := 0 to c-1 do begin
6774       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6775       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6776         aFormat := tfRGB8;
6777     end;
6778
6779     result := TbmpColorTableFormat.Create;
6780     result.PixelSize  := aInfo.biBitCount / 8;
6781     result.ColorTable := ColorTable;
6782     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6783   end;
6784
6785   //////////////////////////////////////////////////////////////////////////////////////////////////
6786   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6787     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6788   var
6789     TmpFormat: TglBitmapFormat;
6790     FormatDesc: TFormatDescriptor;
6791   begin
6792     result := nil;
6793     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6794       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6795         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6796         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6797           aFormat := FormatDesc.Format;
6798           exit;
6799         end;
6800       end;
6801
6802       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6803         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6804       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6805         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6806
6807       result := TbmpBitfieldFormat.Create;
6808       result.PixelSize := aInfo.biBitCount / 8;
6809       result.RedMask   := aMask.r;
6810       result.GreenMask := aMask.g;
6811       result.BlueMask  := aMask.b;
6812       result.AlphaMask := aMask.a;
6813     end;
6814   end;
6815
6816 var
6817   //simple types
6818   StartPos: Int64;
6819   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6820   PaddingBuff: Cardinal;
6821   LineBuf, ImageData, TmpData: PByte;
6822   SourceMD, DestMD: Pointer;
6823   BmpFormat: TglBitmapFormat;
6824
6825   //records
6826   Mask: TglBitmapColorRec;
6827   Header: TBMPHeader;
6828   Info: TBMPInfo;
6829
6830   //classes
6831   SpecialFormat: TFormatDescriptor;
6832   FormatDesc: TFormatDescriptor;
6833
6834   //////////////////////////////////////////////////////////////////////////////////////////////////
6835   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6836   var
6837     i: Integer;
6838     Pixel: TglBitmapPixelData;
6839   begin
6840     aStream.Read(aLineBuf^, rbLineSize);
6841     SpecialFormat.PreparePixel(Pixel);
6842     for i := 0 to Info.biWidth-1 do begin
6843       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6844       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6845       FormatDesc.Map(Pixel, aData, DestMD);
6846     end;
6847   end;
6848
6849 begin
6850   result        := false;
6851   BmpFormat     := tfEmpty;
6852   SpecialFormat := nil;
6853   LineBuf       := nil;
6854   SourceMD      := nil;
6855   DestMD        := nil;
6856
6857   // Header
6858   StartPos := aStream.Position;
6859   aStream.Read(Header{%H-}, SizeOf(Header));
6860
6861   if Header.bfType = BMP_MAGIC then begin
6862     try try
6863       BmpFormat        := ReadInfo(Info, Mask);
6864       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6865       if not Assigned(SpecialFormat) then
6866         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6867       aStream.Position := StartPos + Header.bfOffBits;
6868
6869       if (BmpFormat <> tfEmpty) then begin
6870         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6871         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6872         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6873         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6874
6875         //get Memory
6876         DestMD    := FormatDesc.CreateMappingData;
6877         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6878         GetMem(ImageData, ImageSize);
6879         if Assigned(SpecialFormat) then begin
6880           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6881           SourceMD := SpecialFormat.CreateMappingData;
6882         end;
6883
6884         //read Data
6885         try try
6886           FillChar(ImageData^, ImageSize, $FF);
6887           TmpData := ImageData;
6888           if (Info.biHeight > 0) then
6889             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6890           for i := 0 to Abs(Info.biHeight)-1 do begin
6891             if Assigned(SpecialFormat) then
6892               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6893             else
6894               aStream.Read(TmpData^, wbLineSize);   //else only read data
6895             if (Info.biHeight > 0) then
6896               dec(TmpData, wbLineSize)
6897             else
6898               inc(TmpData, wbLineSize);
6899             aStream.Read(PaddingBuff{%H-}, Padding);
6900           end;
6901           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6902           result := true;
6903         finally
6904           if Assigned(LineBuf) then
6905             FreeMem(LineBuf);
6906           if Assigned(SourceMD) then
6907             SpecialFormat.FreeMappingData(SourceMD);
6908           FormatDesc.FreeMappingData(DestMD);
6909         end;
6910         except
6911           if Assigned(ImageData) then
6912             FreeMem(ImageData);
6913           raise;
6914         end;
6915       end else
6916         raise EglBitmap.Create('LoadBMP - No suitable format found');
6917     except
6918       aStream.Position := StartPos;
6919       raise;
6920     end;
6921     finally
6922       FreeAndNil(SpecialFormat);
6923     end;
6924   end
6925     else aStream.Position := StartPos;
6926 end;
6927
6928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6929 procedure TglBitmap.SaveBMP(const aStream: TStream);
6930 var
6931   Header: TBMPHeader;
6932   Info: TBMPInfo;
6933   Converter: TFormatDescriptor;
6934   FormatDesc: TFormatDescriptor;
6935   SourceFD, DestFD: Pointer;
6936   pData, srcData, dstData, ConvertBuffer: pByte;
6937
6938   Pixel: TglBitmapPixelData;
6939   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6940   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6941
6942   PaddingBuff: Cardinal;
6943
6944   function GetLineWidth : Integer;
6945   begin
6946     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6947   end;
6948
6949 begin
6950   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6951     raise EglBitmapUnsupportedFormat.Create(Format);
6952
6953   Converter  := nil;
6954   FormatDesc := TFormatDescriptor.Get(Format);
6955   ImageSize  := FormatDesc.GetSize(Dimension);
6956
6957   FillChar(Header{%H-}, SizeOf(Header), 0);
6958   Header.bfType      := BMP_MAGIC;
6959   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6960   Header.bfReserved1 := 0;
6961   Header.bfReserved2 := 0;
6962   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6963
6964   FillChar(Info{%H-}, SizeOf(Info), 0);
6965   Info.biSize        := SizeOf(Info);
6966   Info.biWidth       := Width;
6967   Info.biHeight      := Height;
6968   Info.biPlanes      := 1;
6969   Info.biCompression := BMP_COMP_RGB;
6970   Info.biSizeImage   := ImageSize;
6971
6972   try
6973     case Format of
6974       tfLuminance4: begin
6975         Info.biBitCount  := 4;
6976         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6977         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6978         Converter := TbmpColorTableFormat.Create;
6979         with (Converter as TbmpColorTableFormat) do begin
6980           PixelSize := 0.5;
6981           Format    := Format;
6982           Range     := glBitmapColorRec($F, $F, $F, $0);
6983           CreateColorTable;
6984         end;
6985       end;
6986
6987       tfR3G3B2, tfLuminance8: begin
6988         Info.biBitCount  :=  8;
6989         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6990         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6991         Converter := TbmpColorTableFormat.Create;
6992         with (Converter as TbmpColorTableFormat) do begin
6993           PixelSize := 1;
6994           Format    := Format;
6995           if (Format = tfR3G3B2) then begin
6996             Range := glBitmapColorRec($7, $7, $3, $0);
6997             Shift := glBitmapShiftRec(0, 3, 6, 0);
6998           end else
6999             Range := glBitmapColorRec($FF, $FF, $FF, $0);
7000           CreateColorTable;
7001         end;
7002       end;
7003
7004       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
7005       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
7006         Info.biBitCount    := 16;
7007         Info.biCompression := BMP_COMP_BITFIELDS;
7008       end;
7009
7010       tfBGR8, tfRGB8: begin
7011         Info.biBitCount := 24;
7012         if (Format = tfRGB8) then
7013           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
7014       end;
7015
7016       tfRGB10, tfRGB10A2, tfRGBA8,
7017       tfBGR10, tfBGR10A2, tfBGRA8: begin
7018         Info.biBitCount    := 32;
7019         Info.biCompression := BMP_COMP_BITFIELDS;
7020       end;
7021     else
7022       raise EglBitmapUnsupportedFormat.Create(Format);
7023     end;
7024     Info.biXPelsPerMeter := 2835;
7025     Info.biYPelsPerMeter := 2835;
7026
7027     // prepare bitmasks
7028     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7029       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7030       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7031
7032       RedMask    := FormatDesc.RedMask;
7033       GreenMask  := FormatDesc.GreenMask;
7034       BlueMask   := FormatDesc.BlueMask;
7035       AlphaMask  := FormatDesc.AlphaMask;
7036     end;
7037
7038     // headers
7039     aStream.Write(Header, SizeOf(Header));
7040     aStream.Write(Info, SizeOf(Info));
7041
7042     // colortable
7043     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7044       with (Converter as TbmpColorTableFormat) do
7045         aStream.Write(ColorTable[0].b,
7046           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7047
7048     // bitmasks
7049     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7050       aStream.Write(RedMask,   SizeOf(Cardinal));
7051       aStream.Write(GreenMask, SizeOf(Cardinal));
7052       aStream.Write(BlueMask,  SizeOf(Cardinal));
7053       aStream.Write(AlphaMask, SizeOf(Cardinal));
7054     end;
7055
7056     // image data
7057     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7058     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7059     Padding     := GetLineWidth - wbLineSize;
7060     PaddingBuff := 0;
7061
7062     pData := Data;
7063     inc(pData, (Height-1) * rbLineSize);
7064
7065     // prepare row buffer. But only for RGB because RGBA supports color masks
7066     // so it's possible to change color within the image.
7067     if Assigned(Converter) then begin
7068       FormatDesc.PreparePixel(Pixel);
7069       GetMem(ConvertBuffer, wbLineSize);
7070       SourceFD := FormatDesc.CreateMappingData;
7071       DestFD   := Converter.CreateMappingData;
7072     end else
7073       ConvertBuffer := nil;
7074
7075     try
7076       for LineIdx := 0 to Height - 1 do begin
7077         // preparing row
7078         if Assigned(Converter) then begin
7079           srcData := pData;
7080           dstData := ConvertBuffer;
7081           for PixelIdx := 0 to Info.biWidth-1 do begin
7082             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7083             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7084             Converter.Map(Pixel, dstData, DestFD);
7085           end;
7086           aStream.Write(ConvertBuffer^, wbLineSize);
7087         end else begin
7088           aStream.Write(pData^, rbLineSize);
7089         end;
7090         dec(pData, rbLineSize);
7091         if (Padding > 0) then
7092           aStream.Write(PaddingBuff, Padding);
7093       end;
7094     finally
7095       // destroy row buffer
7096       if Assigned(ConvertBuffer) then begin
7097         FormatDesc.FreeMappingData(SourceFD);
7098         Converter.FreeMappingData(DestFD);
7099         FreeMem(ConvertBuffer);
7100       end;
7101     end;
7102   finally
7103     if Assigned(Converter) then
7104       Converter.Free;
7105   end;
7106 end;
7107
7108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7109 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7111 type
7112   TTGAHeader = packed record
7113     ImageID: Byte;
7114     ColorMapType: Byte;
7115     ImageType: Byte;
7116     //ColorMapSpec: Array[0..4] of Byte;
7117     ColorMapStart: Word;
7118     ColorMapLength: Word;
7119     ColorMapEntrySize: Byte;
7120     OrigX: Word;
7121     OrigY: Word;
7122     Width: Word;
7123     Height: Word;
7124     Bpp: Byte;
7125     ImageDesc: Byte;
7126   end;
7127
7128 const
7129   TGA_UNCOMPRESSED_RGB  =  2;
7130   TGA_UNCOMPRESSED_GRAY =  3;
7131   TGA_COMPRESSED_RGB    = 10;
7132   TGA_COMPRESSED_GRAY   = 11;
7133
7134   TGA_NONE_COLOR_TABLE  = 0;
7135
7136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7137 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7138 var
7139   Header: TTGAHeader;
7140   ImageData: System.PByte;
7141   StartPosition: Int64;
7142   PixelSize, LineSize: Integer;
7143   tgaFormat: TglBitmapFormat;
7144   FormatDesc: TFormatDescriptor;
7145   Counter: packed record
7146     X, Y: packed record
7147       low, high, dir: Integer;
7148     end;
7149   end;
7150
7151 const
7152   CACHE_SIZE = $4000;
7153
7154   ////////////////////////////////////////////////////////////////////////////////////////
7155   procedure ReadUncompressed;
7156   var
7157     i, j: Integer;
7158     buf, tmp1, tmp2: System.PByte;
7159   begin
7160     buf := nil;
7161     if (Counter.X.dir < 0) then
7162       GetMem(buf, LineSize);
7163     try
7164       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7165         tmp1 := ImageData;
7166         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7167         if (Counter.X.dir < 0) then begin               //flip X
7168           aStream.Read(buf^, LineSize);
7169           tmp2 := buf;
7170           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7171           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7172             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7173               tmp1^ := tmp2^;
7174               inc(tmp1);
7175               inc(tmp2);
7176             end;
7177             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7178           end;
7179         end else
7180           aStream.Read(tmp1^, LineSize);
7181         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7182       end;
7183     finally
7184       if Assigned(buf) then
7185         FreeMem(buf);
7186     end;
7187   end;
7188
7189   ////////////////////////////////////////////////////////////////////////////////////////
7190   procedure ReadCompressed;
7191
7192     /////////////////////////////////////////////////////////////////
7193     var
7194       TmpData: System.PByte;
7195       LinePixelsRead: Integer;
7196     procedure CheckLine;
7197     begin
7198       if (LinePixelsRead >= Header.Width) then begin
7199         LinePixelsRead := 0;
7200         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7201         TmpData := ImageData;
7202         inc(TmpData, Counter.Y.low * LineSize);           //set line
7203         if (Counter.X.dir < 0) then                       //if x flipped then
7204           inc(TmpData, LineSize - PixelSize);             //set last pixel
7205       end;
7206     end;
7207
7208     /////////////////////////////////////////////////////////////////
7209     var
7210       Cache: PByte;
7211       CacheSize, CachePos: Integer;
7212     procedure CachedRead(out Buffer; Count: Integer);
7213     var
7214       BytesRead: Integer;
7215     begin
7216       if (CachePos + Count > CacheSize) then begin
7217         //if buffer overflow save non read bytes
7218         BytesRead := 0;
7219         if (CacheSize - CachePos > 0) then begin
7220           BytesRead := CacheSize - CachePos;
7221           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7222           inc(CachePos, BytesRead);
7223         end;
7224
7225         //load cache from file
7226         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7227         aStream.Read(Cache^, CacheSize);
7228         CachePos := 0;
7229
7230         //read rest of requested bytes
7231         if (Count - BytesRead > 0) then begin
7232           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7233           inc(CachePos, Count - BytesRead);
7234         end;
7235       end else begin
7236         //if no buffer overflow just read the data
7237         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7238         inc(CachePos, Count);
7239       end;
7240     end;
7241
7242     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7243     begin
7244       case PixelSize of
7245         1: begin
7246           aBuffer^ := aData^;
7247           inc(aBuffer, Counter.X.dir);
7248         end;
7249         2: begin
7250           PWord(aBuffer)^ := PWord(aData)^;
7251           inc(aBuffer, 2 * Counter.X.dir);
7252         end;
7253         3: begin
7254           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7255           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7256           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7257           inc(aBuffer, 3 * Counter.X.dir);
7258         end;
7259         4: begin
7260           PCardinal(aBuffer)^ := PCardinal(aData)^;
7261           inc(aBuffer, 4 * Counter.X.dir);
7262         end;
7263       end;
7264     end;
7265
7266   var
7267     TotalPixelsToRead, TotalPixelsRead: Integer;
7268     Temp: Byte;
7269     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7270     PixelRepeat: Boolean;
7271     PixelsToRead, PixelCount: Integer;
7272   begin
7273     CacheSize := 0;
7274     CachePos  := 0;
7275
7276     TotalPixelsToRead := Header.Width * Header.Height;
7277     TotalPixelsRead   := 0;
7278     LinePixelsRead    := 0;
7279
7280     GetMem(Cache, CACHE_SIZE);
7281     try
7282       TmpData := ImageData;
7283       inc(TmpData, Counter.Y.low * LineSize);           //set line
7284       if (Counter.X.dir < 0) then                       //if x flipped then
7285         inc(TmpData, LineSize - PixelSize);             //set last pixel
7286
7287       repeat
7288         //read CommandByte
7289         CachedRead(Temp, 1);
7290         PixelRepeat  := (Temp and $80) > 0;
7291         PixelsToRead := (Temp and $7F) + 1;
7292         inc(TotalPixelsRead, PixelsToRead);
7293
7294         if PixelRepeat then
7295           CachedRead(buf[0], PixelSize);
7296         while (PixelsToRead > 0) do begin
7297           CheckLine;
7298           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7299           while (PixelCount > 0) do begin
7300             if not PixelRepeat then
7301               CachedRead(buf[0], PixelSize);
7302             PixelToBuffer(@buf[0], TmpData);
7303             inc(LinePixelsRead);
7304             dec(PixelsToRead);
7305             dec(PixelCount);
7306           end;
7307         end;
7308       until (TotalPixelsRead >= TotalPixelsToRead);
7309     finally
7310       FreeMem(Cache);
7311     end;
7312   end;
7313
7314   function IsGrayFormat: Boolean;
7315   begin
7316     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7317   end;
7318
7319 begin
7320   result := false;
7321
7322   // reading header to test file and set cursor back to begin
7323   StartPosition := aStream.Position;
7324   aStream.Read(Header{%H-}, SizeOf(Header));
7325
7326   // no colormapped files
7327   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7328     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7329   begin
7330     try
7331       if Header.ImageID <> 0 then       // skip image ID
7332         aStream.Position := aStream.Position + Header.ImageID;
7333
7334       tgaFormat := tfEmpty;
7335       case Header.Bpp of
7336          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7337                0: tgaFormat := tfLuminance8;
7338                8: tgaFormat := tfAlpha8;
7339             end;
7340
7341         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7342                0: tgaFormat := tfLuminance16;
7343                8: tgaFormat := tfLuminance8Alpha8;
7344             end else case (Header.ImageDesc and $F) of
7345                0: tgaFormat := tfBGR5;
7346                1: tgaFormat := tfBGR5A1;
7347                4: tgaFormat := tfBGRA4;
7348             end;
7349
7350         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7351                0: tgaFormat := tfBGR8;
7352             end;
7353
7354         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7355                2: tgaFormat := tfBGR10A2;
7356                8: tgaFormat := tfBGRA8;
7357             end;
7358       end;
7359
7360       if (tgaFormat = tfEmpty) then
7361         raise EglBitmap.Create('LoadTga - unsupported format');
7362
7363       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7364       PixelSize  := FormatDesc.GetSize(1, 1);
7365       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7366
7367       GetMem(ImageData, LineSize * Header.Height);
7368       try
7369         //column direction
7370         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7371           Counter.X.low  := Header.Height-1;;
7372           Counter.X.high := 0;
7373           Counter.X.dir  := -1;
7374         end else begin
7375           Counter.X.low  := 0;
7376           Counter.X.high := Header.Height-1;
7377           Counter.X.dir  := 1;
7378         end;
7379
7380         // Row direction
7381         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7382           Counter.Y.low  := 0;
7383           Counter.Y.high := Header.Height-1;
7384           Counter.Y.dir  := 1;
7385         end else begin
7386           Counter.Y.low  := Header.Height-1;;
7387           Counter.Y.high := 0;
7388           Counter.Y.dir  := -1;
7389         end;
7390
7391         // Read Image
7392         case Header.ImageType of
7393           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7394             ReadUncompressed;
7395           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7396             ReadCompressed;
7397         end;
7398
7399         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7400         result := true;
7401       except
7402         if Assigned(ImageData) then
7403           FreeMem(ImageData);
7404         raise;
7405       end;
7406     finally
7407       aStream.Position := StartPosition;
7408     end;
7409   end
7410     else aStream.Position := StartPosition;
7411 end;
7412
7413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7414 procedure TglBitmap.SaveTGA(const aStream: TStream);
7415 var
7416   Header: TTGAHeader;
7417   LineSize, Size, x, y: Integer;
7418   Pixel: TglBitmapPixelData;
7419   LineBuf, SourceData, DestData: PByte;
7420   SourceMD, DestMD: Pointer;
7421   FormatDesc: TFormatDescriptor;
7422   Converter: TFormatDescriptor;
7423 begin
7424   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7425     raise EglBitmapUnsupportedFormat.Create(Format);
7426
7427   //prepare header
7428   FillChar(Header{%H-}, SizeOf(Header), 0);
7429
7430   //set ImageType
7431   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7432                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7433     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7434   else
7435     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7436
7437   //set BitsPerPixel
7438   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7439     Header.Bpp := 8
7440   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7441                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7442     Header.Bpp := 16
7443   else if (Format in [tfBGR8, tfRGB8]) then
7444     Header.Bpp := 24
7445   else
7446     Header.Bpp := 32;
7447
7448   //set AlphaBitCount
7449   case Format of
7450     tfRGB5A1, tfBGR5A1:
7451       Header.ImageDesc := 1 and $F;
7452     tfRGB10A2, tfBGR10A2:
7453       Header.ImageDesc := 2 and $F;
7454     tfRGBA4, tfBGRA4:
7455       Header.ImageDesc := 4 and $F;
7456     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7457       Header.ImageDesc := 8 and $F;
7458   end;
7459
7460   Header.Width     := Width;
7461   Header.Height    := Height;
7462   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7463   aStream.Write(Header, SizeOf(Header));
7464
7465   // convert RGB(A) to BGR(A)
7466   Converter  := nil;
7467   FormatDesc := TFormatDescriptor.Get(Format);
7468   Size       := FormatDesc.GetSize(Dimension);
7469   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7470     if (FormatDesc.RGBInverted = tfEmpty) then
7471       raise EglBitmap.Create('inverted RGB format is empty');
7472     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7473     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7474        (Converter.PixelSize <> FormatDesc.PixelSize) then
7475       raise EglBitmap.Create('invalid inverted RGB format');
7476   end;
7477
7478   if Assigned(Converter) then begin
7479     LineSize := FormatDesc.GetSize(Width, 1);
7480     GetMem(LineBuf, LineSize);
7481     SourceMD := FormatDesc.CreateMappingData;
7482     DestMD   := Converter.CreateMappingData;
7483     try
7484       SourceData := Data;
7485       for y := 0 to Height-1 do begin
7486         DestData := LineBuf;
7487         for x := 0 to Width-1 do begin
7488           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7489           Converter.Map(Pixel, DestData, DestMD);
7490         end;
7491         aStream.Write(LineBuf^, LineSize);
7492       end;
7493     finally
7494       FreeMem(LineBuf);
7495       FormatDesc.FreeMappingData(SourceMD);
7496       FormatDesc.FreeMappingData(DestMD);
7497     end;
7498   end else
7499     aStream.Write(Data^, Size);
7500 end;
7501
7502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7503 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7505 const
7506   DDS_MAGIC: Cardinal         = $20534444;
7507
7508   // DDS_header.dwFlags
7509   DDSD_CAPS                   = $00000001;
7510   DDSD_HEIGHT                 = $00000002;
7511   DDSD_WIDTH                  = $00000004;
7512   DDSD_PIXELFORMAT            = $00001000;
7513
7514   // DDS_header.sPixelFormat.dwFlags
7515   DDPF_ALPHAPIXELS            = $00000001;
7516   DDPF_ALPHA                  = $00000002;
7517   DDPF_FOURCC                 = $00000004;
7518   DDPF_RGB                    = $00000040;
7519   DDPF_LUMINANCE              = $00020000;
7520
7521   // DDS_header.sCaps.dwCaps1
7522   DDSCAPS_TEXTURE             = $00001000;
7523
7524   // DDS_header.sCaps.dwCaps2
7525   DDSCAPS2_CUBEMAP            = $00000200;
7526
7527   D3DFMT_DXT1                 = $31545844;
7528   D3DFMT_DXT3                 = $33545844;
7529   D3DFMT_DXT5                 = $35545844;
7530
7531 type
7532   TDDSPixelFormat = packed record
7533     dwSize: Cardinal;
7534     dwFlags: Cardinal;
7535     dwFourCC: Cardinal;
7536     dwRGBBitCount: Cardinal;
7537     dwRBitMask: Cardinal;
7538     dwGBitMask: Cardinal;
7539     dwBBitMask: Cardinal;
7540     dwABitMask: Cardinal;
7541   end;
7542
7543   TDDSCaps = packed record
7544     dwCaps1: Cardinal;
7545     dwCaps2: Cardinal;
7546     dwDDSX: Cardinal;
7547     dwReserved: Cardinal;
7548   end;
7549
7550   TDDSHeader = packed record
7551     dwSize: Cardinal;
7552     dwFlags: Cardinal;
7553     dwHeight: Cardinal;
7554     dwWidth: Cardinal;
7555     dwPitchOrLinearSize: Cardinal;
7556     dwDepth: Cardinal;
7557     dwMipMapCount: Cardinal;
7558     dwReserved: array[0..10] of Cardinal;
7559     PixelFormat: TDDSPixelFormat;
7560     Caps: TDDSCaps;
7561     dwReserved2: Cardinal;
7562   end;
7563
7564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7565 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7566 var
7567   Header: TDDSHeader;
7568   Converter: TbmpBitfieldFormat;
7569
7570   function GetDDSFormat: TglBitmapFormat;
7571   var
7572     fd: TFormatDescriptor;
7573     i: Integer;
7574     Range: TglBitmapColorRec;
7575     match: Boolean;
7576   begin
7577     result := tfEmpty;
7578     with Header.PixelFormat do begin
7579       // Compresses
7580       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7581         case Header.PixelFormat.dwFourCC of
7582           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7583           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7584           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7585         end;
7586       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7587
7588         //find matching format
7589         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7590           fd := TFormatDescriptor.Get(result);
7591           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7592              (8 * fd.PixelSize = dwRGBBitCount) then
7593             exit;
7594         end;
7595
7596         //find format with same Range
7597         Range.r := dwRBitMask;
7598         Range.g := dwGBitMask;
7599         Range.b := dwBBitMask;
7600         Range.a := dwABitMask;
7601         for i := 0 to 3 do begin
7602           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7603             Range.arr[i] := Range.arr[i] shr 1;
7604         end;
7605         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7606           fd := TFormatDescriptor.Get(result);
7607           match := true;
7608           for i := 0 to 3 do
7609             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7610               match := false;
7611               break;
7612             end;
7613           if match then
7614             break;
7615         end;
7616
7617         //no format with same range found -> use default
7618         if (result = tfEmpty) then begin
7619           if (dwABitMask > 0) then
7620             result := tfBGRA8
7621           else
7622             result := tfBGR8;
7623         end;
7624
7625         Converter := TbmpBitfieldFormat.Create;
7626         Converter.RedMask   := dwRBitMask;
7627         Converter.GreenMask := dwGBitMask;
7628         Converter.BlueMask  := dwBBitMask;
7629         Converter.AlphaMask := dwABitMask;
7630         Converter.PixelSize := dwRGBBitCount / 8;
7631       end;
7632     end;
7633   end;
7634
7635 var
7636   StreamPos: Int64;
7637   x, y, LineSize, RowSize, Magic: Cardinal;
7638   NewImage, TmpData, RowData, SrcData: System.PByte;
7639   SourceMD, DestMD: Pointer;
7640   Pixel: TglBitmapPixelData;
7641   ddsFormat: TglBitmapFormat;
7642   FormatDesc: TFormatDescriptor;
7643
7644 begin
7645   result    := false;
7646   Converter := nil;
7647   StreamPos := aStream.Position;
7648
7649   // Magic
7650   aStream.Read(Magic{%H-}, sizeof(Magic));
7651   if (Magic <> DDS_MAGIC) then begin
7652     aStream.Position := StreamPos;
7653     exit;
7654   end;
7655
7656   //Header
7657   aStream.Read(Header{%H-}, sizeof(Header));
7658   if (Header.dwSize <> SizeOf(Header)) or
7659      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7660         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7661   begin
7662     aStream.Position := StreamPos;
7663     exit;
7664   end;
7665
7666   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7667     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7668
7669   ddsFormat := GetDDSFormat;
7670   try
7671     if (ddsFormat = tfEmpty) then
7672       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7673
7674     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7675     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7676     GetMem(NewImage, Header.dwHeight * LineSize);
7677     try
7678       TmpData := NewImage;
7679
7680       //Converter needed
7681       if Assigned(Converter) then begin
7682         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7683         GetMem(RowData, RowSize);
7684         SourceMD := Converter.CreateMappingData;
7685         DestMD   := FormatDesc.CreateMappingData;
7686         try
7687           for y := 0 to Header.dwHeight-1 do begin
7688             TmpData := NewImage;
7689             inc(TmpData, y * LineSize);
7690             SrcData := RowData;
7691             aStream.Read(SrcData^, RowSize);
7692             for x := 0 to Header.dwWidth-1 do begin
7693               Converter.Unmap(SrcData, Pixel, SourceMD);
7694               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7695               FormatDesc.Map(Pixel, TmpData, DestMD);
7696             end;
7697           end;
7698         finally
7699           Converter.FreeMappingData(SourceMD);
7700           FormatDesc.FreeMappingData(DestMD);
7701           FreeMem(RowData);
7702         end;
7703       end else
7704
7705       // Compressed
7706       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7707         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7708         for Y := 0 to Header.dwHeight-1 do begin
7709           aStream.Read(TmpData^, RowSize);
7710           Inc(TmpData, LineSize);
7711         end;
7712       end else
7713
7714       // Uncompressed
7715       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7716         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7717         for Y := 0 to Header.dwHeight-1 do begin
7718           aStream.Read(TmpData^, RowSize);
7719           Inc(TmpData, LineSize);
7720         end;
7721       end else
7722         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7723
7724       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7725       result := true;
7726     except
7727       if Assigned(NewImage) then
7728         FreeMem(NewImage);
7729       raise;
7730     end;
7731   finally
7732     FreeAndNil(Converter);
7733   end;
7734 end;
7735
7736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7737 procedure TglBitmap.SaveDDS(const aStream: TStream);
7738 var
7739   Header: TDDSHeader;
7740   FormatDesc: TFormatDescriptor;
7741 begin
7742   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7743     raise EglBitmapUnsupportedFormat.Create(Format);
7744
7745   FormatDesc := TFormatDescriptor.Get(Format);
7746
7747   // Generell
7748   FillChar(Header{%H-}, SizeOf(Header), 0);
7749   Header.dwSize  := SizeOf(Header);
7750   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7751
7752   Header.dwWidth  := Max(1, Width);
7753   Header.dwHeight := Max(1, Height);
7754
7755   // Caps
7756   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7757
7758   // Pixelformat
7759   Header.PixelFormat.dwSize := sizeof(Header);
7760   if (FormatDesc.IsCompressed) then begin
7761     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7762     case Format of
7763       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7764       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7765       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7766     end;
7767   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7768     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7769     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7770     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7771   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7772     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7773     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7774     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7775     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7776   end else begin
7777     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7778     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7779     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7780     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7781     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7782     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7783   end;
7784
7785   if (FormatDesc.HasAlpha) then
7786     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7787
7788   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7789   aStream.Write(Header, SizeOf(Header));
7790   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7791 end;
7792
7793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7794 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7796 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7797   const aWidth: Integer; const aHeight: Integer);
7798 var
7799   pTemp: pByte;
7800   Size: Integer;
7801 begin
7802   if (aHeight > 1) then begin
7803     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7804     GetMem(pTemp, Size);
7805     try
7806       Move(aData^, pTemp^, Size);
7807       FreeMem(aData);
7808       aData := nil;
7809     except
7810       FreeMem(pTemp);
7811       raise;
7812     end;
7813   end else
7814     pTemp := aData;
7815   inherited SetDataPointer(pTemp, aFormat, aWidth);
7816 end;
7817
7818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7819 function TglBitmap1D.FlipHorz: Boolean;
7820 var
7821   Col: Integer;
7822   pTempDest, pDest, pSource: PByte;
7823 begin
7824   result := inherited FlipHorz;
7825   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7826     pSource := Data;
7827     GetMem(pDest, fRowSize);
7828     try
7829       pTempDest := pDest;
7830       Inc(pTempDest, fRowSize);
7831       for Col := 0 to Width-1 do begin
7832         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7833         Move(pSource^, pTempDest^, fPixelSize);
7834         Inc(pSource, fPixelSize);
7835       end;
7836       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7837       result := true;
7838     except
7839       if Assigned(pDest) then
7840         FreeMem(pDest);
7841       raise;
7842     end;
7843   end;
7844 end;
7845
7846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7847 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7848 var
7849   FormatDesc: TFormatDescriptor;
7850 begin
7851   // Upload data
7852   FormatDesc := TFormatDescriptor.Get(Format);
7853   if FormatDesc.IsCompressed then begin
7854     if not Assigned(glCompressedTexImage1D) then
7855       raise EglBitmap.Create('compressed formats not supported by video adapter');
7856     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7857   end else if aBuildWithGlu then
7858     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7859   else
7860     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7861
7862   // Free Data
7863   if (FreeDataAfterGenTexture) then
7864     FreeData;
7865 end;
7866
7867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7868 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7869 var
7870   BuildWithGlu, TexRec: Boolean;
7871   TexSize: Integer;
7872 begin
7873   if Assigned(Data) then begin
7874     // Check Texture Size
7875     if (aTestTextureSize) then begin
7876       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7877
7878       if (Width > TexSize) then
7879         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7880
7881       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7882                 (Target = GL_TEXTURE_RECTANGLE);
7883       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7884         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7885     end;
7886
7887     CreateId;
7888     SetupParameters(BuildWithGlu);
7889     UploadData(BuildWithGlu);
7890     glAreTexturesResident(1, @fID, @fIsResident);
7891   end;
7892 end;
7893
7894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7895 procedure TglBitmap1D.AfterConstruction;
7896 begin
7897   inherited;
7898   Target := GL_TEXTURE_1D;
7899 end;
7900
7901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7902 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7904 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7905 begin
7906   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7907     result := fLines[aIndex]
7908   else
7909     result := nil;
7910 end;
7911
7912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7913 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7914   const aWidth: Integer; const aHeight: Integer);
7915 var
7916   Idx, LineWidth: Integer;
7917 begin
7918   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7919
7920   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7921     // Assigning Data
7922     if Assigned(Data) then begin
7923       SetLength(fLines, GetHeight);
7924       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7925
7926       for Idx := 0 to GetHeight-1 do begin
7927         fLines[Idx] := Data;
7928         Inc(fLines[Idx], Idx * LineWidth);
7929       end;
7930     end
7931       else SetLength(fLines, 0);
7932   end else begin
7933     SetLength(fLines, 0);
7934   end;
7935 end;
7936
7937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7938 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7939 var
7940   FormatDesc: TFormatDescriptor;
7941 begin
7942   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7943
7944   FormatDesc := TFormatDescriptor.Get(Format);
7945   if FormatDesc.IsCompressed then begin
7946     if not Assigned(glCompressedTexImage2D) then
7947       raise EglBitmap.Create('compressed formats not supported by video adapter');
7948     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7949   end else if aBuildWithGlu then begin
7950     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7951       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7952   end else begin
7953     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7954       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7955   end;
7956
7957   // Freigeben
7958   if (FreeDataAfterGenTexture) then
7959     FreeData;
7960 end;
7961
7962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7963 procedure TglBitmap2D.AfterConstruction;
7964 begin
7965   inherited;
7966   Target := GL_TEXTURE_2D;
7967 end;
7968
7969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7970 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7971 var
7972   Temp: pByte;
7973   Size, w, h: Integer;
7974   FormatDesc: TFormatDescriptor;
7975 begin
7976   FormatDesc := TFormatDescriptor.Get(aFormat);
7977   if FormatDesc.IsCompressed then
7978     raise EglBitmapUnsupportedFormat.Create(aFormat);
7979
7980   w    := aRight  - aLeft;
7981   h    := aBottom - aTop;
7982   Size := FormatDesc.GetSize(w, h);
7983   GetMem(Temp, Size);
7984   try
7985     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7986     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7987     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7988     FlipVert;
7989   except
7990     if Assigned(Temp) then
7991       FreeMem(Temp);
7992     raise;
7993   end;
7994 end;
7995
7996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7997 procedure TglBitmap2D.GetDataFromTexture;
7998 var
7999   Temp: PByte;
8000   TempWidth, TempHeight: Integer;
8001   TempIntFormat: Cardinal;
8002   IntFormat, f: TglBitmapFormat;
8003   FormatDesc: TFormatDescriptor;
8004 begin
8005   Bind;
8006
8007   // Request Data
8008   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8009   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8010   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8011
8012   IntFormat := tfEmpty;
8013   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
8014     FormatDesc := TFormatDescriptor.Get(f);
8015     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
8016       IntFormat := FormatDesc.Format;
8017       break;
8018     end;
8019   end;
8020
8021   // Getting data from OpenGL
8022   FormatDesc := TFormatDescriptor.Get(IntFormat);
8023   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8024   try
8025     if FormatDesc.IsCompressed then begin
8026       if not Assigned(glGetCompressedTexImage) then
8027         raise EglBitmap.Create('compressed formats not supported by video adapter');
8028       glGetCompressedTexImage(Target, 0, Temp)
8029     end else
8030       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8031     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8032   except
8033     if Assigned(Temp) then
8034       FreeMem(Temp);
8035     raise;
8036   end;
8037 end;
8038
8039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8040 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8041 var
8042   BuildWithGlu, PotTex, TexRec: Boolean;
8043   TexSize: Integer;
8044 begin
8045   if Assigned(Data) then begin
8046     // Check Texture Size
8047     if (aTestTextureSize) then begin
8048       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8049
8050       if ((Height > TexSize) or (Width > TexSize)) then
8051         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8052
8053       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8054       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8055       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8056         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8057     end;
8058
8059     CreateId;
8060     SetupParameters(BuildWithGlu);
8061     UploadData(Target, BuildWithGlu);
8062     glAreTexturesResident(1, @fID, @fIsResident);
8063   end;
8064 end;
8065
8066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8067 function TglBitmap2D.FlipHorz: Boolean;
8068 var
8069   Col, Row: Integer;
8070   TempDestData, DestData, SourceData: PByte;
8071   ImgSize: Integer;
8072 begin
8073   result := inherited FlipHorz;
8074   if Assigned(Data) then begin
8075     SourceData := Data;
8076     ImgSize := Height * fRowSize;
8077     GetMem(DestData, ImgSize);
8078     try
8079       TempDestData := DestData;
8080       Dec(TempDestData, fRowSize + fPixelSize);
8081       for Row := 0 to Height -1 do begin
8082         Inc(TempDestData, fRowSize * 2);
8083         for Col := 0 to Width -1 do begin
8084           Move(SourceData^, TempDestData^, fPixelSize);
8085           Inc(SourceData, fPixelSize);
8086           Dec(TempDestData, fPixelSize);
8087         end;
8088       end;
8089       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8090       result := true;
8091     except
8092       if Assigned(DestData) then
8093         FreeMem(DestData);
8094       raise;
8095     end;
8096   end;
8097 end;
8098
8099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8100 function TglBitmap2D.FlipVert: Boolean;
8101 var
8102   Row: Integer;
8103   TempDestData, DestData, SourceData: PByte;
8104 begin
8105   result := inherited FlipVert;
8106   if Assigned(Data) then begin
8107     SourceData := Data;
8108     GetMem(DestData, Height * fRowSize);
8109     try
8110       TempDestData := DestData;
8111       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8112       for Row := 0 to Height -1 do begin
8113         Move(SourceData^, TempDestData^, fRowSize);
8114         Dec(TempDestData, fRowSize);
8115         Inc(SourceData, fRowSize);
8116       end;
8117       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8118       result := true;
8119     except
8120       if Assigned(DestData) then
8121         FreeMem(DestData);
8122       raise;
8123     end;
8124   end;
8125 end;
8126
8127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8128 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8130 type
8131   TMatrixItem = record
8132     X, Y: Integer;
8133     W: Single;
8134   end;
8135
8136   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8137   TglBitmapToNormalMapRec = Record
8138     Scale: Single;
8139     Heights: array of Single;
8140     MatrixU : array of TMatrixItem;
8141     MatrixV : array of TMatrixItem;
8142   end;
8143
8144 const
8145   ONE_OVER_255 = 1 / 255;
8146
8147   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8148 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8149 var
8150   Val: Single;
8151 begin
8152   with FuncRec do begin
8153     Val :=
8154       Source.Data.r * LUMINANCE_WEIGHT_R +
8155       Source.Data.g * LUMINANCE_WEIGHT_G +
8156       Source.Data.b * LUMINANCE_WEIGHT_B;
8157     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8158   end;
8159 end;
8160
8161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8162 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8163 begin
8164   with FuncRec do
8165     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8166 end;
8167
8168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8169 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8170 type
8171   TVec = Array[0..2] of Single;
8172 var
8173   Idx: Integer;
8174   du, dv: Double;
8175   Len: Single;
8176   Vec: TVec;
8177
8178   function GetHeight(X, Y: Integer): Single;
8179   begin
8180     with FuncRec do begin
8181       X := Max(0, Min(Size.X -1, X));
8182       Y := Max(0, Min(Size.Y -1, Y));
8183       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8184     end;
8185   end;
8186
8187 begin
8188   with FuncRec do begin
8189     with PglBitmapToNormalMapRec(Args)^ do begin
8190       du := 0;
8191       for Idx := Low(MatrixU) to High(MatrixU) do
8192         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8193
8194       dv := 0;
8195       for Idx := Low(MatrixU) to High(MatrixU) do
8196         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8197
8198       Vec[0] := -du * Scale;
8199       Vec[1] := -dv * Scale;
8200       Vec[2] := 1;
8201     end;
8202
8203     // Normalize
8204     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8205     if Len <> 0 then begin
8206       Vec[0] := Vec[0] * Len;
8207       Vec[1] := Vec[1] * Len;
8208       Vec[2] := Vec[2] * Len;
8209     end;
8210
8211     // Farbe zuweisem
8212     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8213     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8214     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8215   end;
8216 end;
8217
8218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8219 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8220 var
8221   Rec: TglBitmapToNormalMapRec;
8222
8223   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8224   begin
8225     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8226       Matrix[Index].X := X;
8227       Matrix[Index].Y := Y;
8228       Matrix[Index].W := W;
8229     end;
8230   end;
8231
8232 begin
8233   if TFormatDescriptor.Get(Format).IsCompressed then
8234     raise EglBitmapUnsupportedFormat.Create(Format);
8235
8236   if aScale > 100 then
8237     Rec.Scale := 100
8238   else if aScale < -100 then
8239     Rec.Scale := -100
8240   else
8241     Rec.Scale := aScale;
8242
8243   SetLength(Rec.Heights, Width * Height);
8244   try
8245     case aFunc of
8246       nm4Samples: begin
8247         SetLength(Rec.MatrixU, 2);
8248         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8249         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8250
8251         SetLength(Rec.MatrixV, 2);
8252         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8253         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8254       end;
8255
8256       nmSobel: begin
8257         SetLength(Rec.MatrixU, 6);
8258         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8259         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8260         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8261         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8262         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8263         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8264
8265         SetLength(Rec.MatrixV, 6);
8266         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8267         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8268         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8269         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8270         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8271         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8272       end;
8273
8274       nm3x3: begin
8275         SetLength(Rec.MatrixU, 6);
8276         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8277         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8278         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8279         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8280         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8281         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8282
8283         SetLength(Rec.MatrixV, 6);
8284         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8285         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8286         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8287         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8288         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8289         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8290       end;
8291
8292       nm5x5: begin
8293         SetLength(Rec.MatrixU, 20);
8294         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8295         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8296         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8297         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8298         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8299         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8300         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8301         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8302         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8303         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8304         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8305         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8306         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8307         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8308         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8309         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8310         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8311         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8312         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8313         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8314
8315         SetLength(Rec.MatrixV, 20);
8316         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8317         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8318         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8319         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8320         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8321         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8322         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8323         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8324         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8325         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8326         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8327         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8328         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8329         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8330         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8331         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8332         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8333         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8334         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8335         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8336       end;
8337     end;
8338
8339     // Daten Sammeln
8340     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8341       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8342     else
8343       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8344     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8345   finally
8346     SetLength(Rec.Heights, 0);
8347   end;
8348 end;
8349
8350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8351 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8353 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8354 begin
8355   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8356 end;
8357
8358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8359 procedure TglBitmapCubeMap.AfterConstruction;
8360 begin
8361   inherited;
8362
8363   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8364     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8365
8366   SetWrap;
8367   Target   := GL_TEXTURE_CUBE_MAP;
8368   fGenMode := GL_REFLECTION_MAP;
8369 end;
8370
8371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8372 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8373 var
8374   BuildWithGlu: Boolean;
8375   TexSize: Integer;
8376 begin
8377   if (aTestTextureSize) then begin
8378     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8379
8380     if (Height > TexSize) or (Width > TexSize) then
8381       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8382
8383     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8384       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8385   end;
8386
8387   if (ID = 0) then
8388     CreateID;
8389   SetupParameters(BuildWithGlu);
8390   UploadData(aCubeTarget, BuildWithGlu);
8391 end;
8392
8393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8394 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8395 begin
8396   inherited Bind (aEnableTextureUnit);
8397   if aEnableTexCoordsGen then begin
8398     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8399     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8400     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8401     glEnable(GL_TEXTURE_GEN_S);
8402     glEnable(GL_TEXTURE_GEN_T);
8403     glEnable(GL_TEXTURE_GEN_R);
8404   end;
8405 end;
8406
8407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8408 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8409 begin
8410   inherited Unbind(aDisableTextureUnit);
8411   if aDisableTexCoordsGen then begin
8412     glDisable(GL_TEXTURE_GEN_S);
8413     glDisable(GL_TEXTURE_GEN_T);
8414     glDisable(GL_TEXTURE_GEN_R);
8415   end;
8416 end;
8417
8418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8419 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8421 type
8422   TVec = Array[0..2] of Single;
8423   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8424
8425   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8426   TglBitmapNormalMapRec = record
8427     HalfSize : Integer;
8428     Func: TglBitmapNormalMapGetVectorFunc;
8429   end;
8430
8431   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8432 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8433 begin
8434   aVec[0] := aHalfSize;
8435   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8436   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8437 end;
8438
8439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8440 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8441 begin
8442   aVec[0] := - aHalfSize;
8443   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8444   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8445 end;
8446
8447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8448 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8449 begin
8450   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8451   aVec[1] := aHalfSize;
8452   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8453 end;
8454
8455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8456 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8457 begin
8458   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8459   aVec[1] := - aHalfSize;
8460   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8461 end;
8462
8463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8464 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8465 begin
8466   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8467   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8468   aVec[2] := aHalfSize;
8469 end;
8470
8471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8472 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8473 begin
8474   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8475   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8476   aVec[2] := - aHalfSize;
8477 end;
8478
8479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8480 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8481 var
8482   i: Integer;
8483   Vec: TVec;
8484   Len: Single;
8485 begin
8486   with FuncRec do begin
8487     with PglBitmapNormalMapRec(Args)^ do begin
8488       Func(Vec, Position, HalfSize);
8489
8490       // Normalize
8491       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8492       if Len <> 0 then begin
8493         Vec[0] := Vec[0] * Len;
8494         Vec[1] := Vec[1] * Len;
8495         Vec[2] := Vec[2] * Len;
8496       end;
8497
8498       // Scale Vector and AddVectro
8499       Vec[0] := Vec[0] * 0.5 + 0.5;
8500       Vec[1] := Vec[1] * 0.5 + 0.5;
8501       Vec[2] := Vec[2] * 0.5 + 0.5;
8502     end;
8503
8504     // Set Color
8505     for i := 0 to 2 do
8506       Dest.Data.arr[i] := Round(Vec[i] * 255);
8507   end;
8508 end;
8509
8510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8511 procedure TglBitmapNormalMap.AfterConstruction;
8512 begin
8513   inherited;
8514   fGenMode := GL_NORMAL_MAP;
8515 end;
8516
8517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8518 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8519 var
8520   Rec: TglBitmapNormalMapRec;
8521   SizeRec: TglBitmapPixelPosition;
8522 begin
8523   Rec.HalfSize := aSize div 2;
8524   FreeDataAfterGenTexture := false;
8525
8526   SizeRec.Fields := [ffX, ffY];
8527   SizeRec.X := aSize;
8528   SizeRec.Y := aSize;
8529
8530   // Positive X
8531   Rec.Func := glBitmapNormalMapPosX;
8532   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8533   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8534
8535   // Negative X
8536   Rec.Func := glBitmapNormalMapNegX;
8537   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8538   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8539
8540   // Positive Y
8541   Rec.Func := glBitmapNormalMapPosY;
8542   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8543   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8544
8545   // Negative Y
8546   Rec.Func := glBitmapNormalMapNegY;
8547   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8548   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8549
8550   // Positive Z
8551   Rec.Func := glBitmapNormalMapPosZ;
8552   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8553   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8554
8555   // Negative Z
8556   Rec.Func := glBitmapNormalMapNegZ;
8557   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8558   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8559 end;
8560
8561
8562 initialization
8563   glBitmapSetDefaultFormat (tfEmpty);
8564   glBitmapSetDefaultMipmap (mmMipmap);
8565   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8566   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8567   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8568
8569   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8570   glBitmapSetDefaultDeleteTextureOnFree    (true);
8571
8572   TFormatDescriptor.Init;
8573
8574 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8575   OpenGLInitialized := false;
8576   InitOpenGLCS := TCriticalSection.Create;
8577 {$ENDIF}
8578
8579 finalization
8580   TFormatDescriptor.Finalize;
8581
8582 {$IFDEF GLB_NATIVE_OGL}
8583   if Assigned(GL_LibHandle) then
8584     glbFreeLibrary(GL_LibHandle);
8585
8586 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8587   if Assigned(GLU_LibHandle) then
8588     glbFreeLibrary(GLU_LibHandle);
8589   FreeAndNil(InitOpenGLCS);
8590 {$ENDIF}
8591 {$ENDIF}
8592
8593 end.