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     fFreeDataAfterGenTexture: Boolean;
 928     fData: PByte;
 929     fIsResident: Boolean;
 930     fBorderColor: array[0..3] of Single;
 931
 932     fDimension: TglBitmapPixelPosition;
 933     fMipMap: TglBitmapMipMap;
 934     fFormat: TglBitmapFormat;
 935
 936     // Mapping
 937     fPixelSize: Integer;
 938     fRowSize: Integer;
 939
 940     // Filtering
 941     fFilterMin: GLenum;
 942     fFilterMag: GLenum;
 943
 944     // TexturWarp
 945     fWrapS: GLenum;
 946     fWrapT: GLenum;
 947     fWrapR: GLenum;
 948
 949     //Swizzle
 950     fSwizzle: array[0..3] of GLenum;
 951
 952     // CustomData
 953     fFilename: String;
 954     fCustomName: String;
 955     fCustomNameW: WideString;
 956     fCustomData: Pointer;
 957
 958     //Getter
 959     function GetWidth:  Integer; virtual;
 960     function GetHeight: Integer; virtual;
 961
 962     function GetFileWidth:  Integer; virtual;
 963     function GetFileHeight: Integer; virtual;
 964
 965     //Setter
 966     procedure SetCustomData(const aValue: Pointer);
 967     procedure SetCustomName(const aValue: String);
 968     procedure SetCustomNameW(const aValue: WideString);
 969     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 970     procedure SetFormat(const aValue: TglBitmapFormat);
 971     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 972     procedure SetID(const aValue: Cardinal);
 973     procedure SetMipMap(const aValue: TglBitmapMipMap);
 974     procedure SetTarget(const aValue: Cardinal);
 975     procedure SetAnisotropic(const aValue: Integer);
 976
 977     procedure CreateID;
 978     procedure SetupParameters(out aBuildWithGlu: Boolean);
 979     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 980       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 981     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 982
 983     function FlipHorz: Boolean; virtual;
 984     function FlipVert: Boolean; virtual;
 985
 986     property Width:  Integer read GetWidth;
 987     property Height: Integer read GetHeight;
 988
 989     property FileWidth:  Integer read GetFileWidth;
 990     property FileHeight: Integer read GetFileHeight;
 991   public
 992     //Properties
 993     property ID:           Cardinal        read fID          write SetID;
 994     property Target:       Cardinal        read fTarget      write SetTarget;
 995     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 996     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 997     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 998
 999     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1000
1001     property Filename:    String     read fFilename;
1002     property CustomName:  String     read fCustomName  write SetCustomName;
1003     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1004     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1005
1006     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1007     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1008
1009     property Dimension:  TglBitmapPixelPosition  read fDimension;
1010     property Data:       PByte                   read fData;
1011     property IsResident: Boolean                 read fIsResident;
1012
1013     procedure AfterConstruction; override;
1014     procedure BeforeDestruction; override;
1015
1016     procedure PrepareResType(var aResource: String; var aResType: PChar);
1017
1018     //Load
1019     procedure LoadFromFile(const aFilename: String);
1020     procedure LoadFromStream(const aStream: TStream); virtual;
1021     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1022       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1023     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1024     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1025
1026     //Save
1027     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1028     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1029
1030     //Convert
1031     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1032     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1033       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1034   public
1035     //Alpha & Co
1036     {$IFDEF GLB_SDL}
1037     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1038     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1039     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1040     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1041       const aArgs: Pointer = nil): Boolean;
1042     {$ENDIF}
1043
1044     {$IFDEF GLB_DELPHI}
1045     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1046     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1047     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1048     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1049       const aArgs: Pointer = nil): Boolean;
1050     {$ENDIF}
1051
1052     {$IFDEF GLB_LAZARUS}
1053     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1054     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1055     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1056     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1057       const aArgs: Pointer = nil): Boolean;
1058     {$ENDIF}
1059
1060     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1061       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1062     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1063       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1064
1065     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1066     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1068     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1069
1070     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1071     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1072     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1073
1074     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1075     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1076     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1077
1078     function RemoveAlpha: Boolean; virtual;
1079   public
1080     //Common
1081     function Clone: TglBitmap;
1082     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1083     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1084     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1085     procedure FreeData;
1086
1087     //ColorFill
1088     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1089     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1090     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1091
1092     //TexParameters
1093     procedure SetFilter(const aMin, aMag: GLenum);
1094     procedure SetWrap(
1095       const S: GLenum = GL_CLAMP_TO_EDGE;
1096       const T: GLenum = GL_CLAMP_TO_EDGE;
1097       const R: GLenum = GL_CLAMP_TO_EDGE);
1098     procedure SetSwizzle(const r, g, b, a: GLenum);
1099
1100     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1101     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1102
1103     //Constructors
1104     constructor Create; overload;
1105     constructor Create(const aFileName: String); overload;
1106     constructor Create(const aStream: TStream); overload;
1107     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1108     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1109     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1110     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1111   private
1112     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1113     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1114
1115     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1116     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1117
1118     function LoadBMP(const aStream: TStream): Boolean; virtual;
1119     procedure SaveBMP(const aStream: TStream); virtual;
1120
1121     function LoadTGA(const aStream: TStream): Boolean; virtual;
1122     procedure SaveTGA(const aStream: TStream); virtual;
1123
1124     function LoadDDS(const aStream: TStream): Boolean; virtual;
1125     procedure SaveDDS(const aStream: TStream); virtual;
1126   end;
1127
1128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1129   TglBitmap1D = class(TglBitmap)
1130   protected
1131     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1132       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1133     procedure UploadData(const aBuildWithGlu: Boolean);
1134   public
1135     property Width;
1136     procedure AfterConstruction; override;
1137     function FlipHorz: Boolean; override;
1138     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1139   end;
1140
1141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1142   TglBitmap2D = class(TglBitmap)
1143   protected
1144     fLines: array of PByte;
1145     function GetScanline(const aIndex: Integer): Pointer;
1146     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1147       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1148     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1149   public
1150     property Width;
1151     property Height;
1152     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1153
1154     procedure AfterConstruction; override;
1155
1156     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1157     procedure GetDataFromTexture;
1158     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1159
1160     function FlipHorz: Boolean; override;
1161     function FlipVert: Boolean; override;
1162
1163     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1164       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1165   end;
1166
1167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1168   TglBitmapCubeMap = class(TglBitmap2D)
1169   protected
1170     fGenMode: Integer;
1171     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1172   public
1173     procedure AfterConstruction; override;
1174     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1175     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1176     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1177   end;
1178
1179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1180   TglBitmapNormalMap = class(TglBitmapCubeMap)
1181   public
1182     procedure AfterConstruction; override;
1183     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1184   end;
1185
1186 const
1187   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1188
1189 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1190 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1191 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1192 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1193 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1194 procedure glBitmapSetDefaultWrap(
1195   const S: Cardinal = GL_CLAMP_TO_EDGE;
1196   const T: Cardinal = GL_CLAMP_TO_EDGE;
1197   const R: Cardinal = GL_CLAMP_TO_EDGE);
1198
1199 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1200 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1201 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1202 function glBitmapGetDefaultFormat: TglBitmapFormat;
1203 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1204 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1205
1206 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1207 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1208 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1209
1210 var
1211   glBitmapDefaultDeleteTextureOnFree: Boolean;
1212   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1213   glBitmapDefaultFormat: TglBitmapFormat;
1214   glBitmapDefaultMipmap: TglBitmapMipMap;
1215   glBitmapDefaultFilterMin: Cardinal;
1216   glBitmapDefaultFilterMag: Cardinal;
1217   glBitmapDefaultWrapS: Cardinal;
1218   glBitmapDefaultWrapT: Cardinal;
1219   glBitmapDefaultWrapR: Cardinal;
1220   glDefaultSwizzle: array[0..3] of GLenum;
1221
1222 {$IFDEF GLB_DELPHI}
1223 function CreateGrayPalette: HPALETTE;
1224 {$ENDIF}
1225
1226 implementation
1227
1228 uses
1229   Math, syncobjs, typinfo
1230   {$IFDEF GLB_DELPHI}, Types{$ENDIF};
1231
1232 type
1233 {$IFNDEF fpc}
1234   QWord   = System.UInt64;
1235   PQWord  = ^QWord;
1236
1237   PtrInt  = Longint;
1238   PtrUInt = DWord;
1239 {$ENDIF}
1240
1241 ////////////////////////////////////////////////////////////////////////////////////////////////////
1242   TShiftRec = packed record
1243   case Integer of
1244     0: (r, g, b, a: Byte);
1245     1: (arr: array[0..3] of Byte);
1246   end;
1247
1248   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1249   private
1250     function GetRedMask: QWord;
1251     function GetGreenMask: QWord;
1252     function GetBlueMask: QWord;
1253     function GetAlphaMask: QWord;
1254   protected
1255     fFormat: TglBitmapFormat;
1256     fWithAlpha: TglBitmapFormat;
1257     fWithoutAlpha: TglBitmapFormat;
1258     fRGBInverted: TglBitmapFormat;
1259     fUncompressed: TglBitmapFormat;
1260     fPixelSize: Single;
1261     fIsCompressed: Boolean;
1262
1263     fRange: TglBitmapColorRec;
1264     fShift: TShiftRec;
1265
1266     fglFormat:         GLenum;
1267     fglInternalFormat: GLenum;
1268     fglDataFormat:     GLenum;
1269
1270     function GetIsCompressed: Boolean; override;
1271     function GetHasAlpha: Boolean; override;
1272
1273     function GetglFormat: GLenum; override;
1274     function GetglInternalFormat: GLenum; override;
1275     function GetglDataFormat: GLenum; override;
1276
1277     function GetComponents: Integer; virtual;
1278   public
1279     property Format:       TglBitmapFormat read fFormat;
1280     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1281     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1282     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1283     property Components:   Integer         read GetComponents;
1284     property PixelSize:    Single          read fPixelSize;
1285
1286     property Range: TglBitmapColorRec read fRange;
1287     property Shift: TShiftRec         read fShift;
1288
1289     property RedMask:   QWord read GetRedMask;
1290     property GreenMask: QWord read GetGreenMask;
1291     property BlueMask:  QWord read GetBlueMask;
1292     property AlphaMask: QWord read GetAlphaMask;
1293
1294     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1295     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1296
1297     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1298     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1299
1300     function CreateMappingData: Pointer; virtual;
1301     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1302
1303     function IsEmpty:  Boolean; virtual;
1304     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1305
1306     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1307
1308     constructor Create; virtual;
1309   public
1310     class procedure Init;
1311     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1312     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1313     class procedure Clear;
1314     class procedure Finalize;
1315   end;
1316   TFormatDescriptorClass = class of TFormatDescriptor;
1317
1318   TfdEmpty = class(TFormatDescriptor);
1319
1320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1321   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330     constructor Create; override;
1331   end;
1332
1333   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336     constructor Create; override;
1337   end;
1338
1339   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342     constructor Create; override;
1343   end;
1344
1345   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1346     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1347     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1348     constructor Create; override;
1349   end;
1350
1351   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354     constructor Create; override;
1355   end;
1356
1357   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1358     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1359     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1360     constructor Create; override;
1361   end;
1362
1363   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1364     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1365     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1366     constructor Create; override;
1367   end;
1368
1369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1370   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1371     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1372     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1373     constructor Create; override;
1374   end;
1375
1376   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379     constructor Create; override;
1380   end;
1381
1382   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385     constructor Create; override;
1386   end;
1387
1388   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1389     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1390     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1391     constructor Create; override;
1392   end;
1393
1394   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1395     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1396     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1397     constructor Create; override;
1398   end;
1399
1400   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1401     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1402     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1403     constructor Create; override;
1404   end;
1405
1406   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409     constructor Create; override;
1410   end;
1411
1412   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415     constructor Create; override;
1416   end;
1417
1418   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421     constructor Create; override;
1422   end;
1423
1424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1425   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1426     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1427     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1428     constructor Create; override;
1429   end;
1430
1431   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1432     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1433     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1434     constructor Create; override;
1435   end;
1436
1437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1438   TfdAlpha4 = class(TfdAlpha_UB1)
1439     constructor Create; override;
1440   end;
1441
1442   TfdAlpha8 = class(TfdAlpha_UB1)
1443     constructor Create; override;
1444   end;
1445
1446   TfdAlpha12 = class(TfdAlpha_US1)
1447     constructor Create; override;
1448   end;
1449
1450   TfdAlpha16 = class(TfdAlpha_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdLuminance4 = class(TfdLuminance_UB1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdLuminance8 = class(TfdLuminance_UB1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdLuminance12 = class(TfdLuminance_US1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdLuminance16 = class(TfdLuminance_US1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1471     constructor Create; override;
1472   end;
1473
1474   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1475     constructor Create; override;
1476   end;
1477
1478   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1479     constructor Create; override;
1480   end;
1481
1482   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1483     constructor Create; override;
1484   end;
1485
1486   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1487     constructor Create; override;
1488   end;
1489
1490   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1491     constructor Create; override;
1492   end;
1493
1494   TfdR3G3B2 = class(TfdUniversal_UB1)
1495     constructor Create; override;
1496   end;
1497
1498   TfdRGB4 = class(TfdUniversal_US1)
1499     constructor Create; override;
1500   end;
1501
1502   TfdR5G6B5 = class(TfdUniversal_US1)
1503     constructor Create; override;
1504   end;
1505
1506   TfdRGB5 = class(TfdUniversal_US1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdRGB8 = class(TfdRGB_UB3)
1511     constructor Create; override;
1512   end;
1513
1514   TfdRGB10 = class(TfdUniversal_UI1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdRGB12 = class(TfdRGB_US3)
1519     constructor Create; override;
1520   end;
1521
1522   TfdRGB16 = class(TfdRGB_US3)
1523     constructor Create; override;
1524   end;
1525
1526   TfdRGBA2 = class(TfdRGBA_UB4)
1527     constructor Create; override;
1528   end;
1529
1530   TfdRGBA4 = class(TfdUniversal_US1)
1531     constructor Create; override;
1532   end;
1533
1534   TfdRGB5A1 = class(TfdUniversal_US1)
1535     constructor Create; override;
1536   end;
1537
1538   TfdRGBA8 = class(TfdRGBA_UB4)
1539     constructor Create; override;
1540   end;
1541
1542   TfdRGB10A2 = class(TfdUniversal_UI1)
1543     constructor Create; override;
1544   end;
1545
1546   TfdRGBA12 = class(TfdRGBA_US4)
1547     constructor Create; override;
1548   end;
1549
1550   TfdRGBA16 = class(TfdRGBA_US4)
1551     constructor Create; override;
1552   end;
1553
1554   TfdBGR4 = class(TfdUniversal_US1)
1555     constructor Create; override;
1556   end;
1557
1558   TfdB5G6R5 = class(TfdUniversal_US1)
1559     constructor Create; override;
1560   end;
1561
1562   TfdBGR5 = class(TfdUniversal_US1)
1563     constructor Create; override;
1564   end;
1565
1566   TfdBGR8 = class(TfdBGR_UB3)
1567     constructor Create; override;
1568   end;
1569
1570   TfdBGR10 = class(TfdUniversal_UI1)
1571     constructor Create; override;
1572   end;
1573
1574   TfdBGR12 = class(TfdBGR_US3)
1575     constructor Create; override;
1576   end;
1577
1578   TfdBGR16 = class(TfdBGR_US3)
1579     constructor Create; override;
1580   end;
1581
1582   TfdBGRA2 = class(TfdBGRA_UB4)
1583     constructor Create; override;
1584   end;
1585
1586   TfdBGRA4 = class(TfdUniversal_US1)
1587     constructor Create; override;
1588   end;
1589
1590   TfdBGR5A1 = class(TfdUniversal_US1)
1591     constructor Create; override;
1592   end;
1593
1594   TfdBGRA8 = class(TfdBGRA_UB4)
1595     constructor Create; override;
1596   end;
1597
1598   TfdBGR10A2 = class(TfdUniversal_UI1)
1599     constructor Create; override;
1600   end;
1601
1602   TfdBGRA12 = class(TfdBGRA_US4)
1603     constructor Create; override;
1604   end;
1605
1606   TfdBGRA16 = class(TfdBGRA_US4)
1607     constructor Create; override;
1608   end;
1609
1610   TfdDepth16 = class(TfdDepth_US1)
1611     constructor Create; override;
1612   end;
1613
1614   TfdDepth24 = class(TfdDepth_UI1)
1615     constructor Create; override;
1616   end;
1617
1618   TfdDepth32 = class(TfdDepth_UI1)
1619     constructor Create; override;
1620   end;
1621
1622   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1623     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1624     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1625     constructor Create; override;
1626   end;
1627
1628   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1629     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1630     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1631     constructor Create; override;
1632   end;
1633
1634   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1635     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1636     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1637     constructor Create; override;
1638   end;
1639
1640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1641   TbmpBitfieldFormat = class(TFormatDescriptor)
1642   private
1643     procedure SetRedMask  (const aValue: QWord);
1644     procedure SetGreenMask(const aValue: QWord);
1645     procedure SetBlueMask (const aValue: QWord);
1646     procedure SetAlphaMask(const aValue: QWord);
1647
1648     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1649   public
1650     property RedMask:   QWord read GetRedMask   write SetRedMask;
1651     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1652     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1653     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1654
1655     property PixelSize: Single read fPixelSize write fPixelSize;
1656
1657     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1658     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1659   end;
1660
1661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1662   TbmpColorTableEnty = packed record
1663     b, g, r, a: Byte;
1664   end;
1665   TbmpColorTable = array of TbmpColorTableEnty;
1666   TbmpColorTableFormat = class(TFormatDescriptor)
1667   private
1668     fColorTable: TbmpColorTable;
1669   public
1670     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1671     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1672     property Range:      TglBitmapColorRec read fRange      write fRange;
1673     property Shift:      TShiftRec         read fShift      write fShift;
1674     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1675
1676     procedure CreateColorTable;
1677
1678     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1679     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1680     destructor Destroy; override;
1681   end;
1682
1683 const
1684   LUMINANCE_WEIGHT_R = 0.30;
1685   LUMINANCE_WEIGHT_G = 0.59;
1686   LUMINANCE_WEIGHT_B = 0.11;
1687
1688   ALPHA_WEIGHT_R = 0.30;
1689   ALPHA_WEIGHT_G = 0.59;
1690   ALPHA_WEIGHT_B = 0.11;
1691
1692   DEPTH_WEIGHT_R = 0.333333333;
1693   DEPTH_WEIGHT_G = 0.333333333;
1694   DEPTH_WEIGHT_B = 0.333333333;
1695
1696   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1697
1698   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1699     TfdEmpty,
1700
1701     TfdAlpha4,
1702     TfdAlpha8,
1703     TfdAlpha12,
1704     TfdAlpha16,
1705
1706     TfdLuminance4,
1707     TfdLuminance8,
1708     TfdLuminance12,
1709     TfdLuminance16,
1710
1711     TfdLuminance4Alpha4,
1712     TfdLuminance6Alpha2,
1713     TfdLuminance8Alpha8,
1714     TfdLuminance12Alpha4,
1715     TfdLuminance12Alpha12,
1716     TfdLuminance16Alpha16,
1717
1718     TfdR3G3B2,
1719     TfdRGB4,
1720     TfdR5G6B5,
1721     TfdRGB5,
1722     TfdRGB8,
1723     TfdRGB10,
1724     TfdRGB12,
1725     TfdRGB16,
1726
1727     TfdRGBA2,
1728     TfdRGBA4,
1729     TfdRGB5A1,
1730     TfdRGBA8,
1731     TfdRGB10A2,
1732     TfdRGBA12,
1733     TfdRGBA16,
1734
1735     TfdBGR4,
1736     TfdB5G6R5,
1737     TfdBGR5,
1738     TfdBGR8,
1739     TfdBGR10,
1740     TfdBGR12,
1741     TfdBGR16,
1742
1743     TfdBGRA2,
1744     TfdBGRA4,
1745     TfdBGR5A1,
1746     TfdBGRA8,
1747     TfdBGR10A2,
1748     TfdBGRA12,
1749     TfdBGRA16,
1750
1751     TfdDepth16,
1752     TfdDepth24,
1753     TfdDepth32,
1754
1755     TfdS3tcDtx1RGBA,
1756     TfdS3tcDtx3RGBA,
1757     TfdS3tcDtx5RGBA
1758   );
1759
1760 var
1761   FormatDescriptorCS: TCriticalSection;
1762   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1763
1764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1765 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1766 begin
1767   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1768 end;
1769
1770 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1771 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1772 begin
1773   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1774 end;
1775
1776 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1777 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1778 begin
1779   result.Fields := [];
1780
1781   if X >= 0 then
1782     result.Fields := result.Fields + [ffX];
1783   if Y >= 0 then
1784     result.Fields := result.Fields + [ffY];
1785
1786   result.X := Max(0, X);
1787   result.Y := Max(0, Y);
1788 end;
1789
1790 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1791 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1792 begin
1793   result.r := r;
1794   result.g := g;
1795   result.b := b;
1796   result.a := a;
1797 end;
1798
1799 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1800 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1801 var
1802   i: Integer;
1803 begin
1804   result := false;
1805   for i := 0 to high(r1.arr) do
1806     if (r1.arr[i] <> r2.arr[i]) then
1807       exit;
1808   result := true;
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1813 begin
1814   result.r := r;
1815   result.g := g;
1816   result.b := b;
1817   result.a := a;
1818 end;
1819
1820 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1821 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1822 begin
1823   result := [];
1824
1825   if (aFormat in [
1826         //4 bbp
1827         tfLuminance4,
1828
1829         //8bpp
1830         tfR3G3B2, tfLuminance8,
1831
1832         //16bpp
1833         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1834         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1835
1836         //24bpp
1837         tfBGR8, tfRGB8,
1838
1839         //32bpp
1840         tfRGB10, tfRGB10A2, tfRGBA8,
1841         tfBGR10, tfBGR10A2, tfBGRA8]) then
1842     result := result + [ftBMP];
1843
1844   if (aFormat in [
1845         //8 bpp
1846         tfLuminance8, tfAlpha8,
1847
1848         //16 bpp
1849         tfLuminance16, tfLuminance8Alpha8,
1850         tfRGB5, tfRGB5A1, tfRGBA4,
1851         tfBGR5, tfBGR5A1, tfBGRA4,
1852
1853         //24 bpp
1854         tfRGB8, tfBGR8,
1855
1856         //32 bpp
1857         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1858     result := result + [ftTGA];
1859
1860   if (aFormat in [
1861         //8 bpp
1862         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1863         tfR3G3B2, tfRGBA2, tfBGRA2,
1864
1865         //16 bpp
1866         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1867         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1868         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1869
1870         //24 bpp
1871         tfRGB8, tfBGR8,
1872
1873         //32 bbp
1874         tfLuminance16Alpha16,
1875         tfRGBA8, tfRGB10A2,
1876         tfBGRA8, tfBGR10A2,
1877
1878         //compressed
1879         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1880     result := result + [ftDDS];
1881
1882   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1883   if aFormat in [
1884       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1885       tfRGB8, tfRGBA8,
1886       tfBGR8, tfBGRA8] then
1887     result := result + [ftPNG];
1888   {$ENDIF}
1889
1890   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1891   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1892     result := result + [ftJPEG];
1893   {$ENDIF}
1894 end;
1895
1896 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1897 function IsPowerOfTwo(aNumber: Integer): Boolean;
1898 begin
1899   while (aNumber and 1) = 0 do
1900     aNumber := aNumber shr 1;
1901   result := aNumber = 1;
1902 end;
1903
1904 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1905 function GetTopMostBit(aBitSet: QWord): Integer;
1906 begin
1907   result := 0;
1908   while aBitSet > 0 do begin
1909     inc(result);
1910     aBitSet := aBitSet shr 1;
1911   end;
1912 end;
1913
1914 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1915 function CountSetBits(aBitSet: QWord): Integer;
1916 begin
1917   result := 0;
1918   while aBitSet > 0 do begin
1919     if (aBitSet and 1) = 1 then
1920       inc(result);
1921     aBitSet := aBitSet shr 1;
1922   end;
1923 end;
1924
1925 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1926 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1927 begin
1928   result := Trunc(
1929     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1930     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1931     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1932 end;
1933
1934 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1935 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1936 begin
1937   result := Trunc(
1938     DEPTH_WEIGHT_R * aPixel.Data.r +
1939     DEPTH_WEIGHT_G * aPixel.Data.g +
1940     DEPTH_WEIGHT_B * aPixel.Data.b);
1941 end;
1942
1943 {$IFDEF GLB_NATIVE_OGL}
1944 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1945 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1946 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1947 var
1948   GL_LibHandle: Pointer = nil;
1949
1950 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1951 begin
1952   if not Assigned(aLibHandle) then
1953     aLibHandle := GL_LibHandle;
1954
1955 {$IF DEFINED(GLB_WIN)}
1956   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1957   if Assigned(result) then
1958     exit;
1959
1960   if Assigned(wglGetProcAddress) then
1961     result := wglGetProcAddress(aProcName);
1962 {$ELSEIF DEFINED(GLB_LINUX)}
1963   if Assigned(glXGetProcAddress) then begin
1964     result := glXGetProcAddress(aProcName);
1965     if Assigned(result) then
1966       exit;
1967   end;
1968
1969   if Assigned(glXGetProcAddressARB) then begin
1970     result := glXGetProcAddressARB(aProcName);
1971     if Assigned(result) then
1972       exit;
1973   end;
1974
1975   result := dlsym(aLibHandle, aProcName);
1976 {$IFEND}
1977   if not Assigned(result) and aRaiseOnErr then
1978     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1979 end;
1980
1981 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1982 var
1983   GLU_LibHandle: Pointer = nil;
1984   OpenGLInitialized: Boolean;
1985   InitOpenGLCS: TCriticalSection;
1986
1987 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1988 procedure glbInitOpenGL;
1989
1990   ////////////////////////////////////////////////////////////////////////////////
1991   function glbLoadLibrary(const aName: PChar): Pointer;
1992   begin
1993     {$IF DEFINED(GLB_WIN)}
1994     result := {%H-}Pointer(LoadLibrary(aName));
1995     {$ELSEIF DEFINED(GLB_LINUX)}
1996     result := dlopen(Name, RTLD_LAZY);
1997     {$ELSE}
1998     result := nil;
1999     {$IFEND}
2000   end;
2001
2002   ////////////////////////////////////////////////////////////////////////////////
2003   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2004   begin
2005     result := false;
2006     if not Assigned(aLibHandle) then
2007       exit;
2008
2009     {$IF DEFINED(GLB_WIN)}
2010     Result := FreeLibrary({%H-}HINST(aLibHandle));
2011     {$ELSEIF DEFINED(GLB_LINUX)}
2012     Result := dlclose(aLibHandle) = 0;
2013     {$IFEND}
2014   end;
2015
2016 begin
2017   if Assigned(GL_LibHandle) then
2018     glbFreeLibrary(GL_LibHandle);
2019
2020   if Assigned(GLU_LibHandle) then
2021     glbFreeLibrary(GLU_LibHandle);
2022
2023   GL_LibHandle := glbLoadLibrary(libopengl);
2024   if not Assigned(GL_LibHandle) then
2025     raise EglBitmap.Create('unable to load library: ' + libopengl);
2026
2027   GLU_LibHandle := glbLoadLibrary(libglu);
2028   if not Assigned(GLU_LibHandle) then
2029     raise EglBitmap.Create('unable to load library: ' + libglu);
2030
2031 {$IF DEFINED(GLB_WIN)}
2032   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2033 {$ELSEIF DEFINED(GLB_LINUX)}
2034   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2035   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2036 {$IFEND}
2037
2038   glEnable := glbGetProcAddress('glEnable');
2039   glDisable := glbGetProcAddress('glDisable');
2040   glGetString := glbGetProcAddress('glGetString');
2041   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2042   glTexParameteri := glbGetProcAddress('glTexParameteri');
2043   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2044   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2045   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2046   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2047   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2048   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2049   glTexGeni := glbGetProcAddress('glTexGeni');
2050   glGenTextures := glbGetProcAddress('glGenTextures');
2051   glBindTexture := glbGetProcAddress('glBindTexture');
2052   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2053   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2054   glReadPixels := glbGetProcAddress('glReadPixels');
2055   glPixelStorei := glbGetProcAddress('glPixelStorei');
2056   glTexImage1D := glbGetProcAddress('glTexImage1D');
2057   glTexImage2D := glbGetProcAddress('glTexImage2D');
2058   glGetTexImage := glbGetProcAddress('glGetTexImage');
2059
2060   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2061   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2062 end;
2063 {$ENDIF}
2064
2065 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2066 procedure glbReadOpenGLExtensions;
2067 var
2068   Buffer: AnsiString;
2069   MajorVersion, MinorVersion: Integer;
2070
2071   ///////////////////////////////////////////////////////////////////////////////////////////
2072   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2073   var
2074     Separator: Integer;
2075   begin
2076     aMinor := 0;
2077     aMajor := 0;
2078
2079     Separator := Pos(AnsiString('.'), aBuffer);
2080     if (Separator > 1) and (Separator < Length(aBuffer)) and
2081        (aBuffer[Separator - 1] in ['0'..'9']) and
2082        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2083
2084       Dec(Separator);
2085       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2086         Dec(Separator);
2087
2088       Delete(aBuffer, 1, Separator);
2089       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2090
2091       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2092         Inc(Separator);
2093
2094       Delete(aBuffer, Separator, 255);
2095       Separator := Pos(AnsiString('.'), aBuffer);
2096
2097       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2098       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2099     end;
2100   end;
2101
2102   ///////////////////////////////////////////////////////////////////////////////////////////
2103   function CheckExtension(const Extension: AnsiString): Boolean;
2104   var
2105     ExtPos: Integer;
2106   begin
2107     ExtPos := Pos(Extension, Buffer);
2108     result := ExtPos > 0;
2109     if result then
2110       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2111   end;
2112
2113   ///////////////////////////////////////////////////////////////////////////////////////////
2114   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2115   begin
2116     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2117   end;
2118
2119 begin
2120 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2121   InitOpenGLCS.Enter;
2122   try
2123     if not OpenGLInitialized then begin
2124       glbInitOpenGL;
2125       OpenGLInitialized := true;
2126     end;
2127   finally
2128     InitOpenGLCS.Leave;
2129   end;
2130 {$ENDIF}
2131
2132   // Version
2133   Buffer := glGetString(GL_VERSION);
2134   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2135
2136   GL_VERSION_1_2 := CheckVersion(1, 2);
2137   GL_VERSION_1_3 := CheckVersion(1, 3);
2138   GL_VERSION_1_4 := CheckVersion(1, 4);
2139   GL_VERSION_2_0 := CheckVersion(2, 0);
2140   GL_VERSION_3_3 := CheckVersion(3, 3);
2141
2142   // Extensions
2143   Buffer := glGetString(GL_EXTENSIONS);
2144   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2145   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2146   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2147   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2148   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2149   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2150   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2151   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2152   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2153   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2154   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2155   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2156   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2157   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2158
2159   if GL_VERSION_1_3 then begin
2160     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2161     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2162     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2163   end else begin
2164     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2165     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2166     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2167   end;
2168 end;
2169 {$ENDIF}
2170
2171 {$IFDEF GLB_SDL_IMAGE}
2172 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2175 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2176 begin
2177   result := TStream(context^.unknown.data1).Seek(offset, whence);
2178 end;
2179
2180 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2181 begin
2182   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2183 end;
2184
2185 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2186 begin
2187   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2188 end;
2189
2190 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2191 begin
2192   result := 0;
2193 end;
2194
2195 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2196 begin
2197   result := SDL_AllocRW;
2198
2199   if result = nil then
2200     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2201
2202   result^.seek := glBitmapRWseek;
2203   result^.read := glBitmapRWread;
2204   result^.write := glBitmapRWwrite;
2205   result^.close := glBitmapRWclose;
2206   result^.unknown.data1 := Stream;
2207 end;
2208 {$ENDIF}
2209
2210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2211 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2212 begin
2213   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2214 end;
2215
2216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2217 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2218 begin
2219   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2220 end;
2221
2222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2223 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2224 begin
2225   glBitmapDefaultMipmap := aValue;
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2230 begin
2231   glBitmapDefaultFormat := aFormat;
2232 end;
2233
2234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2235 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2236 begin
2237   glBitmapDefaultFilterMin := aMin;
2238   glBitmapDefaultFilterMag := aMag;
2239 end;
2240
2241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2242 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2243 begin
2244   glBitmapDefaultWrapS := S;
2245   glBitmapDefaultWrapT := T;
2246   glBitmapDefaultWrapR := R;
2247 end;
2248
2249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2250 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2251 begin
2252   glDefaultSwizzle[0] := r;
2253   glDefaultSwizzle[1] := g;
2254   glDefaultSwizzle[2] := b;
2255   glDefaultSwizzle[3] := a;
2256 end;
2257
2258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2259 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2260 begin
2261   result := glBitmapDefaultDeleteTextureOnFree;
2262 end;
2263
2264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2265 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2266 begin
2267   result := glBitmapDefaultFreeDataAfterGenTextures;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2272 begin
2273   result := glBitmapDefaultMipmap;
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 function glBitmapGetDefaultFormat: TglBitmapFormat;
2278 begin
2279   result := glBitmapDefaultFormat;
2280 end;
2281
2282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2283 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2284 begin
2285   aMin := glBitmapDefaultFilterMin;
2286   aMag := glBitmapDefaultFilterMag;
2287 end;
2288
2289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2290 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2291 begin
2292   S := glBitmapDefaultWrapS;
2293   T := glBitmapDefaultWrapT;
2294   R := glBitmapDefaultWrapR;
2295 end;
2296
2297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2299 begin
2300   r := glDefaultSwizzle[0];
2301   g := glDefaultSwizzle[1];
2302   b := glDefaultSwizzle[2];
2303   a := glDefaultSwizzle[3];
2304 end;
2305
2306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2307 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2309 function TFormatDescriptor.GetRedMask: QWord;
2310 begin
2311   result := fRange.r shl fShift.r;
2312 end;
2313
2314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2315 function TFormatDescriptor.GetGreenMask: QWord;
2316 begin
2317   result := fRange.g shl fShift.g;
2318 end;
2319
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 function TFormatDescriptor.GetBlueMask: QWord;
2322 begin
2323   result := fRange.b shl fShift.b;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function TFormatDescriptor.GetAlphaMask: QWord;
2328 begin
2329   result := fRange.a shl fShift.a;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function TFormatDescriptor.GetIsCompressed: Boolean;
2334 begin
2335   result := fIsCompressed;
2336 end;
2337
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function TFormatDescriptor.GetHasAlpha: Boolean;
2340 begin
2341   result := (fRange.a > 0);
2342 end;
2343
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function TFormatDescriptor.GetglFormat: GLenum;
2346 begin
2347   result := fglFormat;
2348 end;
2349
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 function TFormatDescriptor.GetglInternalFormat: GLenum;
2352 begin
2353   result := fglInternalFormat;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 function TFormatDescriptor.GetglDataFormat: GLenum;
2358 begin
2359   result := fglDataFormat;
2360 end;
2361
2362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2363 function TFormatDescriptor.GetComponents: Integer;
2364 var
2365   i: Integer;
2366 begin
2367   result := 0;
2368   for i := 0 to 3 do
2369     if (fRange.arr[i] > 0) then
2370       inc(result);
2371 end;
2372
2373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2374 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2375 var
2376   w, h: Integer;
2377 begin
2378   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2379     w := Max(1, aSize.X);
2380     h := Max(1, aSize.Y);
2381     result := GetSize(w, h);
2382   end else
2383     result := 0;
2384 end;
2385
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2388 begin
2389   result := 0;
2390   if (aWidth <= 0) or (aHeight <= 0) then
2391     exit;
2392   result := Ceil(aWidth * aHeight * fPixelSize);
2393 end;
2394
2395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2396 function TFormatDescriptor.CreateMappingData: Pointer;
2397 begin
2398   result := nil;
2399 end;
2400
2401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2403 begin
2404   //DUMMY
2405 end;
2406
2407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2408 function TFormatDescriptor.IsEmpty: Boolean;
2409 begin
2410   result := (fFormat = tfEmpty);
2411 end;
2412
2413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2414 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2415 begin
2416   result := false;
2417   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2418     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2419   if (aRedMask   <> RedMask) then
2420     exit;
2421   if (aGreenMask <> GreenMask) then
2422     exit;
2423   if (aBlueMask  <> BlueMask) then
2424     exit;
2425   if (aAlphaMask <> AlphaMask) then
2426     exit;
2427   result := true;
2428 end;
2429
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2432 begin
2433   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2434   aPixel.Data   := fRange;
2435   aPixel.Range  := fRange;
2436   aPixel.Format := fFormat;
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 constructor TFormatDescriptor.Create;
2441 begin
2442   inherited Create;
2443
2444   fFormat       := tfEmpty;
2445   fWithAlpha    := tfEmpty;
2446   fWithoutAlpha := tfEmpty;
2447   fRGBInverted  := tfEmpty;
2448   fUncompressed := tfEmpty;
2449   fPixelSize    := 0.0;
2450   fIsCompressed := false;
2451
2452   fglFormat         := 0;
2453   fglInternalFormat := 0;
2454   fglDataFormat     := 0;
2455
2456   FillChar(fRange, 0, SizeOf(fRange));
2457   FillChar(fShift, 0, SizeOf(fShift));
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2464 begin
2465   aData^ := aPixel.Data.a;
2466   inc(aData);
2467 end;
2468
2469 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2470 begin
2471   aPixel.Data.r := 0;
2472   aPixel.Data.g := 0;
2473   aPixel.Data.b := 0;
2474   aPixel.Data.a := aData^;
2475   inc(aData);
2476 end;
2477
2478 constructor TfdAlpha_UB1.Create;
2479 begin
2480   inherited Create;
2481   fPixelSize        := 1.0;
2482   fRange.a          := $FF;
2483   fglFormat         := GL_ALPHA;
2484   fglDataFormat     := GL_UNSIGNED_BYTE;
2485 end;
2486
2487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2491 begin
2492   aData^ := LuminanceWeight(aPixel);
2493   inc(aData);
2494 end;
2495
2496 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2497 begin
2498   aPixel.Data.r := aData^;
2499   aPixel.Data.g := aData^;
2500   aPixel.Data.b := aData^;
2501   aPixel.Data.a := 0;
2502   inc(aData);
2503 end;
2504
2505 constructor TfdLuminance_UB1.Create;
2506 begin
2507   inherited Create;
2508   fPixelSize        := 1.0;
2509   fRange.r          := $FF;
2510   fRange.g          := $FF;
2511   fRange.b          := $FF;
2512   fglFormat         := GL_LUMINANCE;
2513   fglDataFormat     := GL_UNSIGNED_BYTE;
2514 end;
2515
2516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2520 var
2521   i: Integer;
2522 begin
2523   aData^ := 0;
2524   for i := 0 to 3 do
2525     if (fRange.arr[i] > 0) then
2526       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2527   inc(aData);
2528 end;
2529
2530 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2531 var
2532   i: Integer;
2533 begin
2534   for i := 0 to 3 do
2535     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2536   inc(aData);
2537 end;
2538
2539 constructor TfdUniversal_UB1.Create;
2540 begin
2541   inherited Create;
2542   fPixelSize := 1.0;
2543 end;
2544
2545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2549 begin
2550   inherited Map(aPixel, aData, aMapData);
2551   aData^ := aPixel.Data.a;
2552   inc(aData);
2553 end;
2554
2555 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2556 begin
2557   inherited Unmap(aData, aPixel, aMapData);
2558   aPixel.Data.a := aData^;
2559   inc(aData);
2560 end;
2561
2562 constructor TfdLuminanceAlpha_UB2.Create;
2563 begin
2564   inherited Create;
2565   fPixelSize        := 2.0;
2566   fRange.a          := $FF;
2567   fShift.a          :=   8;
2568   fglFormat         := GL_LUMINANCE_ALPHA;
2569   fglDataFormat     := GL_UNSIGNED_BYTE;
2570 end;
2571
2572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2573 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2576 begin
2577   aData^ := aPixel.Data.r;
2578   inc(aData);
2579   aData^ := aPixel.Data.g;
2580   inc(aData);
2581   aData^ := aPixel.Data.b;
2582   inc(aData);
2583 end;
2584
2585 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2586 begin
2587   aPixel.Data.r := aData^;
2588   inc(aData);
2589   aPixel.Data.g := aData^;
2590   inc(aData);
2591   aPixel.Data.b := aData^;
2592   inc(aData);
2593   aPixel.Data.a := 0;
2594 end;
2595
2596 constructor TfdRGB_UB3.Create;
2597 begin
2598   inherited Create;
2599   fPixelSize        := 3.0;
2600   fRange.r          := $FF;
2601   fRange.g          := $FF;
2602   fRange.b          := $FF;
2603   fShift.r          :=   0;
2604   fShift.g          :=   8;
2605   fShift.b          :=  16;
2606   fglFormat         := GL_RGB;
2607   fglDataFormat     := GL_UNSIGNED_BYTE;
2608 end;
2609
2610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2614 begin
2615   aData^ := aPixel.Data.b;
2616   inc(aData);
2617   aData^ := aPixel.Data.g;
2618   inc(aData);
2619   aData^ := aPixel.Data.r;
2620   inc(aData);
2621 end;
2622
2623 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2624 begin
2625   aPixel.Data.b := aData^;
2626   inc(aData);
2627   aPixel.Data.g := aData^;
2628   inc(aData);
2629   aPixel.Data.r := aData^;
2630   inc(aData);
2631   aPixel.Data.a := 0;
2632 end;
2633
2634 constructor TfdBGR_UB3.Create;
2635 begin
2636   fPixelSize        := 3.0;
2637   fRange.r          := $FF;
2638   fRange.g          := $FF;
2639   fRange.b          := $FF;
2640   fShift.r          :=  16;
2641   fShift.g          :=   8;
2642   fShift.b          :=   0;
2643   fglFormat         := GL_BGR;
2644   fglDataFormat     := GL_UNSIGNED_BYTE;
2645 end;
2646
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2651 begin
2652   inherited Map(aPixel, aData, aMapData);
2653   aData^ := aPixel.Data.a;
2654   inc(aData);
2655 end;
2656
2657 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2658 begin
2659   inherited Unmap(aData, aPixel, aMapData);
2660   aPixel.Data.a := aData^;
2661   inc(aData);
2662 end;
2663
2664 constructor TfdRGBA_UB4.Create;
2665 begin
2666   inherited Create;
2667   fPixelSize        := 4.0;
2668   fRange.a          := $FF;
2669   fShift.a          :=  24;
2670   fglFormat         := GL_RGBA;
2671   fglDataFormat     := GL_UNSIGNED_BYTE;
2672 end;
2673
2674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2675 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2678 begin
2679   inherited Map(aPixel, aData, aMapData);
2680   aData^ := aPixel.Data.a;
2681   inc(aData);
2682 end;
2683
2684 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2685 begin
2686   inherited Unmap(aData, aPixel, aMapData);
2687   aPixel.Data.a := aData^;
2688   inc(aData);
2689 end;
2690
2691 constructor TfdBGRA_UB4.Create;
2692 begin
2693   inherited Create;
2694   fPixelSize        := 4.0;
2695   fRange.a          := $FF;
2696   fShift.a          :=  24;
2697   fglFormat         := GL_BGRA;
2698   fglDataFormat     := GL_UNSIGNED_BYTE;
2699 end;
2700
2701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2702 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2704 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2705 begin
2706   PWord(aData)^ := aPixel.Data.a;
2707   inc(aData, 2);
2708 end;
2709
2710 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2711 begin
2712   aPixel.Data.r := 0;
2713   aPixel.Data.g := 0;
2714   aPixel.Data.b := 0;
2715   aPixel.Data.a := PWord(aData)^;
2716   inc(aData, 2);
2717 end;
2718
2719 constructor TfdAlpha_US1.Create;
2720 begin
2721   inherited Create;
2722   fPixelSize        := 2.0;
2723   fRange.a          := $FFFF;
2724   fglFormat         := GL_ALPHA;
2725   fglDataFormat     := GL_UNSIGNED_SHORT;
2726 end;
2727
2728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2729 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2731 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2732 begin
2733   PWord(aData)^ := LuminanceWeight(aPixel);
2734   inc(aData, 2);
2735 end;
2736
2737 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2738 begin
2739   aPixel.Data.r := PWord(aData)^;
2740   aPixel.Data.g := PWord(aData)^;
2741   aPixel.Data.b := PWord(aData)^;
2742   aPixel.Data.a := 0;
2743   inc(aData, 2);
2744 end;
2745
2746 constructor TfdLuminance_US1.Create;
2747 begin
2748   inherited Create;
2749   fPixelSize        := 2.0;
2750   fRange.r          := $FFFF;
2751   fRange.g          := $FFFF;
2752   fRange.b          := $FFFF;
2753   fglFormat         := GL_LUMINANCE;
2754   fglDataFormat     := GL_UNSIGNED_SHORT;
2755 end;
2756
2757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2761 var
2762   i: Integer;
2763 begin
2764   PWord(aData)^ := 0;
2765   for i := 0 to 3 do
2766     if (fRange.arr[i] > 0) then
2767       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2768   inc(aData, 2);
2769 end;
2770
2771 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2772 var
2773   i: Integer;
2774 begin
2775   for i := 0 to 3 do
2776     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2777   inc(aData, 2);
2778 end;
2779
2780 constructor TfdUniversal_US1.Create;
2781 begin
2782   inherited Create;
2783   fPixelSize := 2.0;
2784 end;
2785
2786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2790 begin
2791   PWord(aData)^ := DepthWeight(aPixel);
2792   inc(aData, 2);
2793 end;
2794
2795 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2796 begin
2797   aPixel.Data.r := PWord(aData)^;
2798   aPixel.Data.g := PWord(aData)^;
2799   aPixel.Data.b := PWord(aData)^;
2800   aPixel.Data.a := 0;
2801   inc(aData, 2);
2802 end;
2803
2804 constructor TfdDepth_US1.Create;
2805 begin
2806   inherited Create;
2807   fPixelSize        := 2.0;
2808   fRange.r          := $FFFF;
2809   fRange.g          := $FFFF;
2810   fRange.b          := $FFFF;
2811   fglFormat         := GL_DEPTH_COMPONENT;
2812   fglDataFormat     := GL_UNSIGNED_SHORT;
2813 end;
2814
2815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2819 begin
2820   inherited Map(aPixel, aData, aMapData);
2821   PWord(aData)^ := aPixel.Data.a;
2822   inc(aData, 2);
2823 end;
2824
2825 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2826 begin
2827   inherited Unmap(aData, aPixel, aMapData);
2828   aPixel.Data.a := PWord(aData)^;
2829   inc(aData, 2);
2830 end;
2831
2832 constructor TfdLuminanceAlpha_US2.Create;
2833 begin
2834   inherited Create;
2835   fPixelSize        :=   4.0;
2836   fRange.a          := $FFFF;
2837   fShift.a          :=    16;
2838   fglFormat         := GL_LUMINANCE_ALPHA;
2839   fglDataFormat     := GL_UNSIGNED_SHORT;
2840 end;
2841
2842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2843 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2845 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2846 begin
2847   PWord(aData)^ := aPixel.Data.r;
2848   inc(aData, 2);
2849   PWord(aData)^ := aPixel.Data.g;
2850   inc(aData, 2);
2851   PWord(aData)^ := aPixel.Data.b;
2852   inc(aData, 2);
2853 end;
2854
2855 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2856 begin
2857   aPixel.Data.r := PWord(aData)^;
2858   inc(aData, 2);
2859   aPixel.Data.g := PWord(aData)^;
2860   inc(aData, 2);
2861   aPixel.Data.b := PWord(aData)^;
2862   inc(aData, 2);
2863   aPixel.Data.a := 0;
2864 end;
2865
2866 constructor TfdRGB_US3.Create;
2867 begin
2868   inherited Create;
2869   fPixelSize        :=   6.0;
2870   fRange.r          := $FFFF;
2871   fRange.g          := $FFFF;
2872   fRange.b          := $FFFF;
2873   fShift.r          :=     0;
2874   fShift.g          :=    16;
2875   fShift.b          :=    32;
2876   fglFormat         := GL_RGB;
2877   fglDataFormat     := GL_UNSIGNED_SHORT;
2878 end;
2879
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2884 begin
2885   PWord(aData)^ := aPixel.Data.b;
2886   inc(aData, 2);
2887   PWord(aData)^ := aPixel.Data.g;
2888   inc(aData, 2);
2889   PWord(aData)^ := aPixel.Data.r;
2890   inc(aData, 2);
2891 end;
2892
2893 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2894 begin
2895   aPixel.Data.b := PWord(aData)^;
2896   inc(aData, 2);
2897   aPixel.Data.g := PWord(aData)^;
2898   inc(aData, 2);
2899   aPixel.Data.r := PWord(aData)^;
2900   inc(aData, 2);
2901   aPixel.Data.a := 0;
2902 end;
2903
2904 constructor TfdBGR_US3.Create;
2905 begin
2906   inherited Create;
2907   fPixelSize        :=   6.0;
2908   fRange.r          := $FFFF;
2909   fRange.g          := $FFFF;
2910   fRange.b          := $FFFF;
2911   fShift.r          :=    32;
2912   fShift.g          :=    16;
2913   fShift.b          :=     0;
2914   fglFormat         := GL_BGR;
2915   fglDataFormat     := GL_UNSIGNED_SHORT;
2916 end;
2917
2918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2922 begin
2923   inherited Map(aPixel, aData, aMapData);
2924   PWord(aData)^ := aPixel.Data.a;
2925   inc(aData, 2);
2926 end;
2927
2928 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2929 begin
2930   inherited Unmap(aData, aPixel, aMapData);
2931   aPixel.Data.a := PWord(aData)^;
2932   inc(aData, 2);
2933 end;
2934
2935 constructor TfdRGBA_US4.Create;
2936 begin
2937   inherited Create;
2938   fPixelSize        :=   8.0;
2939   fRange.a          := $FFFF;
2940   fShift.a          :=    48;
2941   fglFormat         := GL_RGBA;
2942   fglDataFormat     := GL_UNSIGNED_SHORT;
2943 end;
2944
2945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2946 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2948 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2949 begin
2950   inherited Map(aPixel, aData, aMapData);
2951   PWord(aData)^ := aPixel.Data.a;
2952   inc(aData, 2);
2953 end;
2954
2955 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2956 begin
2957   inherited Unmap(aData, aPixel, aMapData);
2958   aPixel.Data.a := PWord(aData)^;
2959   inc(aData, 2);
2960 end;
2961
2962 constructor TfdBGRA_US4.Create;
2963 begin
2964   inherited Create;
2965   fPixelSize        :=   8.0;
2966   fRange.a          := $FFFF;
2967   fShift.a          :=    48;
2968   fglFormat         := GL_BGRA;
2969   fglDataFormat     := GL_UNSIGNED_SHORT;
2970 end;
2971
2972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2973 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2976 var
2977   i: Integer;
2978 begin
2979   PCardinal(aData)^ := 0;
2980   for i := 0 to 3 do
2981     if (fRange.arr[i] > 0) then
2982       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2983   inc(aData, 4);
2984 end;
2985
2986 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2987 var
2988   i: Integer;
2989 begin
2990   for i := 0 to 3 do
2991     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2992   inc(aData, 2);
2993 end;
2994
2995 constructor TfdUniversal_UI1.Create;
2996 begin
2997   inherited Create;
2998   fPixelSize := 4.0;
2999 end;
3000
3001 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3002 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3004 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3005 begin
3006   PCardinal(aData)^ := DepthWeight(aPixel);
3007   inc(aData, 4);
3008 end;
3009
3010 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3011 begin
3012   aPixel.Data.r := PCardinal(aData)^;
3013   aPixel.Data.g := PCardinal(aData)^;
3014   aPixel.Data.b := PCardinal(aData)^;
3015   aPixel.Data.a := 0;
3016   inc(aData, 4);
3017 end;
3018
3019 constructor TfdDepth_UI1.Create;
3020 begin
3021   inherited Create;
3022   fPixelSize        := 4.0;
3023   fRange.r          := $FFFFFFFF;
3024   fRange.g          := $FFFFFFFF;
3025   fRange.b          := $FFFFFFFF;
3026   fglFormat         := GL_DEPTH_COMPONENT;
3027   fglDataFormat     := GL_UNSIGNED_INT;
3028 end;
3029
3030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3033 constructor TfdAlpha4.Create;
3034 begin
3035   inherited Create;
3036   fFormat           := tfAlpha4;
3037   fWithAlpha        := tfAlpha4;
3038   fglInternalFormat := GL_ALPHA4;
3039 end;
3040
3041 constructor TfdAlpha8.Create;
3042 begin
3043   inherited Create;
3044   fFormat           := tfAlpha8;
3045   fWithAlpha        := tfAlpha8;
3046   fglInternalFormat := GL_ALPHA8;
3047 end;
3048
3049 constructor TfdAlpha12.Create;
3050 begin
3051   inherited Create;
3052   fFormat           := tfAlpha12;
3053   fWithAlpha        := tfAlpha12;
3054   fglInternalFormat := GL_ALPHA12;
3055 end;
3056
3057 constructor TfdAlpha16.Create;
3058 begin
3059   inherited Create;
3060   fFormat           := tfAlpha16;
3061   fWithAlpha        := tfAlpha16;
3062   fglInternalFormat := GL_ALPHA16;
3063 end;
3064
3065 constructor TfdLuminance4.Create;
3066 begin
3067   inherited Create;
3068   fFormat           := tfLuminance4;
3069   fWithAlpha        := tfLuminance4Alpha4;
3070   fWithoutAlpha     := tfLuminance4;
3071   fglInternalFormat := GL_LUMINANCE4;
3072 end;
3073
3074 constructor TfdLuminance8.Create;
3075 begin
3076   inherited Create;
3077   fFormat           := tfLuminance8;
3078   fWithAlpha        := tfLuminance8Alpha8;
3079   fWithoutAlpha     := tfLuminance8;
3080   fglInternalFormat := GL_LUMINANCE8;
3081 end;
3082
3083 constructor TfdLuminance12.Create;
3084 begin
3085   inherited Create;
3086   fFormat           := tfLuminance12;
3087   fWithAlpha        := tfLuminance12Alpha12;
3088   fWithoutAlpha     := tfLuminance12;
3089   fglInternalFormat := GL_LUMINANCE12;
3090 end;
3091
3092 constructor TfdLuminance16.Create;
3093 begin
3094   inherited Create;
3095   fFormat           := tfLuminance16;
3096   fWithAlpha        := tfLuminance16Alpha16;
3097   fWithoutAlpha     := tfLuminance16;
3098   fglInternalFormat := GL_LUMINANCE16;
3099 end;
3100
3101 constructor TfdLuminance4Alpha4.Create;
3102 begin
3103   inherited Create;
3104   fFormat           := tfLuminance4Alpha4;
3105   fWithAlpha        := tfLuminance4Alpha4;
3106   fWithoutAlpha     := tfLuminance4;
3107   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3108 end;
3109
3110 constructor TfdLuminance6Alpha2.Create;
3111 begin
3112   inherited Create;
3113   fFormat           := tfLuminance6Alpha2;
3114   fWithAlpha        := tfLuminance6Alpha2;
3115   fWithoutAlpha     := tfLuminance8;
3116   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3117 end;
3118
3119 constructor TfdLuminance8Alpha8.Create;
3120 begin
3121   inherited Create;
3122   fFormat           := tfLuminance8Alpha8;
3123   fWithAlpha        := tfLuminance8Alpha8;
3124   fWithoutAlpha     := tfLuminance8;
3125   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3126 end;
3127
3128 constructor TfdLuminance12Alpha4.Create;
3129 begin
3130   inherited Create;
3131   fFormat           := tfLuminance12Alpha4;
3132   fWithAlpha        := tfLuminance12Alpha4;
3133   fWithoutAlpha     := tfLuminance12;
3134   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3135 end;
3136
3137 constructor TfdLuminance12Alpha12.Create;
3138 begin
3139   inherited Create;
3140   fFormat           := tfLuminance12Alpha12;
3141   fWithAlpha        := tfLuminance12Alpha12;
3142   fWithoutAlpha     := tfLuminance12;
3143   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3144 end;
3145
3146 constructor TfdLuminance16Alpha16.Create;
3147 begin
3148   inherited Create;
3149   fFormat           := tfLuminance16Alpha16;
3150   fWithAlpha        := tfLuminance16Alpha16;
3151   fWithoutAlpha     := tfLuminance16;
3152   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3153 end;
3154
3155 constructor TfdR3G3B2.Create;
3156 begin
3157   inherited Create;
3158   fFormat           := tfR3G3B2;
3159   fWithAlpha        := tfRGBA2;
3160   fWithoutAlpha     := tfR3G3B2;
3161   fRange.r          := $7;
3162   fRange.g          := $7;
3163   fRange.b          := $3;
3164   fShift.r          :=  0;
3165   fShift.g          :=  3;
3166   fShift.b          :=  6;
3167   fglFormat         := GL_RGB;
3168   fglInternalFormat := GL_R3_G3_B2;
3169   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3170 end;
3171
3172 constructor TfdRGB4.Create;
3173 begin
3174   inherited Create;
3175   fFormat           := tfRGB4;
3176   fWithAlpha        := tfRGBA4;
3177   fWithoutAlpha     := tfRGB4;
3178   fRGBInverted      := tfBGR4;
3179   fRange.r          := $F;
3180   fRange.g          := $F;
3181   fRange.b          := $F;
3182   fShift.r          :=  0;
3183   fShift.g          :=  4;
3184   fShift.b          :=  8;
3185   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3186   fglInternalFormat := GL_RGB4;
3187   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3188 end;
3189
3190 constructor TfdR5G6B5.Create;
3191 begin
3192   inherited Create;
3193   fFormat           := tfR5G6B5;
3194   fWithAlpha        := tfRGBA4;
3195   fWithoutAlpha     := tfR5G6B5;
3196   fRGBInverted      := tfB5G6R5;
3197   fRange.r          := $1F;
3198   fRange.g          := $3F;
3199   fRange.b          := $1F;
3200   fShift.r          :=   0;
3201   fShift.g          :=   5;
3202   fShift.b          :=  11;
3203   fglFormat         := GL_RGB;
3204   fglInternalFormat := GL_RGB565;
3205   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3206 end;
3207
3208 constructor TfdRGB5.Create;
3209 begin
3210   inherited Create;
3211   fFormat           := tfRGB5;
3212   fWithAlpha        := tfRGB5A1;
3213   fWithoutAlpha     := tfRGB5;
3214   fRGBInverted      := tfBGR5;
3215   fRange.r          := $1F;
3216   fRange.g          := $1F;
3217   fRange.b          := $1F;
3218   fShift.r          :=   0;
3219   fShift.g          :=   5;
3220   fShift.b          :=  10;
3221   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3222   fglInternalFormat := GL_RGB5;
3223   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3224 end;
3225
3226 constructor TfdRGB8.Create;
3227 begin
3228   inherited Create;
3229   fFormat           := tfRGB8;
3230   fWithAlpha        := tfRGBA8;
3231   fWithoutAlpha     := tfRGB8;
3232   fRGBInverted      := tfBGR8;
3233   fglInternalFormat := GL_RGB8;
3234 end;
3235
3236 constructor TfdRGB10.Create;
3237 begin
3238   inherited Create;
3239   fFormat           := tfRGB10;
3240   fWithAlpha        := tfRGB10A2;
3241   fWithoutAlpha     := tfRGB10;
3242   fRGBInverted      := tfBGR10;
3243   fRange.r          := $3FF;
3244   fRange.g          := $3FF;
3245   fRange.b          := $3FF;
3246   fShift.r          :=    0;
3247   fShift.g          :=   10;
3248   fShift.b          :=   20;
3249   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3250   fglInternalFormat := GL_RGB10;
3251   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3252 end;
3253
3254 constructor TfdRGB12.Create;
3255 begin
3256   inherited Create;
3257   fFormat           := tfRGB12;
3258   fWithAlpha        := tfRGBA12;
3259   fWithoutAlpha     := tfRGB12;
3260   fRGBInverted      := tfBGR12;
3261   fglInternalFormat := GL_RGB12;
3262 end;
3263
3264 constructor TfdRGB16.Create;
3265 begin
3266   inherited Create;
3267   fFormat           := tfRGB16;
3268   fWithAlpha        := tfRGBA16;
3269   fWithoutAlpha     := tfRGB16;
3270   fRGBInverted      := tfBGR16;
3271   fglInternalFormat := GL_RGB16;
3272 end;
3273
3274 constructor TfdRGBA2.Create;
3275 begin
3276   inherited Create;
3277   fFormat           := tfRGBA2;
3278   fWithAlpha        := tfRGBA2;
3279   fWithoutAlpha     := tfR3G3B2;
3280   fRGBInverted      := tfBGRA2;
3281   fglInternalFormat := GL_RGBA2;
3282 end;
3283
3284 constructor TfdRGBA4.Create;
3285 begin
3286   inherited Create;
3287   fFormat           := tfRGBA4;
3288   fWithAlpha        := tfRGBA4;
3289   fWithoutAlpha     := tfRGB4;
3290   fRGBInverted      := tfBGRA4;
3291   fRange.r          := $F;
3292   fRange.g          := $F;
3293   fRange.b          := $F;
3294   fRange.a          := $F;
3295   fShift.r          :=  0;
3296   fShift.g          :=  4;
3297   fShift.b          :=  8;
3298   fShift.a          := 12;
3299   fglFormat         := GL_RGBA;
3300   fglInternalFormat := GL_RGBA4;
3301   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3302 end;
3303
3304 constructor TfdRGB5A1.Create;
3305 begin
3306   inherited Create;
3307   fFormat           := tfRGB5A1;
3308   fWithAlpha        := tfRGB5A1;
3309   fWithoutAlpha     := tfRGB5;
3310   fRGBInverted      := tfBGR5A1;
3311   fRange.r          := $1F;
3312   fRange.g          := $1F;
3313   fRange.b          := $1F;
3314   fRange.a          := $01;
3315   fShift.r          :=   0;
3316   fShift.g          :=   5;
3317   fShift.b          :=  10;
3318   fShift.a          :=  15;
3319   fglFormat         := GL_RGBA;
3320   fglInternalFormat := GL_RGB5_A1;
3321   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3322 end;
3323
3324 constructor TfdRGBA8.Create;
3325 begin
3326   inherited Create;
3327   fFormat           := tfRGBA8;
3328   fWithAlpha        := tfRGBA8;
3329   fWithoutAlpha     := tfRGB8;
3330   fRGBInverted      := tfBGRA8;
3331   fglInternalFormat := GL_RGBA8;
3332 end;
3333
3334 constructor TfdRGB10A2.Create;
3335 begin
3336   inherited Create;
3337   fFormat           := tfRGB10A2;
3338   fWithAlpha        := tfRGB10A2;
3339   fWithoutAlpha     := tfRGB10;
3340   fRGBInverted      := tfBGR10A2;
3341   fRange.r          := $3FF;
3342   fRange.g          := $3FF;
3343   fRange.b          := $3FF;
3344   fRange.a          := $003;
3345   fShift.r          :=    0;
3346   fShift.g          :=   10;
3347   fShift.b          :=   20;
3348   fShift.a          :=   30;
3349   fglFormat         := GL_RGBA;
3350   fglInternalFormat := GL_RGB10_A2;
3351   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3352 end;
3353
3354 constructor TfdRGBA12.Create;
3355 begin
3356   inherited Create;
3357   fFormat           := tfRGBA12;
3358   fWithAlpha        := tfRGBA12;
3359   fWithoutAlpha     := tfRGB12;
3360   fRGBInverted      := tfBGRA12;
3361   fglInternalFormat := GL_RGBA12;
3362 end;
3363
3364 constructor TfdRGBA16.Create;
3365 begin
3366   inherited Create;
3367   fFormat           := tfRGBA16;
3368   fWithAlpha        := tfRGBA16;
3369   fWithoutAlpha     := tfRGB16;
3370   fRGBInverted      := tfBGRA16;
3371   fglInternalFormat := GL_RGBA16;
3372 end;
3373
3374 constructor TfdBGR4.Create;
3375 begin
3376   inherited Create;
3377   fPixelSize        := 2.0;
3378   fFormat           := tfBGR4;
3379   fWithAlpha        := tfBGRA4;
3380   fWithoutAlpha     := tfBGR4;
3381   fRGBInverted      := tfRGB4;
3382   fRange.r          := $F;
3383   fRange.g          := $F;
3384   fRange.b          := $F;
3385   fRange.a          := $0;
3386   fShift.r          :=  8;
3387   fShift.g          :=  4;
3388   fShift.b          :=  0;
3389   fShift.a          :=  0;
3390   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3391   fglInternalFormat := GL_RGB4;
3392   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3393 end;
3394
3395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3398 constructor TfdB5G6R5.Create;
3399 begin
3400   inherited Create;
3401   fFormat           := tfB5G6R5;
3402   fWithAlpha        := tfBGRA4;
3403   fWithoutAlpha     := tfB5G6R5;
3404   fRGBInverted      := tfR5G6B5;
3405   fRange.r          := $1F;
3406   fRange.g          := $3F;
3407   fRange.b          := $1F;
3408   fShift.r          :=  11;
3409   fShift.g          :=   5;
3410   fShift.b          :=   0;
3411   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3412   fglInternalFormat := GL_RGB8;
3413   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3414 end;
3415
3416 constructor TfdBGR5.Create;
3417 begin
3418   inherited Create;
3419   fPixelSize        := 2.0;
3420   fFormat           := tfBGR5;
3421   fWithAlpha        := tfBGR5A1;
3422   fWithoutAlpha     := tfBGR5;
3423   fRGBInverted      := tfRGB5;
3424   fRange.r          := $1F;
3425   fRange.g          := $1F;
3426   fRange.b          := $1F;
3427   fRange.a          := $00;
3428   fShift.r          :=  10;
3429   fShift.g          :=   5;
3430   fShift.b          :=   0;
3431   fShift.a          :=   0;
3432   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3433   fglInternalFormat := GL_RGB5;
3434   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3435 end;
3436
3437 constructor TfdBGR8.Create;
3438 begin
3439   inherited Create;
3440   fFormat           := tfBGR8;
3441   fWithAlpha        := tfBGRA8;
3442   fWithoutAlpha     := tfBGR8;
3443   fRGBInverted      := tfRGB8;
3444   fglInternalFormat := GL_RGB8;
3445 end;
3446
3447 constructor TfdBGR10.Create;
3448 begin
3449   inherited Create;
3450   fFormat           := tfBGR10;
3451   fWithAlpha        := tfBGR10A2;
3452   fWithoutAlpha     := tfBGR10;
3453   fRGBInverted      := tfRGB10;
3454   fRange.r          := $3FF;
3455   fRange.g          := $3FF;
3456   fRange.b          := $3FF;
3457   fRange.a          := $000;
3458   fShift.r          :=   20;
3459   fShift.g          :=   10;
3460   fShift.b          :=    0;
3461   fShift.a          :=    0;
3462   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3463   fglInternalFormat := GL_RGB10;
3464   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3465 end;
3466
3467 constructor TfdBGR12.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfBGR12;
3471   fWithAlpha        := tfBGRA12;
3472   fWithoutAlpha     := tfBGR12;
3473   fRGBInverted      := tfRGB12;
3474   fglInternalFormat := GL_RGB12;
3475 end;
3476
3477 constructor TfdBGR16.Create;
3478 begin
3479   inherited Create;
3480   fFormat           := tfBGR16;
3481   fWithAlpha        := tfBGRA16;
3482   fWithoutAlpha     := tfBGR16;
3483   fRGBInverted      := tfRGB16;
3484   fglInternalFormat := GL_RGB16;
3485 end;
3486
3487 constructor TfdBGRA2.Create;
3488 begin
3489   inherited Create;
3490   fFormat           := tfBGRA2;
3491   fWithAlpha        := tfBGRA4;
3492   fWithoutAlpha     := tfBGR4;
3493   fRGBInverted      := tfRGBA2;
3494   fglInternalFormat := GL_RGBA2;
3495 end;
3496
3497 constructor TfdBGRA4.Create;
3498 begin
3499   inherited Create;
3500   fFormat           := tfBGRA4;
3501   fWithAlpha        := tfBGRA4;
3502   fWithoutAlpha     := tfBGR4;
3503   fRGBInverted      := tfRGBA4;
3504   fRange.r          := $F;
3505   fRange.g          := $F;
3506   fRange.b          := $F;
3507   fRange.a          := $F;
3508   fShift.r          :=  8;
3509   fShift.g          :=  4;
3510   fShift.b          :=  0;
3511   fShift.a          := 12;
3512   fglFormat         := GL_BGRA;
3513   fglInternalFormat := GL_RGBA4;
3514   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3515 end;
3516
3517 constructor TfdBGR5A1.Create;
3518 begin
3519   inherited Create;
3520   fFormat           := tfBGR5A1;
3521   fWithAlpha        := tfBGR5A1;
3522   fWithoutAlpha     := tfBGR5;
3523   fRGBInverted      := tfRGB5A1;
3524   fRange.r          := $1F;
3525   fRange.g          := $1F;
3526   fRange.b          := $1F;
3527   fRange.a          := $01;
3528   fShift.r          :=  10;
3529   fShift.g          :=   5;
3530   fShift.b          :=   0;
3531   fShift.a          :=  15;
3532   fglFormat         := GL_BGRA;
3533   fglInternalFormat := GL_RGB5_A1;
3534   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3535 end;
3536
3537 constructor TfdBGRA8.Create;
3538 begin
3539   inherited Create;
3540   fFormat           := tfBGRA8;
3541   fWithAlpha        := tfBGRA8;
3542   fWithoutAlpha     := tfBGR8;
3543   fRGBInverted      := tfRGBA8;
3544   fglInternalFormat := GL_RGBA8;
3545 end;
3546
3547 constructor TfdBGR10A2.Create;
3548 begin
3549   inherited Create;
3550   fFormat           := tfBGR10A2;
3551   fWithAlpha        := tfBGR10A2;
3552   fWithoutAlpha     := tfBGR10;
3553   fRGBInverted      := tfRGB10A2;
3554   fRange.r          := $3FF;
3555   fRange.g          := $3FF;
3556   fRange.b          := $3FF;
3557   fRange.a          := $003;
3558   fShift.r          :=   20;
3559   fShift.g          :=   10;
3560   fShift.b          :=    0;
3561   fShift.a          :=   30;
3562   fglFormat         := GL_BGRA;
3563   fglInternalFormat := GL_RGB10_A2;
3564   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3565 end;
3566
3567 constructor TfdBGRA12.Create;
3568 begin
3569   inherited Create;
3570   fFormat           := tfBGRA12;
3571   fWithAlpha        := tfBGRA12;
3572   fWithoutAlpha     := tfBGR12;
3573   fRGBInverted      := tfRGBA12;
3574   fglInternalFormat := GL_RGBA12;
3575 end;
3576
3577 constructor TfdBGRA16.Create;
3578 begin
3579   inherited Create;
3580   fFormat           := tfBGRA16;
3581   fWithAlpha        := tfBGRA16;
3582   fWithoutAlpha     := tfBGR16;
3583   fRGBInverted      := tfRGBA16;
3584   fglInternalFormat := GL_RGBA16;
3585 end;
3586
3587 constructor TfdDepth16.Create;
3588 begin
3589   inherited Create;
3590   fFormat           := tfDepth16;
3591   fWithAlpha        := tfEmpty;
3592   fWithoutAlpha     := tfDepth16;
3593   fglInternalFormat := GL_DEPTH_COMPONENT16;
3594 end;
3595
3596 constructor TfdDepth24.Create;
3597 begin
3598   inherited Create;
3599   fFormat           := tfDepth24;
3600   fWithAlpha        := tfEmpty;
3601   fWithoutAlpha     := tfDepth24;
3602   fglInternalFormat := GL_DEPTH_COMPONENT24;
3603 end;
3604
3605 constructor TfdDepth32.Create;
3606 begin
3607   inherited Create;
3608   fFormat           := tfDepth32;
3609   fWithAlpha        := tfEmpty;
3610   fWithoutAlpha     := tfDepth32;
3611   fglInternalFormat := GL_DEPTH_COMPONENT32;
3612 end;
3613
3614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3615 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3617 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3618 begin
3619   raise EglBitmap.Create('mapping for compressed formats is not supported');
3620 end;
3621
3622 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3623 begin
3624   raise EglBitmap.Create('mapping for compressed formats is not supported');
3625 end;
3626
3627 constructor TfdS3tcDtx1RGBA.Create;
3628 begin
3629   inherited Create;
3630   fFormat           := tfS3tcDtx1RGBA;
3631   fWithAlpha        := tfS3tcDtx1RGBA;
3632   fUncompressed     := tfRGB5A1;
3633   fPixelSize        := 0.5;
3634   fIsCompressed     := true;
3635   fglFormat         := GL_COMPRESSED_RGBA;
3636   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3637   fglDataFormat     := GL_UNSIGNED_BYTE;
3638 end;
3639
3640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3641 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3643 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3644 begin
3645   raise EglBitmap.Create('mapping for compressed formats is not supported');
3646 end;
3647
3648 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3649 begin
3650   raise EglBitmap.Create('mapping for compressed formats is not supported');
3651 end;
3652
3653 constructor TfdS3tcDtx3RGBA.Create;
3654 begin
3655   inherited Create;
3656   fFormat           := tfS3tcDtx3RGBA;
3657   fWithAlpha        := tfS3tcDtx3RGBA;
3658   fUncompressed     := tfRGBA8;
3659   fPixelSize        := 1.0;
3660   fIsCompressed     := true;
3661   fglFormat         := GL_COMPRESSED_RGBA;
3662   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3663   fglDataFormat     := GL_UNSIGNED_BYTE;
3664 end;
3665
3666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3667 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3669 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3670 begin
3671   raise EglBitmap.Create('mapping for compressed formats is not supported');
3672 end;
3673
3674 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3675 begin
3676   raise EglBitmap.Create('mapping for compressed formats is not supported');
3677 end;
3678
3679 constructor TfdS3tcDtx5RGBA.Create;
3680 begin
3681   inherited Create;
3682   fFormat           := tfS3tcDtx3RGBA;
3683   fWithAlpha        := tfS3tcDtx3RGBA;
3684   fUncompressed     := tfRGBA8;
3685   fPixelSize        := 1.0;
3686   fIsCompressed     := true;
3687   fglFormat         := GL_COMPRESSED_RGBA;
3688   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3689   fglDataFormat     := GL_UNSIGNED_BYTE;
3690 end;
3691
3692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3693 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3695 class procedure TFormatDescriptor.Init;
3696 begin
3697   if not Assigned(FormatDescriptorCS) then
3698     FormatDescriptorCS := TCriticalSection.Create;
3699 end;
3700
3701 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3702 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3703 begin
3704   FormatDescriptorCS.Enter;
3705   try
3706     result := FormatDescriptors[aFormat];
3707     if not Assigned(result) then begin
3708       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3709       FormatDescriptors[aFormat] := result;
3710     end;
3711   finally
3712     FormatDescriptorCS.Leave;
3713   end;
3714 end;
3715
3716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3717 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3718 begin
3719   result := Get(Get(aFormat).WithAlpha);
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 class procedure TFormatDescriptor.Clear;
3724 var
3725   f: TglBitmapFormat;
3726 begin
3727   FormatDescriptorCS.Enter;
3728   try
3729     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3730       FreeAndNil(FormatDescriptors[f]);
3731   finally
3732     FormatDescriptorCS.Leave;
3733   end;
3734 end;
3735
3736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3737 class procedure TFormatDescriptor.Finalize;
3738 begin
3739   Clear;
3740   FreeAndNil(FormatDescriptorCS);
3741 end;
3742
3743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3744 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3746 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3747 begin
3748   Update(aValue, fRange.r, fShift.r);
3749 end;
3750
3751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3752 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3753 begin
3754   Update(aValue, fRange.g, fShift.g);
3755 end;
3756
3757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3758 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3759 begin
3760   Update(aValue, fRange.b, fShift.b);
3761 end;
3762
3763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3764 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3765 begin
3766   Update(aValue, fRange.a, fShift.a);
3767 end;
3768
3769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3770 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3771   aShift: Byte);
3772 begin
3773   aShift := 0;
3774   aRange := 0;
3775   if (aMask = 0) then
3776     exit;
3777   while (aMask > 0) and ((aMask and 1) = 0) do begin
3778     inc(aShift);
3779     aMask := aMask shr 1;
3780   end;
3781   aRange := 1;
3782   while (aMask > 0) do begin
3783     aRange := aRange shl 1;
3784     aMask  := aMask  shr 1;
3785   end;
3786   dec(aRange);
3787
3788   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3789 end;
3790
3791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3793 var
3794   data: QWord;
3795   s: Integer;
3796 begin
3797   data :=
3798     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3799     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3800     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3801     ((aPixel.Data.a and fRange.a) shl fShift.a);
3802   s := Round(fPixelSize);
3803   case s of
3804     1:           aData^  := data;
3805     2:     PWord(aData)^ := data;
3806     4: PCardinal(aData)^ := data;
3807     8:    PQWord(aData)^ := data;
3808   else
3809     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3810   end;
3811   inc(aData, s);
3812 end;
3813
3814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3815 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3816 var
3817   data: QWord;
3818   s, i: Integer;
3819 begin
3820   s := Round(fPixelSize);
3821   case s of
3822     1: data :=           aData^;
3823     2: data :=     PWord(aData)^;
3824     4: data := PCardinal(aData)^;
3825     8: data :=    PQWord(aData)^;
3826   else
3827     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3828   end;
3829   for i := 0 to 3 do
3830     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3831   inc(aData, s);
3832 end;
3833
3834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3835 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3837 procedure TbmpColorTableFormat.CreateColorTable;
3838 var
3839   i: Integer;
3840 begin
3841   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3842     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3843
3844   if (Format = tfLuminance4) then
3845     SetLength(fColorTable, 16)
3846   else
3847     SetLength(fColorTable, 256);
3848
3849   case Format of
3850     tfLuminance4: begin
3851       for i := 0 to High(fColorTable) do begin
3852         fColorTable[i].r := 16 * i;
3853         fColorTable[i].g := 16 * i;
3854         fColorTable[i].b := 16 * i;
3855         fColorTable[i].a := 0;
3856       end;
3857     end;
3858
3859     tfLuminance8: begin
3860       for i := 0 to High(fColorTable) do begin
3861         fColorTable[i].r := i;
3862         fColorTable[i].g := i;
3863         fColorTable[i].b := i;
3864         fColorTable[i].a := 0;
3865       end;
3866     end;
3867
3868     tfR3G3B2: begin
3869       for i := 0 to High(fColorTable) do begin
3870         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3871         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3872         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3873         fColorTable[i].a := 0;
3874       end;
3875     end;
3876   end;
3877 end;
3878
3879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3880 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3881 var
3882   d: Byte;
3883 begin
3884   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3885     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3886
3887   case Format of
3888     tfLuminance4: begin
3889       if (aMapData = nil) then
3890         aData^ := 0;
3891       d := LuminanceWeight(aPixel) and Range.r;
3892       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3893       inc(PByte(aMapData), 4);
3894       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3895         inc(aData);
3896         aMapData := nil;
3897       end;
3898     end;
3899
3900     tfLuminance8: begin
3901       aData^ := LuminanceWeight(aPixel) and Range.r;
3902       inc(aData);
3903     end;
3904
3905     tfR3G3B2: begin
3906       aData^ := Round(
3907         ((aPixel.Data.r and Range.r) shl Shift.r) or
3908         ((aPixel.Data.g and Range.g) shl Shift.g) or
3909         ((aPixel.Data.b and Range.b) shl Shift.b));
3910       inc(aData);
3911     end;
3912   end;
3913 end;
3914
3915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3916 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3917 var
3918   idx: QWord;
3919   s: Integer;
3920   bits: Byte;
3921   f: Single;
3922 begin
3923   s    := Trunc(fPixelSize);
3924   f    := fPixelSize - s;
3925   bits := Round(8 * f);
3926   case s of
3927     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3928     1: idx :=           aData^;
3929     2: idx :=     PWord(aData)^;
3930     4: idx := PCardinal(aData)^;
3931     8: idx :=    PQWord(aData)^;
3932   else
3933     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3934   end;
3935   if (idx >= Length(fColorTable)) then
3936     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3937   with fColorTable[idx] do begin
3938     aPixel.Data.r := r;
3939     aPixel.Data.g := g;
3940     aPixel.Data.b := b;
3941     aPixel.Data.a := a;
3942   end;
3943   inc(PByte(aMapData), bits);
3944   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3945     inc(aData, 1);
3946     dec(PByte(aMapData), 8);
3947   end;
3948   inc(aData, s);
3949 end;
3950
3951 destructor TbmpColorTableFormat.Destroy;
3952 begin
3953   SetLength(fColorTable, 0);
3954   inherited Destroy;
3955 end;
3956
3957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3958 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3960 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3961 var
3962   i: Integer;
3963 begin
3964   for i := 0 to 3 do begin
3965     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3966       if (aSourceFD.Range.arr[i] > 0) then
3967         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3968       else
3969         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3970     end;
3971   end;
3972 end;
3973
3974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3975 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3976 begin
3977   with aFuncRec do begin
3978     if (Source.Range.r   > 0) then
3979       Dest.Data.r := Source.Data.r;
3980     if (Source.Range.g > 0) then
3981       Dest.Data.g := Source.Data.g;
3982     if (Source.Range.b  > 0) then
3983       Dest.Data.b := Source.Data.b;
3984     if (Source.Range.a > 0) then
3985       Dest.Data.a := Source.Data.a;
3986   end;
3987 end;
3988
3989 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3990 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3991 var
3992   i: Integer;
3993 begin
3994   with aFuncRec do begin
3995     for i := 0 to 3 do
3996       if (Source.Range.arr[i] > 0) then
3997         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3998   end;
3999 end;
4000
4001 type
4002   TShiftData = packed record
4003     case Integer of
4004       0: (r, g, b, a: SmallInt);
4005       1: (arr: array[0..3] of SmallInt);
4006   end;
4007   PShiftData = ^TShiftData;
4008
4009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4010 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4011 var
4012   i: Integer;
4013 begin
4014   with aFuncRec do
4015     for i := 0 to 3 do
4016       if (Source.Range.arr[i] > 0) then
4017         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4022 begin
4023   with aFuncRec do begin
4024     Dest.Data := Source.Data;
4025     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4026       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4027       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4028       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4029     end;
4030     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4031       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4032     end;
4033   end;
4034 end;
4035
4036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4037 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4038 var
4039   i: Integer;
4040 begin
4041   with aFuncRec do begin
4042     for i := 0 to 3 do
4043       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4044   end;
4045 end;
4046
4047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4048 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4049 var
4050   Temp: Single;
4051 begin
4052   with FuncRec do begin
4053     if (FuncRec.Args = nil) then begin //source has no alpha
4054       Temp :=
4055         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4056         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4057         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4058       Dest.Data.a := Round(Dest.Range.a * Temp);
4059     end else
4060       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4061   end;
4062 end;
4063
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4066 type
4067   PglBitmapPixelData = ^TglBitmapPixelData;
4068 begin
4069   with FuncRec do begin
4070     Dest.Data.r := Source.Data.r;
4071     Dest.Data.g := Source.Data.g;
4072     Dest.Data.b := Source.Data.b;
4073
4074     with PglBitmapPixelData(Args)^ do
4075       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4076           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4077           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4078         Dest.Data.a := 0
4079       else
4080         Dest.Data.a := Dest.Range.a;
4081   end;
4082 end;
4083
4084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4085 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4086 begin
4087   with FuncRec do begin
4088     Dest.Data.r := Source.Data.r;
4089     Dest.Data.g := Source.Data.g;
4090     Dest.Data.b := Source.Data.b;
4091     Dest.Data.a := PCardinal(Args)^;
4092   end;
4093 end;
4094
4095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4096 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4097 type
4098   PRGBPix = ^TRGBPix;
4099   TRGBPix = array [0..2] of byte;
4100 var
4101   Temp: Byte;
4102 begin
4103   while aWidth > 0 do begin
4104     Temp := PRGBPix(aData)^[0];
4105     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4106     PRGBPix(aData)^[2] := Temp;
4107
4108     if aHasAlpha then
4109       Inc(aData, 4)
4110     else
4111       Inc(aData, 3);
4112     dec(aWidth);
4113   end;
4114 end;
4115
4116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4117 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4120 begin
4121   result := TFormatDescriptor.Get(Format);
4122 end;
4123
4124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4125 function TglBitmap.GetWidth: Integer;
4126 begin
4127   if (ffX in fDimension.Fields) then
4128     result := fDimension.X
4129   else
4130     result := -1;
4131 end;
4132
4133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4134 function TglBitmap.GetHeight: Integer;
4135 begin
4136   if (ffY in fDimension.Fields) then
4137     result := fDimension.Y
4138   else
4139     result := -1;
4140 end;
4141
4142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 function TglBitmap.GetFileWidth: Integer;
4144 begin
4145   result := Max(1, Width);
4146 end;
4147
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 function TglBitmap.GetFileHeight: Integer;
4150 begin
4151   result := Max(1, Height);
4152 end;
4153
4154 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4156 begin
4157   if fCustomData = aValue then
4158     exit;
4159   fCustomData := aValue;
4160 end;
4161
4162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4163 procedure TglBitmap.SetCustomName(const aValue: String);
4164 begin
4165   if fCustomName = aValue then
4166     exit;
4167   fCustomName := aValue;
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4172 begin
4173   if fCustomNameW = aValue then
4174     exit;
4175   fCustomNameW := aValue;
4176 end;
4177
4178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4179 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4180 begin
4181   if fDeleteTextureOnFree = aValue then
4182     exit;
4183   fDeleteTextureOnFree := aValue;
4184 end;
4185
4186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4187 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4188 begin
4189   if fFormat = aValue then
4190     exit;
4191   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4192     raise EglBitmapUnsupportedFormat.Create(Format);
4193   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4194 end;
4195
4196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4197 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4198 begin
4199   if fFreeDataAfterGenTexture = aValue then
4200     exit;
4201   fFreeDataAfterGenTexture := aValue;
4202 end;
4203
4204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4205 procedure TglBitmap.SetID(const aValue: Cardinal);
4206 begin
4207   if fID = aValue then
4208     exit;
4209   fID := aValue;
4210 end;
4211
4212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4213 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4214 begin
4215   if fMipMap = aValue then
4216     exit;
4217   fMipMap := aValue;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4222 begin
4223   if fTarget = aValue then
4224     exit;
4225   fTarget := aValue;
4226 end;
4227
4228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4229 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4230 var
4231   MaxAnisotropic: Integer;
4232 begin
4233   fAnisotropic := aValue;
4234   if (ID > 0) then begin
4235     if GL_EXT_texture_filter_anisotropic then begin
4236       if fAnisotropic > 0 then begin
4237         Bind(false);
4238         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4239         if aValue > MaxAnisotropic then
4240           fAnisotropic := MaxAnisotropic;
4241         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4242       end;
4243     end else begin
4244       fAnisotropic := 0;
4245     end;
4246   end;
4247 end;
4248
4249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4250 procedure TglBitmap.CreateID;
4251 begin
4252   if (ID <> 0) then
4253     glDeleteTextures(1, @fID);
4254   glGenTextures(1, @fID);
4255   Bind(false);
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4260 begin
4261   // Set Up Parameters
4262   SetWrap(fWrapS, fWrapT, fWrapR);
4263   SetFilter(fFilterMin, fFilterMag);
4264   SetAnisotropic(fAnisotropic);
4265   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4266
4267   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4268     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4269
4270   // Mip Maps Generation Mode
4271   aBuildWithGlu := false;
4272   if (MipMap = mmMipmap) then begin
4273     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4274       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4275     else
4276       aBuildWithGlu := true;
4277   end else if (MipMap = mmMipmapGlu) then
4278     aBuildWithGlu := true;
4279 end;
4280
4281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4282 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4283   const aWidth: Integer; const aHeight: Integer);
4284 var
4285   s: Single;
4286 begin
4287   if (Data <> aData) then begin
4288     if (Assigned(Data)) then
4289       FreeMem(Data);
4290     fData := aData;
4291   end;
4292
4293   if not Assigned(fData) then begin
4294     fPixelSize := 0;
4295     fRowSize   := 0;
4296   end else begin
4297     FillChar(fDimension, SizeOf(fDimension), 0);
4298     if aWidth <> -1 then begin
4299       fDimension.Fields := fDimension.Fields + [ffX];
4300       fDimension.X := aWidth;
4301     end;
4302
4303     if aHeight <> -1 then begin
4304       fDimension.Fields := fDimension.Fields + [ffY];
4305       fDimension.Y := aHeight;
4306     end;
4307
4308     s := TFormatDescriptor.Get(aFormat).PixelSize;
4309     fFormat    := aFormat;
4310     fPixelSize := Ceil(s);
4311     fRowSize   := Ceil(s * aWidth);
4312   end;
4313 end;
4314
4315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4316 function TglBitmap.FlipHorz: Boolean;
4317 begin
4318   result := false;
4319 end;
4320
4321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4322 function TglBitmap.FlipVert: Boolean;
4323 begin
4324   result := false;
4325 end;
4326
4327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4330 procedure TglBitmap.AfterConstruction;
4331 begin
4332   inherited AfterConstruction;
4333
4334   fID         := 0;
4335   fTarget     := 0;
4336   fIsResident := false;
4337
4338   fFormat                  := glBitmapGetDefaultFormat;
4339   fMipMap                  := glBitmapDefaultMipmap;
4340   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4341   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4342
4343   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4344   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4345   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 procedure TglBitmap.BeforeDestruction;
4350 var
4351   NewData: PByte;
4352 begin
4353   NewData := nil;
4354   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4355   if (fID > 0) and fDeleteTextureOnFree then
4356     glDeleteTextures(1, @fID);
4357   inherited BeforeDestruction;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4362 var
4363   TempPos: Integer;
4364 begin
4365   if not Assigned(aResType) then begin
4366     TempPos   := Pos('.', aResource);
4367     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4368     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4369   end;
4370 end;
4371
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 procedure TglBitmap.LoadFromFile(const aFilename: String);
4374 var
4375   fs: TFileStream;
4376 begin
4377   if not FileExists(aFilename) then
4378     raise EglBitmap.Create('file does not exist: ' + aFilename);
4379   fFilename := aFilename;
4380   fs := TFileStream.Create(fFilename, fmOpenRead);
4381   try
4382     fs.Position := 0;
4383     LoadFromStream(fs);
4384   finally
4385     fs.Free;
4386   end;
4387 end;
4388
4389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4390 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4391 begin
4392   {$IFDEF GLB_SUPPORT_PNG_READ}
4393   if not LoadPNG(aStream) then
4394   {$ENDIF}
4395   {$IFDEF GLB_SUPPORT_JPEG_READ}
4396   if not LoadJPEG(aStream) then
4397   {$ENDIF}
4398   if not LoadDDS(aStream) then
4399   if not LoadTGA(aStream) then
4400   if not LoadBMP(aStream) then
4401     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4402 end;
4403
4404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4405 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4406   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4407 var
4408   tmpData: PByte;
4409   size: Integer;
4410 begin
4411   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4412   GetMem(tmpData, size);
4413   try
4414     FillChar(tmpData^, size, #$FF);
4415     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4416   except
4417     if Assigned(tmpData) then
4418       FreeMem(tmpData);
4419     raise;
4420   end;
4421   AddFunc(Self, aFunc, false, Format, aArgs);
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4426 var
4427   rs: TResourceStream;
4428 begin
4429   PrepareResType(aResource, aResType);
4430   rs := TResourceStream.Create(aInstance, aResource, aResType);
4431   try
4432     LoadFromStream(rs);
4433   finally
4434     rs.Free;
4435   end;
4436 end;
4437
4438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4439 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4440 var
4441   rs: TResourceStream;
4442 begin
4443   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4444   try
4445     LoadFromStream(rs);
4446   finally
4447     rs.Free;
4448   end;
4449 end;
4450
4451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4452 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4453 var
4454   fs: TFileStream;
4455 begin
4456   fs := TFileStream.Create(aFileName, fmCreate);
4457   try
4458     fs.Position := 0;
4459     SaveToStream(fs, aFileType);
4460   finally
4461     fs.Free;
4462   end;
4463 end;
4464
4465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4466 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4467 begin
4468   case aFileType of
4469     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4470     ftPNG:  SavePNG(aStream);
4471     {$ENDIF}
4472     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4473     ftJPEG: SaveJPEG(aStream);
4474     {$ENDIF}
4475     ftDDS:  SaveDDS(aStream);
4476     ftTGA:  SaveTGA(aStream);
4477     ftBMP:  SaveBMP(aStream);
4478   end;
4479 end;
4480
4481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4482 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4483 begin
4484   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4485 end;
4486
4487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4488 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4489   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4490 var
4491   DestData, TmpData, SourceData: pByte;
4492   TempHeight, TempWidth: Integer;
4493   SourceFD, DestFD: TFormatDescriptor;
4494   SourceMD, DestMD: Pointer;
4495
4496   FuncRec: TglBitmapFunctionRec;
4497 begin
4498   Assert(Assigned(Data));
4499   Assert(Assigned(aSource));
4500   Assert(Assigned(aSource.Data));
4501
4502   result := false;
4503   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4504     SourceFD := TFormatDescriptor.Get(aSource.Format);
4505     DestFD   := TFormatDescriptor.Get(aFormat);
4506
4507     if (SourceFD.IsCompressed) then
4508       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4509     if (DestFD.IsCompressed) then
4510       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4511
4512     // inkompatible Formats so CreateTemp
4513     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4514       aCreateTemp := true;
4515
4516     // Values
4517     TempHeight := Max(1, aSource.Height);
4518     TempWidth  := Max(1, aSource.Width);
4519
4520     FuncRec.Sender := Self;
4521     FuncRec.Args   := aArgs;
4522
4523     TmpData := nil;
4524     if aCreateTemp then begin
4525       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4526       DestData := TmpData;
4527     end else
4528       DestData := Data;
4529
4530     try
4531       SourceFD.PreparePixel(FuncRec.Source);
4532       DestFD.PreparePixel  (FuncRec.Dest);
4533
4534       SourceMD := SourceFD.CreateMappingData;
4535       DestMD   := DestFD.CreateMappingData;
4536
4537       FuncRec.Size            := aSource.Dimension;
4538       FuncRec.Position.Fields := FuncRec.Size.Fields;
4539
4540       try
4541         SourceData := aSource.Data;
4542         FuncRec.Position.Y := 0;
4543         while FuncRec.Position.Y < TempHeight do begin
4544           FuncRec.Position.X := 0;
4545           while FuncRec.Position.X < TempWidth do begin
4546             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4547             aFunc(FuncRec);
4548             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4549             inc(FuncRec.Position.X);
4550           end;
4551           inc(FuncRec.Position.Y);
4552         end;
4553
4554         // Updating Image or InternalFormat
4555         if aCreateTemp then
4556           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4557         else if (aFormat <> fFormat) then
4558           Format := aFormat;
4559
4560         result := true;
4561       finally
4562         SourceFD.FreeMappingData(SourceMD);
4563         DestFD.FreeMappingData(DestMD);
4564       end;
4565     except
4566       if aCreateTemp and Assigned(TmpData) then
4567         FreeMem(TmpData);
4568       raise;
4569     end;
4570   end;
4571 end;
4572
4573 {$IFDEF GLB_SDL}
4574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4575 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4576 var
4577   Row, RowSize: Integer;
4578   SourceData, TmpData: PByte;
4579   TempDepth: Integer;
4580   FormatDesc: TFormatDescriptor;
4581
4582   function GetRowPointer(Row: Integer): pByte;
4583   begin
4584     result := aSurface.pixels;
4585     Inc(result, Row * RowSize);
4586   end;
4587
4588 begin
4589   result := false;
4590
4591   FormatDesc := TFormatDescriptor.Get(Format);
4592   if FormatDesc.IsCompressed then
4593     raise EglBitmapUnsupportedFormat.Create(Format);
4594
4595   if Assigned(Data) then begin
4596     case Trunc(FormatDesc.PixelSize) of
4597       1: TempDepth :=  8;
4598       2: TempDepth := 16;
4599       3: TempDepth := 24;
4600       4: TempDepth := 32;
4601     else
4602       raise EglBitmapUnsupportedFormat.Create(Format);
4603     end;
4604
4605     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4606       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4607     SourceData := Data;
4608     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4609
4610     for Row := 0 to FileHeight-1 do begin
4611       TmpData := GetRowPointer(Row);
4612       if Assigned(TmpData) then begin
4613         Move(SourceData^, TmpData^, RowSize);
4614         inc(SourceData, RowSize);
4615       end;
4616     end;
4617     result := true;
4618   end;
4619 end;
4620
4621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4622 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4623 var
4624   pSource, pData, pTempData: PByte;
4625   Row, RowSize, TempWidth, TempHeight: Integer;
4626   IntFormat: TglBitmapFormat;
4627   FormatDesc: TFormatDescriptor;
4628
4629   function GetRowPointer(Row: Integer): pByte;
4630   begin
4631     result := aSurface^.pixels;
4632     Inc(result, Row * RowSize);
4633   end;
4634
4635 begin
4636   result := false;
4637   if (Assigned(aSurface)) then begin
4638     with aSurface^.format^ do begin
4639       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4640         FormatDesc := TFormatDescriptor.Get(IntFormat);
4641         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4642           break;
4643       end;
4644       if (IntFormat = tfEmpty) then
4645         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4646     end;
4647
4648     TempWidth  := aSurface^.w;
4649     TempHeight := aSurface^.h;
4650     RowSize := FormatDesc.GetSize(TempWidth, 1);
4651     GetMem(pData, TempHeight * RowSize);
4652     try
4653       pTempData := pData;
4654       for Row := 0 to TempHeight -1 do begin
4655         pSource := GetRowPointer(Row);
4656         if (Assigned(pSource)) then begin
4657           Move(pSource^, pTempData^, RowSize);
4658           Inc(pTempData, RowSize);
4659         end;
4660       end;
4661       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4662       result := true;
4663     except
4664       if Assigned(pData) then
4665         FreeMem(pData);
4666       raise;
4667     end;
4668   end;
4669 end;
4670
4671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4672 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4673 var
4674   Row, Col, AlphaInterleave: Integer;
4675   pSource, pDest: PByte;
4676
4677   function GetRowPointer(Row: Integer): pByte;
4678   begin
4679     result := aSurface.pixels;
4680     Inc(result, Row * Width);
4681   end;
4682
4683 begin
4684   result := false;
4685   if Assigned(Data) then begin
4686     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4687       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4688
4689       AlphaInterleave := 0;
4690       case Format of
4691         tfLuminance8Alpha8:
4692           AlphaInterleave := 1;
4693         tfBGRA8, tfRGBA8:
4694           AlphaInterleave := 3;
4695       end;
4696
4697       pSource := Data;
4698       for Row := 0 to Height -1 do begin
4699         pDest := GetRowPointer(Row);
4700         if Assigned(pDest) then begin
4701           for Col := 0 to Width -1 do begin
4702             Inc(pSource, AlphaInterleave);
4703             pDest^ := pSource^;
4704             Inc(pDest);
4705             Inc(pSource);
4706           end;
4707         end;
4708       end;
4709       result := true;
4710     end;
4711   end;
4712 end;
4713
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4716 var
4717   bmp: TglBitmap2D;
4718 begin
4719   bmp := TglBitmap2D.Create;
4720   try
4721     bmp.AssignFromSurface(aSurface);
4722     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4723   finally
4724     bmp.Free;
4725   end;
4726 end;
4727 {$ENDIF}
4728
4729 {$IFDEF GLB_DELPHI}
4730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4731 function CreateGrayPalette: HPALETTE;
4732 var
4733   Idx: Integer;
4734   Pal: PLogPalette;
4735 begin
4736   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4737
4738   Pal.palVersion := $300;
4739   Pal.palNumEntries := 256;
4740
4741   for Idx := 0 to Pal.palNumEntries - 1 do begin
4742     Pal.palPalEntry[Idx].peRed   := Idx;
4743     Pal.palPalEntry[Idx].peGreen := Idx;
4744     Pal.palPalEntry[Idx].peBlue  := Idx;
4745     Pal.palPalEntry[Idx].peFlags := 0;
4746   end;
4747   Result := CreatePalette(Pal^);
4748   FreeMem(Pal);
4749 end;
4750
4751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4752 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4753 var
4754   Row: Integer;
4755   pSource, pData: PByte;
4756 begin
4757   result := false;
4758   if Assigned(Data) then begin
4759     if Assigned(aBitmap) then begin
4760       aBitmap.Width  := Width;
4761       aBitmap.Height := Height;
4762
4763       case Format of
4764         tfAlpha8, tfLuminance8: begin
4765           aBitmap.PixelFormat := pf8bit;
4766           aBitmap.Palette     := CreateGrayPalette;
4767         end;
4768         tfRGB5A1:
4769           aBitmap.PixelFormat := pf15bit;
4770         tfR5G6B5:
4771           aBitmap.PixelFormat := pf16bit;
4772         tfRGB8, tfBGR8:
4773           aBitmap.PixelFormat := pf24bit;
4774         tfRGBA8, tfBGRA8:
4775           aBitmap.PixelFormat := pf32bit;
4776       else
4777         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4778       end;
4779
4780       pSource := Data;
4781       for Row := 0 to FileHeight -1 do begin
4782         pData := aBitmap.Scanline[Row];
4783         Move(pSource^, pData^, fRowSize);
4784         Inc(pSource, fRowSize);
4785         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4786           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4787       end;
4788       result := true;
4789     end;
4790   end;
4791 end;
4792
4793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4794 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4795 var
4796   pSource, pData, pTempData: PByte;
4797   Row, RowSize, TempWidth, TempHeight: Integer;
4798   IntFormat: TglBitmapFormat;
4799 begin
4800   result := false;
4801
4802   if (Assigned(aBitmap)) then begin
4803     case aBitmap.PixelFormat of
4804       pf8bit:
4805         IntFormat := tfLuminance8;
4806       pf15bit:
4807         IntFormat := tfRGB5A1;
4808       pf16bit:
4809         IntFormat := tfR5G6B5;
4810       pf24bit:
4811         IntFormat := tfBGR8;
4812       pf32bit:
4813         IntFormat := tfBGRA8;
4814     else
4815       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4816     end;
4817
4818     TempWidth  := aBitmap.Width;
4819     TempHeight := aBitmap.Height;
4820     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4821     GetMem(pData, TempHeight * RowSize);
4822     try
4823       pTempData := pData;
4824       for Row := 0 to TempHeight -1 do begin
4825         pSource := aBitmap.Scanline[Row];
4826         if (Assigned(pSource)) then begin
4827           Move(pSource^, pTempData^, RowSize);
4828           Inc(pTempData, RowSize);
4829         end;
4830       end;
4831       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4832       result := true;
4833     except
4834       if Assigned(pData) then
4835         FreeMem(pData);
4836       raise;
4837     end;
4838   end;
4839 end;
4840
4841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4842 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4843 var
4844   Row, Col, AlphaInterleave: Integer;
4845   pSource, pDest: PByte;
4846 begin
4847   result := false;
4848
4849   if Assigned(Data) then begin
4850     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4851       if Assigned(aBitmap) then begin
4852         aBitmap.PixelFormat := pf8bit;
4853         aBitmap.Palette     := CreateGrayPalette;
4854         aBitmap.Width       := Width;
4855         aBitmap.Height      := Height;
4856
4857         case Format of
4858           tfLuminance8Alpha8:
4859             AlphaInterleave := 1;
4860           tfRGBA8, tfBGRA8:
4861             AlphaInterleave := 3;
4862           else
4863             AlphaInterleave := 0;
4864         end;
4865
4866         // Copy Data
4867         pSource := Data;
4868
4869         for Row := 0 to Height -1 do begin
4870           pDest := aBitmap.Scanline[Row];
4871           if Assigned(pDest) then begin
4872             for Col := 0 to Width -1 do begin
4873               Inc(pSource, AlphaInterleave);
4874               pDest^ := pSource^;
4875               Inc(pDest);
4876               Inc(pSource);
4877             end;
4878           end;
4879         end;
4880         result := true;
4881       end;
4882     end;
4883   end;
4884 end;
4885
4886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4887 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4888 var
4889   tex: TglBitmap2D;
4890 begin
4891   tex := TglBitmap2D.Create;
4892   try
4893     tex.AssignFromBitmap(ABitmap);
4894     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4895   finally
4896     tex.Free;
4897   end;
4898 end;
4899 {$ENDIF}
4900
4901 {$IFDEF GLB_LAZARUS}
4902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4903 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4904 var
4905   rid: TRawImageDescription;
4906   FormatDesc: TFormatDescriptor;
4907 begin
4908   result := false;
4909   if not Assigned(aImage) or (Format = tfEmpty) then
4910     exit;
4911   FormatDesc := TFormatDescriptor.Get(Format);
4912   if FormatDesc.IsCompressed then
4913     exit;
4914
4915   FillChar(rid{%H-}, SizeOf(rid), 0);
4916   if (Format in [
4917        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4918        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4919        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4920     rid.Format := ricfGray
4921   else
4922     rid.Format := ricfRGBA;
4923
4924   rid.Width        := Width;
4925   rid.Height       := Height;
4926   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4927   rid.BitOrder     := riboBitsInOrder;
4928   rid.ByteOrder    := riboLSBFirst;
4929   rid.LineOrder    := riloTopToBottom;
4930   rid.LineEnd      := rileTight;
4931   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4932   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4933   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4934   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4935   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4936   rid.RedShift     := FormatDesc.Shift.r;
4937   rid.GreenShift   := FormatDesc.Shift.g;
4938   rid.BlueShift    := FormatDesc.Shift.b;
4939   rid.AlphaShift   := FormatDesc.Shift.a;
4940
4941   rid.MaskBitsPerPixel  := 0;
4942   rid.PaletteColorCount := 0;
4943
4944   aImage.DataDescription := rid;
4945   aImage.CreateData;
4946
4947   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4948
4949   result := true;
4950 end;
4951
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4954 var
4955   f: TglBitmapFormat;
4956   FormatDesc: TFormatDescriptor;
4957   ImageData: PByte;
4958   ImageSize: Integer;
4959 begin
4960   result := false;
4961   if not Assigned(aImage) then
4962     exit;
4963   for f := High(f) downto Low(f) do begin
4964     FormatDesc := TFormatDescriptor.Get(f);
4965     with aImage.DataDescription do
4966       if FormatDesc.MaskMatch(
4967         (QWord(1 shl RedPrec  )-1) shl RedShift,
4968         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4969         (QWord(1 shl BluePrec )-1) shl BlueShift,
4970         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4971         break;
4972   end;
4973
4974   if (f = tfEmpty) then
4975     exit;
4976
4977   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4978   ImageData := GetMem(ImageSize);
4979   try
4980     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4981     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4982   except
4983     if Assigned(ImageData) then
4984       FreeMem(ImageData);
4985     raise;
4986   end;
4987
4988   result := true;
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4993 var
4994   rid: TRawImageDescription;
4995   FormatDesc: TFormatDescriptor;
4996   Pixel: TglBitmapPixelData;
4997   x, y: Integer;
4998   srcMD: Pointer;
4999   src, dst: PByte;
5000 begin
5001   result := false;
5002   if not Assigned(aImage) or (Format = tfEmpty) then
5003     exit;
5004   FormatDesc := TFormatDescriptor.Get(Format);
5005   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5006     exit;
5007
5008   FillChar(rid{%H-}, SizeOf(rid), 0);
5009   rid.Format       := ricfGray;
5010   rid.Width        := Width;
5011   rid.Height       := Height;
5012   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5013   rid.BitOrder     := riboBitsInOrder;
5014   rid.ByteOrder    := riboLSBFirst;
5015   rid.LineOrder    := riloTopToBottom;
5016   rid.LineEnd      := rileTight;
5017   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5018   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5019   rid.GreenPrec    := 0;
5020   rid.BluePrec     := 0;
5021   rid.AlphaPrec    := 0;
5022   rid.RedShift     := 0;
5023   rid.GreenShift   := 0;
5024   rid.BlueShift    := 0;
5025   rid.AlphaShift   := 0;
5026
5027   rid.MaskBitsPerPixel  := 0;
5028   rid.PaletteColorCount := 0;
5029
5030   aImage.DataDescription := rid;
5031   aImage.CreateData;
5032
5033   srcMD := FormatDesc.CreateMappingData;
5034   try
5035     FormatDesc.PreparePixel(Pixel);
5036     src := Data;
5037     dst := aImage.PixelData;
5038     for y := 0 to Height-1 do
5039       for x := 0 to Width-1 do begin
5040         FormatDesc.Unmap(src, Pixel, srcMD);
5041         case rid.BitsPerPixel of
5042            8: begin
5043             dst^ := Pixel.Data.a;
5044             inc(dst);
5045           end;
5046           16: begin
5047             PWord(dst)^ := Pixel.Data.a;
5048             inc(dst, 2);
5049           end;
5050           24: begin
5051             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5052             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5053             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5054             inc(dst, 3);
5055           end;
5056           32: begin
5057             PCardinal(dst)^ := Pixel.Data.a;
5058             inc(dst, 4);
5059           end;
5060         else
5061           raise EglBitmapUnsupportedFormat.Create(Format);
5062         end;
5063       end;
5064   finally
5065     FormatDesc.FreeMappingData(srcMD);
5066   end;
5067   result := true;
5068 end;
5069
5070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5071 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5072 var
5073   tex: TglBitmap2D;
5074 begin
5075   tex := TglBitmap2D.Create;
5076   try
5077     tex.AssignFromLazIntfImage(aImage);
5078     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5079   finally
5080     tex.Free;
5081   end;
5082 end;
5083 {$ENDIF}
5084
5085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5086 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5087   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5088 var
5089   rs: TResourceStream;
5090 begin
5091   PrepareResType(aResource, aResType);
5092   rs := TResourceStream.Create(aInstance, aResource, aResType);
5093   try
5094     result := AddAlphaFromStream(rs, aFunc, aArgs);
5095   finally
5096     rs.Free;
5097   end;
5098 end;
5099
5100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5101 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5102   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5103 var
5104   rs: TResourceStream;
5105 begin
5106   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5107   try
5108     result := AddAlphaFromStream(rs, aFunc, aArgs);
5109   finally
5110     rs.Free;
5111   end;
5112 end;
5113
5114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5115 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5116 begin
5117   if TFormatDescriptor.Get(Format).IsCompressed then
5118     raise EglBitmapUnsupportedFormat.Create(Format);
5119   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5120 end;
5121
5122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5123 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5124 var
5125   FS: TFileStream;
5126 begin
5127   FS := TFileStream.Create(aFileName, fmOpenRead);
5128   try
5129     result := AddAlphaFromStream(FS, aFunc, aArgs);
5130   finally
5131     FS.Free;
5132   end;
5133 end;
5134
5135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5136 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5137 var
5138   tex: TglBitmap2D;
5139 begin
5140   tex := TglBitmap2D.Create(aStream);
5141   try
5142     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5143   finally
5144     tex.Free;
5145   end;
5146 end;
5147
5148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5149 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5150 var
5151   DestData, DestData2, SourceData: pByte;
5152   TempHeight, TempWidth: Integer;
5153   SourceFD, DestFD: TFormatDescriptor;
5154   SourceMD, DestMD, DestMD2: Pointer;
5155
5156   FuncRec: TglBitmapFunctionRec;
5157 begin
5158   result := false;
5159
5160   Assert(Assigned(Data));
5161   Assert(Assigned(aBitmap));
5162   Assert(Assigned(aBitmap.Data));
5163
5164   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5165     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5166
5167     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5168     DestFD   := TFormatDescriptor.Get(Format);
5169
5170     if not Assigned(aFunc) then begin
5171       aFunc        := glBitmapAlphaFunc;
5172       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5173     end else
5174       FuncRec.Args := aArgs;
5175
5176     // Values
5177     TempHeight := aBitmap.FileHeight;
5178     TempWidth  := aBitmap.FileWidth;
5179
5180     FuncRec.Sender          := Self;
5181     FuncRec.Size            := Dimension;
5182     FuncRec.Position.Fields := FuncRec.Size.Fields;
5183
5184     DestData   := Data;
5185     DestData2  := Data;
5186     SourceData := aBitmap.Data;
5187
5188     // Mapping
5189     SourceFD.PreparePixel(FuncRec.Source);
5190     DestFD.PreparePixel  (FuncRec.Dest);
5191
5192     SourceMD := SourceFD.CreateMappingData;
5193     DestMD   := DestFD.CreateMappingData;
5194     DestMD2  := DestFD.CreateMappingData;
5195     try
5196       FuncRec.Position.Y := 0;
5197       while FuncRec.Position.Y < TempHeight do begin
5198         FuncRec.Position.X := 0;
5199         while FuncRec.Position.X < TempWidth do begin
5200           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5201           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5202           aFunc(FuncRec);
5203           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5204           inc(FuncRec.Position.X);
5205         end;
5206         inc(FuncRec.Position.Y);
5207       end;
5208     finally
5209       SourceFD.FreeMappingData(SourceMD);
5210       DestFD.FreeMappingData(DestMD);
5211       DestFD.FreeMappingData(DestMD2);
5212     end;
5213   end;
5214 end;
5215
5216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5217 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5218 begin
5219   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5220 end;
5221
5222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5223 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5224 var
5225   PixelData: TglBitmapPixelData;
5226 begin
5227   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5228   result := AddAlphaFromColorKeyFloat(
5229     aRed   / PixelData.Range.r,
5230     aGreen / PixelData.Range.g,
5231     aBlue  / PixelData.Range.b,
5232     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5233 end;
5234
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5237 var
5238   values: array[0..2] of Single;
5239   tmp: Cardinal;
5240   i: Integer;
5241   PixelData: TglBitmapPixelData;
5242 begin
5243   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5244   with PixelData do begin
5245     values[0] := aRed;
5246     values[1] := aGreen;
5247     values[2] := aBlue;
5248
5249     for i := 0 to 2 do begin
5250       tmp          := Trunc(Range.arr[i] * aDeviation);
5251       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5252       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5253     end;
5254     Data.a  := 0;
5255     Range.a := 0;
5256   end;
5257   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5258 end;
5259
5260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5261 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5262 begin
5263   result := AddAlphaFromValueFloat(aAlpha / $FF);
5264 end;
5265
5266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5267 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5268 var
5269   PixelData: TglBitmapPixelData;
5270 begin
5271   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5272   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5273 end;
5274
5275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5276 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5277 var
5278   PixelData: TglBitmapPixelData;
5279 begin
5280   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5281   with PixelData do
5282     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5283   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5284 end;
5285
5286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5287 function TglBitmap.RemoveAlpha: Boolean;
5288 var
5289   FormatDesc: TFormatDescriptor;
5290 begin
5291   result := false;
5292   FormatDesc := TFormatDescriptor.Get(Format);
5293   if Assigned(Data) then begin
5294     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5295       raise EglBitmapUnsupportedFormat.Create(Format);
5296     result := ConvertTo(FormatDesc.WithoutAlpha);
5297   end;
5298 end;
5299
5300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5301 function TglBitmap.Clone: TglBitmap;
5302 var
5303   Temp: TglBitmap;
5304   TempPtr: PByte;
5305   Size: Integer;
5306 begin
5307   result := nil;
5308   Temp := (ClassType.Create as TglBitmap);
5309   try
5310     // copy texture data if assigned
5311     if Assigned(Data) then begin
5312       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5313       GetMem(TempPtr, Size);
5314       try
5315         Move(Data^, TempPtr^, Size);
5316         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5317       except
5318         if Assigned(TempPtr) then
5319           FreeMem(TempPtr);
5320         raise;
5321       end;
5322     end else begin
5323       TempPtr := nil;
5324       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5325     end;
5326
5327         // copy properties
5328     Temp.fID                      := ID;
5329     Temp.fTarget                  := Target;
5330     Temp.fFormat                  := Format;
5331     Temp.fMipMap                  := MipMap;
5332     Temp.fAnisotropic             := Anisotropic;
5333     Temp.fBorderColor             := fBorderColor;
5334     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5335     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5336     Temp.fFilterMin               := fFilterMin;
5337     Temp.fFilterMag               := fFilterMag;
5338     Temp.fWrapS                   := fWrapS;
5339     Temp.fWrapT                   := fWrapT;
5340     Temp.fWrapR                   := fWrapR;
5341     Temp.fFilename                := fFilename;
5342     Temp.fCustomName              := fCustomName;
5343     Temp.fCustomNameW             := fCustomNameW;
5344     Temp.fCustomData              := fCustomData;
5345
5346     result := Temp;
5347   except
5348     FreeAndNil(Temp);
5349     raise;
5350   end;
5351 end;
5352
5353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5354 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5355 var
5356   SourceFD, DestFD: TFormatDescriptor;
5357   SourcePD, DestPD: TglBitmapPixelData;
5358   ShiftData: TShiftData;
5359
5360   function CanCopyDirect: Boolean;
5361   begin
5362     result :=
5363       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5364       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5365       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5366       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5367   end;
5368
5369   function CanShift: Boolean;
5370   begin
5371     result :=
5372       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5373       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5374       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5375       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5376   end;
5377
5378   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5379   begin
5380     result := 0;
5381     while (aSource > aDest) and (aSource > 0) do begin
5382       inc(result);
5383       aSource := aSource shr 1;
5384     end;
5385   end;
5386
5387 begin
5388   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5389     SourceFD := TFormatDescriptor.Get(Format);
5390     DestFD   := TFormatDescriptor.Get(aFormat);
5391
5392     SourceFD.PreparePixel(SourcePD);
5393     DestFD.PreparePixel  (DestPD);
5394
5395     if CanCopyDirect then
5396       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5397     else if CanShift then begin
5398       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5399       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5400       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5401       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5402       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5403     end else
5404       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5405   end else
5406     result := true;
5407 end;
5408
5409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5410 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5411 begin
5412   if aUseRGB or aUseAlpha then
5413     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5414       ((Byte(aUseAlpha) and 1) shl 1) or
5415        (Byte(aUseRGB)   and 1)      ));
5416 end;
5417
5418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5419 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5420 begin
5421   fBorderColor[0] := aRed;
5422   fBorderColor[1] := aGreen;
5423   fBorderColor[2] := aBlue;
5424   fBorderColor[3] := aAlpha;
5425   if (ID > 0) then begin
5426     Bind(false);
5427     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5428   end;
5429 end;
5430
5431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5432 procedure TglBitmap.FreeData;
5433 var
5434   TempPtr: PByte;
5435 begin
5436   TempPtr := nil;
5437   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5438 end;
5439
5440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5441 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5442   const aAlpha: Byte);
5443 begin
5444   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5445 end;
5446
5447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5448 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5449 var
5450   PixelData: TglBitmapPixelData;
5451 begin
5452   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5453   FillWithColorFloat(
5454     aRed   / PixelData.Range.r,
5455     aGreen / PixelData.Range.g,
5456     aBlue  / PixelData.Range.b,
5457     aAlpha / PixelData.Range.a);
5458 end;
5459
5460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5461 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5462 var
5463   PixelData: TglBitmapPixelData;
5464 begin
5465   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5466   with PixelData do begin
5467     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5468     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5469     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5470     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5471   end;
5472   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5473 end;
5474
5475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5476 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5477 begin
5478   //check MIN filter
5479   case aMin of
5480     GL_NEAREST:
5481       fFilterMin := GL_NEAREST;
5482     GL_LINEAR:
5483       fFilterMin := GL_LINEAR;
5484     GL_NEAREST_MIPMAP_NEAREST:
5485       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5486     GL_LINEAR_MIPMAP_NEAREST:
5487       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5488     GL_NEAREST_MIPMAP_LINEAR:
5489       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5490     GL_LINEAR_MIPMAP_LINEAR:
5491       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5492     else
5493       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5494   end;
5495
5496   //check MAG filter
5497   case aMag of
5498     GL_NEAREST:
5499       fFilterMag := GL_NEAREST;
5500     GL_LINEAR:
5501       fFilterMag := GL_LINEAR;
5502     else
5503       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5504   end;
5505
5506   //apply filter
5507   if (ID > 0) then begin
5508     Bind(false);
5509     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5510
5511     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5512       case fFilterMin of
5513         GL_NEAREST, GL_LINEAR:
5514           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5515         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5516           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5517         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5518           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5519       end;
5520     end else
5521       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5522   end;
5523 end;
5524
5525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5526 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5527
5528   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5529   begin
5530     case aValue of
5531       GL_CLAMP:
5532         aTarget := GL_CLAMP;
5533
5534       GL_REPEAT:
5535         aTarget := GL_REPEAT;
5536
5537       GL_CLAMP_TO_EDGE: begin
5538         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5539           aTarget := GL_CLAMP_TO_EDGE
5540         else
5541           aTarget := GL_CLAMP;
5542       end;
5543
5544       GL_CLAMP_TO_BORDER: begin
5545         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5546           aTarget := GL_CLAMP_TO_BORDER
5547         else
5548           aTarget := GL_CLAMP;
5549       end;
5550
5551       GL_MIRRORED_REPEAT: begin
5552         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5553           aTarget := GL_MIRRORED_REPEAT
5554         else
5555           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5556       end;
5557     else
5558       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5559     end;
5560   end;
5561
5562 begin
5563   CheckAndSetWrap(S, fWrapS);
5564   CheckAndSetWrap(T, fWrapT);
5565   CheckAndSetWrap(R, fWrapR);
5566
5567   if (ID > 0) then begin
5568     Bind(false);
5569     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5570     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5571     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5572   end;
5573 end;
5574
5575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5576 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5577
5578   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5579   begin
5580     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5581        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5582       fSwizzle[aIndex] := aValue
5583     else
5584       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5585   end;
5586
5587 begin
5588   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5589     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5590   CheckAndSetValue(r, 0);
5591   CheckAndSetValue(g, 1);
5592   CheckAndSetValue(b, 2);
5593   CheckAndSetValue(a, 3);
5594
5595   if (ID > 0) then begin
5596     Bind(false);
5597     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5598   end;
5599 end;
5600
5601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5602 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5603 begin
5604   if aEnableTextureUnit then
5605     glEnable(Target);
5606   if (ID > 0) then
5607     glBindTexture(Target, ID);
5608 end;
5609
5610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5611 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5612 begin
5613   if aDisableTextureUnit then
5614     glDisable(Target);
5615   glBindTexture(Target, 0);
5616 end;
5617
5618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5619 constructor TglBitmap.Create;
5620 begin
5621   if (ClassType = TglBitmap) then
5622     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5623 {$IFDEF GLB_NATIVE_OGL}
5624   glbReadOpenGLExtensions;
5625 {$ENDIF}
5626   inherited Create;
5627 end;
5628
5629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5630 constructor TglBitmap.Create(const aFileName: String);
5631 begin
5632   Create;
5633   LoadFromFile(aFileName);
5634 end;
5635
5636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5637 constructor TglBitmap.Create(const aStream: TStream);
5638 begin
5639   Create;
5640   LoadFromStream(aStream);
5641 end;
5642
5643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5644 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5645 var
5646   Image: PByte;
5647   ImageSize: Integer;
5648 begin
5649   Create;
5650   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5651   GetMem(Image, ImageSize);
5652   try
5653     FillChar(Image^, ImageSize, #$FF);
5654     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5655   except
5656     if Assigned(Image) then
5657       FreeMem(Image);
5658     raise;
5659   end;
5660 end;
5661
5662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5663 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5664   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5665 begin
5666   Create;
5667   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5668 end;
5669
5670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5671 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5672 begin
5673   Create;
5674   LoadFromResource(aInstance, aResource, aResType);
5675 end;
5676
5677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5678 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5679 begin
5680   Create;
5681   LoadFromResourceID(aInstance, aResourceID, aResType);
5682 end;
5683
5684 {$IFDEF GLB_SUPPORT_PNG_READ}
5685 {$IF DEFINED(GLB_LAZ_PNG)}
5686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5687 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5689 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5690 const
5691   MAGIC_LEN = 8;
5692   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5693 var
5694   png: TPortableNetworkGraphic;
5695   intf: TLazIntfImage;
5696   StreamPos: Int64;
5697   magic: String[MAGIC_LEN];
5698 begin
5699   result := true;
5700   StreamPos := aStream.Position;
5701
5702   SetLength(magic, MAGIC_LEN);
5703   aStream.Read(magic[1], MAGIC_LEN);
5704   aStream.Position := StreamPos;
5705   if (magic <> PNG_MAGIC) then begin
5706     result := false;
5707     exit;
5708   end;
5709
5710   png := TPortableNetworkGraphic.Create;
5711   try try
5712     png.LoadFromStream(aStream);
5713     intf := png.CreateIntfImage;
5714     try try
5715       AssignFromLazIntfImage(intf);
5716     except
5717       result := false;
5718       aStream.Position := StreamPos;
5719       exit;
5720     end;
5721     finally
5722       intf.Free;
5723     end;
5724   except
5725     result := false;
5726     aStream.Position := StreamPos;
5727     exit;
5728   end;
5729   finally
5730     png.Free;
5731   end;
5732 end;
5733
5734 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5736 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5737 var
5738   Surface: PSDL_Surface;
5739   RWops: PSDL_RWops;
5740 begin
5741   result := false;
5742   RWops := glBitmapCreateRWops(aStream);
5743   try
5744     if IMG_isPNG(RWops) > 0 then begin
5745       Surface := IMG_LoadPNG_RW(RWops);
5746       try
5747         AssignFromSurface(Surface);
5748         result := true;
5749       finally
5750         SDL_FreeSurface(Surface);
5751       end;
5752     end;
5753   finally
5754     SDL_FreeRW(RWops);
5755   end;
5756 end;
5757
5758 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5760 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5761 begin
5762   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5763 end;
5764
5765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5766 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5767 var
5768   StreamPos: Int64;
5769   signature: array [0..7] of byte;
5770   png: png_structp;
5771   png_info: png_infop;
5772
5773   TempHeight, TempWidth: Integer;
5774   Format: TglBitmapFormat;
5775
5776   png_data: pByte;
5777   png_rows: array of pByte;
5778   Row, LineSize: Integer;
5779 begin
5780   result := false;
5781
5782   if not init_libPNG then
5783     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5784
5785   try
5786     // signature
5787     StreamPos := aStream.Position;
5788     aStream.Read(signature{%H-}, 8);
5789     aStream.Position := StreamPos;
5790
5791     if png_check_sig(@signature, 8) <> 0 then begin
5792       // png read struct
5793       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5794       if png = nil then
5795         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5796
5797       // png info
5798       png_info := png_create_info_struct(png);
5799       if png_info = nil then begin
5800         png_destroy_read_struct(@png, nil, nil);
5801         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5802       end;
5803
5804       // set read callback
5805       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5806
5807       // read informations
5808       png_read_info(png, png_info);
5809
5810       // size
5811       TempHeight := png_get_image_height(png, png_info);
5812       TempWidth := png_get_image_width(png, png_info);
5813
5814       // format
5815       case png_get_color_type(png, png_info) of
5816         PNG_COLOR_TYPE_GRAY:
5817           Format := tfLuminance8;
5818         PNG_COLOR_TYPE_GRAY_ALPHA:
5819           Format := tfLuminance8Alpha8;
5820         PNG_COLOR_TYPE_RGB:
5821           Format := tfRGB8;
5822         PNG_COLOR_TYPE_RGB_ALPHA:
5823           Format := tfRGBA8;
5824         else
5825           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5826       end;
5827
5828       // cut upper 8 bit from 16 bit formats
5829       if png_get_bit_depth(png, png_info) > 8 then
5830         png_set_strip_16(png);
5831
5832       // expand bitdepth smaller than 8
5833       if png_get_bit_depth(png, png_info) < 8 then
5834         png_set_expand(png);
5835
5836       // allocating mem for scanlines
5837       LineSize := png_get_rowbytes(png, png_info);
5838       GetMem(png_data, TempHeight * LineSize);
5839       try
5840         SetLength(png_rows, TempHeight);
5841         for Row := Low(png_rows) to High(png_rows) do begin
5842           png_rows[Row] := png_data;
5843           Inc(png_rows[Row], Row * LineSize);
5844         end;
5845
5846         // read complete image into scanlines
5847         png_read_image(png, @png_rows[0]);
5848
5849         // read end
5850         png_read_end(png, png_info);
5851
5852         // destroy read struct
5853         png_destroy_read_struct(@png, @png_info, nil);
5854
5855         SetLength(png_rows, 0);
5856
5857         // set new data
5858         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5859
5860         result := true;
5861       except
5862         if Assigned(png_data) then
5863           FreeMem(png_data);
5864         raise;
5865       end;
5866     end;
5867   finally
5868     quit_libPNG;
5869   end;
5870 end;
5871
5872 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5874 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5875 var
5876   StreamPos: Int64;
5877   Png: TPNGObject;
5878   Header: String[8];
5879   Row, Col, PixSize, LineSize: Integer;
5880   NewImage, pSource, pDest, pAlpha: pByte;
5881   PngFormat: TglBitmapFormat;
5882   FormatDesc: TFormatDescriptor;
5883
5884 const
5885   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5886
5887 begin
5888   result := false;
5889
5890   StreamPos := aStream.Position;
5891   aStream.Read(Header[0], SizeOf(Header));
5892   aStream.Position := StreamPos;
5893
5894   {Test if the header matches}
5895   if Header = PngHeader then begin
5896     Png := TPNGObject.Create;
5897     try
5898       Png.LoadFromStream(aStream);
5899
5900       case Png.Header.ColorType of
5901         COLOR_GRAYSCALE:
5902           PngFormat := tfLuminance8;
5903         COLOR_GRAYSCALEALPHA:
5904           PngFormat := tfLuminance8Alpha8;
5905         COLOR_RGB:
5906           PngFormat := tfBGR8;
5907         COLOR_RGBALPHA:
5908           PngFormat := tfBGRA8;
5909         else
5910           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5911       end;
5912
5913       FormatDesc := TFormatDescriptor.Get(PngFormat);
5914       PixSize    := Round(FormatDesc.PixelSize);
5915       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5916
5917       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5918       try
5919         pDest := NewImage;
5920
5921         case Png.Header.ColorType of
5922           COLOR_RGB, COLOR_GRAYSCALE:
5923             begin
5924               for Row := 0 to Png.Height -1 do begin
5925                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5926                 Inc(pDest, LineSize);
5927               end;
5928             end;
5929           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5930             begin
5931               PixSize := PixSize -1;
5932
5933               for Row := 0 to Png.Height -1 do begin
5934                 pSource := Png.Scanline[Row];
5935                 pAlpha := pByte(Png.AlphaScanline[Row]);
5936
5937                 for Col := 0 to Png.Width -1 do begin
5938                   Move (pSource^, pDest^, PixSize);
5939                   Inc(pSource, PixSize);
5940                   Inc(pDest, PixSize);
5941
5942                   pDest^ := pAlpha^;
5943                   inc(pAlpha);
5944                   Inc(pDest);
5945                 end;
5946               end;
5947             end;
5948           else
5949             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5950         end;
5951
5952         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5953
5954         result := true;
5955       except
5956         if Assigned(NewImage) then
5957           FreeMem(NewImage);
5958         raise;
5959       end;
5960     finally
5961       Png.Free;
5962     end;
5963   end;
5964 end;
5965 {$IFEND}
5966 {$ENDIF}
5967
5968 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5969 {$IFDEF GLB_LIB_PNG}
5970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5971 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5972 begin
5973   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5974 end;
5975 {$ENDIF}
5976
5977 {$IF DEFINED(GLB_LAZ_PNG)}
5978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5979 procedure TglBitmap.SavePNG(const aStream: TStream);
5980 var
5981   png: TPortableNetworkGraphic;
5982   intf: TLazIntfImage;
5983   raw: TRawImage;
5984 begin
5985   png  := TPortableNetworkGraphic.Create;
5986   intf := TLazIntfImage.Create(0, 0);
5987   try
5988     if not AssignToLazIntfImage(intf) then
5989       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5990     intf.GetRawImage(raw);
5991     png.LoadFromRawImage(raw, false);
5992     png.SaveToStream(aStream);
5993   finally
5994     png.Free;
5995     intf.Free;
5996   end;
5997 end;
5998
5999 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6001 procedure TglBitmap.SavePNG(const aStream: TStream);
6002 var
6003   png: png_structp;
6004   png_info: png_infop;
6005   png_rows: array of pByte;
6006   LineSize: Integer;
6007   ColorType: Integer;
6008   Row: Integer;
6009   FormatDesc: TFormatDescriptor;
6010 begin
6011   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6012     raise EglBitmapUnsupportedFormat.Create(Format);
6013
6014   if not init_libPNG then
6015     raise Exception.Create('unable to initialize libPNG.');
6016
6017   try
6018     case Format of
6019       tfAlpha8, tfLuminance8:
6020         ColorType := PNG_COLOR_TYPE_GRAY;
6021       tfLuminance8Alpha8:
6022         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6023       tfBGR8, tfRGB8:
6024         ColorType := PNG_COLOR_TYPE_RGB;
6025       tfBGRA8, tfRGBA8:
6026         ColorType := PNG_COLOR_TYPE_RGBA;
6027       else
6028         raise EglBitmapUnsupportedFormat.Create(Format);
6029     end;
6030
6031     FormatDesc := TFormatDescriptor.Get(Format);
6032     LineSize := FormatDesc.GetSize(Width, 1);
6033
6034     // creating array for scanline
6035     SetLength(png_rows, Height);
6036     try
6037       for Row := 0 to Height - 1 do begin
6038         png_rows[Row] := Data;
6039         Inc(png_rows[Row], Row * LineSize)
6040       end;
6041
6042       // write struct
6043       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6044       if png = nil then
6045         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6046
6047       // create png info
6048       png_info := png_create_info_struct(png);
6049       if png_info = nil then begin
6050         png_destroy_write_struct(@png, nil);
6051         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6052       end;
6053
6054       // set read callback
6055       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6056
6057       // set compression
6058       png_set_compression_level(png, 6);
6059
6060       if Format in [tfBGR8, tfBGRA8] then
6061         png_set_bgr(png);
6062
6063       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6064       png_write_info(png, png_info);
6065       png_write_image(png, @png_rows[0]);
6066       png_write_end(png, png_info);
6067       png_destroy_write_struct(@png, @png_info);
6068     finally
6069       SetLength(png_rows, 0);
6070     end;
6071   finally
6072     quit_libPNG;
6073   end;
6074 end;
6075
6076 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6078 procedure TglBitmap.SavePNG(const aStream: TStream);
6079 var
6080   Png: TPNGObject;
6081
6082   pSource, pDest: pByte;
6083   X, Y, PixSize: Integer;
6084   ColorType: Cardinal;
6085   Alpha: Boolean;
6086
6087   pTemp: pByte;
6088   Temp: Byte;
6089 begin
6090   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6091     raise EglBitmapUnsupportedFormat.Create(Format);
6092
6093   case Format of
6094     tfAlpha8, tfLuminance8: begin
6095       ColorType := COLOR_GRAYSCALE;
6096       PixSize   := 1;
6097       Alpha     := false;
6098     end;
6099     tfLuminance8Alpha8: begin
6100       ColorType := COLOR_GRAYSCALEALPHA;
6101       PixSize   := 1;
6102       Alpha     := true;
6103     end;
6104     tfBGR8, tfRGB8: begin
6105       ColorType := COLOR_RGB;
6106       PixSize   := 3;
6107       Alpha     := false;
6108     end;
6109     tfBGRA8, tfRGBA8: begin
6110       ColorType := COLOR_RGBALPHA;
6111       PixSize   := 3;
6112       Alpha     := true
6113     end;
6114   else
6115     raise EglBitmapUnsupportedFormat.Create(Format);
6116   end;
6117
6118   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6119   try
6120     // Copy ImageData
6121     pSource := Data;
6122     for Y := 0 to Height -1 do begin
6123       pDest := png.ScanLine[Y];
6124       for X := 0 to Width -1 do begin
6125         Move(pSource^, pDest^, PixSize);
6126         Inc(pDest, PixSize);
6127         Inc(pSource, PixSize);
6128         if Alpha then begin
6129           png.AlphaScanline[Y]^[X] := pSource^;
6130           Inc(pSource);
6131         end;
6132       end;
6133
6134       // convert RGB line to BGR
6135       if Format in [tfRGB8, tfRGBA8] then begin
6136         pTemp := png.ScanLine[Y];
6137         for X := 0 to Width -1 do begin
6138           Temp := pByteArray(pTemp)^[0];
6139           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6140           pByteArray(pTemp)^[2] := Temp;
6141           Inc(pTemp, 3);
6142         end;
6143       end;
6144     end;
6145
6146     // Save to Stream
6147     Png.CompressionLevel := 6;
6148     Png.SaveToStream(aStream);
6149   finally
6150     FreeAndNil(Png);
6151   end;
6152 end;
6153 {$IFEND}
6154 {$ENDIF}
6155
6156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6157 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6159 {$IFDEF GLB_LIB_JPEG}
6160 type
6161   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6162   glBitmap_libJPEG_source_mgr = record
6163     pub: jpeg_source_mgr;
6164
6165     SrcStream: TStream;
6166     SrcBuffer: array [1..4096] of byte;
6167   end;
6168
6169   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6170   glBitmap_libJPEG_dest_mgr = record
6171     pub: jpeg_destination_mgr;
6172
6173     DestStream: TStream;
6174     DestBuffer: array [1..4096] of byte;
6175   end;
6176
6177 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6178 begin
6179   //DUMMY
6180 end;
6181
6182
6183 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6184 begin
6185   //DUMMY
6186 end;
6187
6188
6189 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6190 begin
6191   //DUMMY
6192 end;
6193
6194 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6195 begin
6196   //DUMMY
6197 end;
6198
6199
6200 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6201 begin
6202   //DUMMY
6203 end;
6204
6205
6206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6207 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6208 var
6209   src: glBitmap_libJPEG_source_mgr_ptr;
6210   bytes: integer;
6211 begin
6212   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6213
6214   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6215         if (bytes <= 0) then begin
6216                 src^.SrcBuffer[1] := $FF;
6217                 src^.SrcBuffer[2] := JPEG_EOI;
6218                 bytes := 2;
6219         end;
6220
6221         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6222         src^.pub.bytes_in_buffer := bytes;
6223
6224   result := true;
6225 end;
6226
6227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6228 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6229 var
6230   src: glBitmap_libJPEG_source_mgr_ptr;
6231 begin
6232   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6233
6234   if num_bytes > 0 then begin
6235     // wanted byte isn't in buffer so set stream position and read buffer
6236     if num_bytes > src^.pub.bytes_in_buffer then begin
6237       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6238       src^.pub.fill_input_buffer(cinfo);
6239     end else begin
6240       // wanted byte is in buffer so only skip
6241                 inc(src^.pub.next_input_byte, num_bytes);
6242                 dec(src^.pub.bytes_in_buffer, num_bytes);
6243     end;
6244   end;
6245 end;
6246
6247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6248 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6249 var
6250   dest: glBitmap_libJPEG_dest_mgr_ptr;
6251 begin
6252   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6253
6254   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6255     // write complete buffer
6256     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6257
6258     // reset buffer
6259     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6260     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6261   end;
6262
6263   result := true;
6264 end;
6265
6266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6267 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6268 var
6269   Idx: Integer;
6270   dest: glBitmap_libJPEG_dest_mgr_ptr;
6271 begin
6272   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6273
6274   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6275     // check for endblock
6276     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6277       // write endblock
6278       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6279
6280       // leave
6281       break;
6282     end else
6283       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6284   end;
6285 end;
6286 {$ENDIF}
6287
6288 {$IFDEF GLB_SUPPORT_JPEG_READ}
6289 {$IF DEFINED(GLB_LAZ_JPEG)}
6290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6291 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6292 const
6293   MAGIC_LEN = 2;
6294   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6295 var
6296   jpeg: TJPEGImage;
6297   intf: TLazIntfImage;
6298   StreamPos: Int64;
6299   magic: String[MAGIC_LEN];
6300 begin
6301   result := true;
6302   StreamPos := aStream.Position;
6303
6304   SetLength(magic, MAGIC_LEN);
6305   aStream.Read(magic[1], MAGIC_LEN);
6306   aStream.Position := StreamPos;
6307   if (magic <> JPEG_MAGIC) then begin
6308     result := false;
6309     exit;
6310   end;
6311
6312   jpeg := TJPEGImage.Create;
6313   try try
6314     jpeg.LoadFromStream(aStream);
6315     intf := TLazIntfImage.Create(0, 0);
6316     try try
6317       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6318       AssignFromLazIntfImage(intf);
6319     except
6320       result := false;
6321       aStream.Position := StreamPos;
6322       exit;
6323     end;
6324     finally
6325       intf.Free;
6326     end;
6327   except
6328     result := false;
6329     aStream.Position := StreamPos;
6330     exit;
6331   end;
6332   finally
6333     jpeg.Free;
6334   end;
6335 end;
6336
6337 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6339 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6340 var
6341   Surface: PSDL_Surface;
6342   RWops: PSDL_RWops;
6343 begin
6344   result := false;
6345
6346   RWops := glBitmapCreateRWops(aStream);
6347   try
6348     if IMG_isJPG(RWops) > 0 then begin
6349       Surface := IMG_LoadJPG_RW(RWops);
6350       try
6351         AssignFromSurface(Surface);
6352         result := true;
6353       finally
6354         SDL_FreeSurface(Surface);
6355       end;
6356     end;
6357   finally
6358     SDL_FreeRW(RWops);
6359   end;
6360 end;
6361
6362 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6365 var
6366   StreamPos: Int64;
6367   Temp: array[0..1]of Byte;
6368
6369   jpeg: jpeg_decompress_struct;
6370   jpeg_err: jpeg_error_mgr;
6371
6372   IntFormat: TglBitmapFormat;
6373   pImage: pByte;
6374   TempHeight, TempWidth: Integer;
6375
6376   pTemp: pByte;
6377   Row: Integer;
6378
6379   FormatDesc: TFormatDescriptor;
6380 begin
6381   result := false;
6382
6383   if not init_libJPEG then
6384     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6385
6386   try
6387     // reading first two bytes to test file and set cursor back to begin
6388     StreamPos := aStream.Position;
6389     aStream.Read({%H-}Temp[0], 2);
6390     aStream.Position := StreamPos;
6391
6392     // if Bitmap then read file.
6393     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6394       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6395       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6396
6397       // error managment
6398       jpeg.err := jpeg_std_error(@jpeg_err);
6399       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6400       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6401
6402       // decompression struct
6403       jpeg_create_decompress(@jpeg);
6404
6405       // allocation space for streaming methods
6406       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6407
6408       // seeting up custom functions
6409       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6410         pub.init_source       := glBitmap_libJPEG_init_source;
6411         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6412         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6413         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6414         pub.term_source       := glBitmap_libJPEG_term_source;
6415
6416         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6417         pub.next_input_byte := nil;   // until buffer loaded
6418
6419         SrcStream := aStream;
6420       end;
6421
6422       // set global decoding state
6423       jpeg.global_state := DSTATE_START;
6424
6425       // read header of jpeg
6426       jpeg_read_header(@jpeg, false);
6427
6428       // setting output parameter
6429       case jpeg.jpeg_color_space of
6430         JCS_GRAYSCALE:
6431           begin
6432             jpeg.out_color_space := JCS_GRAYSCALE;
6433             IntFormat := tfLuminance8;
6434           end;
6435         else
6436           jpeg.out_color_space := JCS_RGB;
6437           IntFormat := tfRGB8;
6438       end;
6439
6440       // reading image
6441       jpeg_start_decompress(@jpeg);
6442
6443       TempHeight := jpeg.output_height;
6444       TempWidth := jpeg.output_width;
6445
6446       FormatDesc := TFormatDescriptor.Get(IntFormat);
6447
6448       // creating new image
6449       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6450       try
6451         pTemp := pImage;
6452
6453         for Row := 0 to TempHeight -1 do begin
6454           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6455           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6456         end;
6457
6458         // finish decompression
6459         jpeg_finish_decompress(@jpeg);
6460
6461         // destroy decompression
6462         jpeg_destroy_decompress(@jpeg);
6463
6464         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6465
6466         result := true;
6467       except
6468         if Assigned(pImage) then
6469           FreeMem(pImage);
6470         raise;
6471       end;
6472     end;
6473   finally
6474     quit_libJPEG;
6475   end;
6476 end;
6477
6478 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6480 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6481 var
6482   bmp: TBitmap;
6483   jpg: TJPEGImage;
6484   StreamPos: Int64;
6485   Temp: array[0..1]of Byte;
6486 begin
6487   result := false;
6488
6489   // reading first two bytes to test file and set cursor back to begin
6490   StreamPos := aStream.Position;
6491   aStream.Read(Temp[0], 2);
6492   aStream.Position := StreamPos;
6493
6494   // if Bitmap then read file.
6495   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6496     bmp := TBitmap.Create;
6497     try
6498       jpg := TJPEGImage.Create;
6499       try
6500         jpg.LoadFromStream(aStream);
6501         bmp.Assign(jpg);
6502         result := AssignFromBitmap(bmp);
6503       finally
6504         jpg.Free;
6505       end;
6506     finally
6507       bmp.Free;
6508     end;
6509   end;
6510 end;
6511 {$IFEND}
6512 {$ENDIF}
6513
6514 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6515 {$IF DEFINED(GLB_LAZ_JPEG)}
6516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6517 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6518 var
6519   jpeg: TJPEGImage;
6520   intf: TLazIntfImage;
6521   raw: TRawImage;
6522 begin
6523   jpeg := TJPEGImage.Create;
6524   intf := TLazIntfImage.Create(0, 0);
6525   try
6526     if not AssignToLazIntfImage(intf) then
6527       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6528     intf.GetRawImage(raw);
6529     jpeg.LoadFromRawImage(raw, false);
6530     jpeg.SaveToStream(aStream);
6531   finally
6532     intf.Free;
6533     jpeg.Free;
6534   end;
6535 end;
6536
6537 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6539 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6540 var
6541   jpeg: jpeg_compress_struct;
6542   jpeg_err: jpeg_error_mgr;
6543   Row: Integer;
6544   pTemp, pTemp2: pByte;
6545
6546   procedure CopyRow(pDest, pSource: pByte);
6547   var
6548     X: Integer;
6549   begin
6550     for X := 0 to Width - 1 do begin
6551       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6552       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6553       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6554       Inc(pDest, 3);
6555       Inc(pSource, 3);
6556     end;
6557   end;
6558
6559 begin
6560   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6561     raise EglBitmapUnsupportedFormat.Create(Format);
6562
6563   if not init_libJPEG then
6564     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6565
6566   try
6567     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6568     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6569
6570     // error managment
6571     jpeg.err := jpeg_std_error(@jpeg_err);
6572     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6573     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6574
6575     // compression struct
6576     jpeg_create_compress(@jpeg);
6577
6578     // allocation space for streaming methods
6579     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6580
6581     // seeting up custom functions
6582     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6583       pub.init_destination    := glBitmap_libJPEG_init_destination;
6584       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6585       pub.term_destination    := glBitmap_libJPEG_term_destination;
6586
6587       pub.next_output_byte  := @DestBuffer[1];
6588       pub.free_in_buffer    := Length(DestBuffer);
6589
6590       DestStream := aStream;
6591     end;
6592
6593     // very important state
6594     jpeg.global_state := CSTATE_START;
6595     jpeg.image_width  := Width;
6596     jpeg.image_height := Height;
6597     case Format of
6598       tfAlpha8, tfLuminance8: begin
6599         jpeg.input_components := 1;
6600         jpeg.in_color_space   := JCS_GRAYSCALE;
6601       end;
6602       tfRGB8, tfBGR8: begin
6603         jpeg.input_components := 3;
6604         jpeg.in_color_space   := JCS_RGB;
6605       end;
6606     end;
6607
6608     jpeg_set_defaults(@jpeg);
6609     jpeg_set_quality(@jpeg, 95, true);
6610     jpeg_start_compress(@jpeg, true);
6611     pTemp := Data;
6612
6613     if Format = tfBGR8 then
6614       GetMem(pTemp2, fRowSize)
6615     else
6616       pTemp2 := pTemp;
6617
6618     try
6619       for Row := 0 to jpeg.image_height -1 do begin
6620         // prepare row
6621         if Format = tfBGR8 then
6622           CopyRow(pTemp2, pTemp)
6623         else
6624           pTemp2 := pTemp;
6625
6626         // write row
6627         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6628         inc(pTemp, fRowSize);
6629       end;
6630     finally
6631       // free memory
6632       if Format = tfBGR8 then
6633         FreeMem(pTemp2);
6634     end;
6635     jpeg_finish_compress(@jpeg);
6636     jpeg_destroy_compress(@jpeg);
6637   finally
6638     quit_libJPEG;
6639   end;
6640 end;
6641
6642 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6644 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6645 var
6646   Bmp: TBitmap;
6647   Jpg: TJPEGImage;
6648 begin
6649   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6650     raise EglBitmapUnsupportedFormat.Create(Format);
6651
6652   Bmp := TBitmap.Create;
6653   try
6654     Jpg := TJPEGImage.Create;
6655     try
6656       AssignToBitmap(Bmp);
6657       if (Format in [tfAlpha8, tfLuminance8]) then begin
6658         Jpg.Grayscale   := true;
6659         Jpg.PixelFormat := jf8Bit;
6660       end;
6661       Jpg.Assign(Bmp);
6662       Jpg.SaveToStream(aStream);
6663     finally
6664       FreeAndNil(Jpg);
6665     end;
6666   finally
6667     FreeAndNil(Bmp);
6668   end;
6669 end;
6670 {$IFEND}
6671 {$ENDIF}
6672
6673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6674 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6676 const
6677   BMP_MAGIC          = $4D42;
6678
6679   BMP_COMP_RGB       = 0;
6680   BMP_COMP_RLE8      = 1;
6681   BMP_COMP_RLE4      = 2;
6682   BMP_COMP_BITFIELDS = 3;
6683
6684 type
6685   TBMPHeader = packed record
6686     bfType: Word;
6687     bfSize: Cardinal;
6688     bfReserved1: Word;
6689     bfReserved2: Word;
6690     bfOffBits: Cardinal;
6691   end;
6692
6693   TBMPInfo = packed record
6694     biSize: Cardinal;
6695     biWidth: Longint;
6696     biHeight: Longint;
6697     biPlanes: Word;
6698     biBitCount: Word;
6699     biCompression: Cardinal;
6700     biSizeImage: Cardinal;
6701     biXPelsPerMeter: Longint;
6702     biYPelsPerMeter: Longint;
6703     biClrUsed: Cardinal;
6704     biClrImportant: Cardinal;
6705   end;
6706
6707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6708 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6709
6710   //////////////////////////////////////////////////////////////////////////////////////////////////
6711   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6712   begin
6713     result := tfEmpty;
6714     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6715     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6716
6717     //Read Compression
6718     case aInfo.biCompression of
6719       BMP_COMP_RLE4,
6720       BMP_COMP_RLE8: begin
6721         raise EglBitmap.Create('RLE compression is not supported');
6722       end;
6723       BMP_COMP_BITFIELDS: begin
6724         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6725           aStream.Read(aMask.r, SizeOf(aMask.r));
6726           aStream.Read(aMask.g, SizeOf(aMask.g));
6727           aStream.Read(aMask.b, SizeOf(aMask.b));
6728           aStream.Read(aMask.a, SizeOf(aMask.a));
6729         end else
6730           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6731       end;
6732     end;
6733
6734     //get suitable format
6735     case aInfo.biBitCount of
6736        8: result := tfLuminance8;
6737       16: result := tfBGR5;
6738       24: result := tfBGR8;
6739       32: result := tfBGRA8;
6740     end;
6741   end;
6742
6743   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6744   var
6745     i, c: Integer;
6746     ColorTable: TbmpColorTable;
6747   begin
6748     result := nil;
6749     if (aInfo.biBitCount >= 16) then
6750       exit;
6751     aFormat := tfLuminance8;
6752     c := aInfo.biClrUsed;
6753     if (c = 0) then
6754       c := 1 shl aInfo.biBitCount;
6755     SetLength(ColorTable, c);
6756     for i := 0 to c-1 do begin
6757       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6758       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6759         aFormat := tfRGB8;
6760     end;
6761
6762     result := TbmpColorTableFormat.Create;
6763     result.PixelSize  := aInfo.biBitCount / 8;
6764     result.ColorTable := ColorTable;
6765     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6766   end;
6767
6768   //////////////////////////////////////////////////////////////////////////////////////////////////
6769   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6770     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6771   var
6772     TmpFormat: TglBitmapFormat;
6773     FormatDesc: TFormatDescriptor;
6774   begin
6775     result := nil;
6776     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6777       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6778         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6779         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6780           aFormat := FormatDesc.Format;
6781           exit;
6782         end;
6783       end;
6784
6785       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6786         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6787       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6788         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6789
6790       result := TbmpBitfieldFormat.Create;
6791       result.PixelSize := aInfo.biBitCount / 8;
6792       result.RedMask   := aMask.r;
6793       result.GreenMask := aMask.g;
6794       result.BlueMask  := aMask.b;
6795       result.AlphaMask := aMask.a;
6796     end;
6797   end;
6798
6799 var
6800   //simple types
6801   StartPos: Int64;
6802   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6803   PaddingBuff: Cardinal;
6804   LineBuf, ImageData, TmpData: PByte;
6805   SourceMD, DestMD: Pointer;
6806   BmpFormat: TglBitmapFormat;
6807
6808   //records
6809   Mask: TglBitmapColorRec;
6810   Header: TBMPHeader;
6811   Info: TBMPInfo;
6812
6813   //classes
6814   SpecialFormat: TFormatDescriptor;
6815   FormatDesc: TFormatDescriptor;
6816
6817   //////////////////////////////////////////////////////////////////////////////////////////////////
6818   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6819   var
6820     i: Integer;
6821     Pixel: TglBitmapPixelData;
6822   begin
6823     aStream.Read(aLineBuf^, rbLineSize);
6824     SpecialFormat.PreparePixel(Pixel);
6825     for i := 0 to Info.biWidth-1 do begin
6826       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6827       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6828       FormatDesc.Map(Pixel, aData, DestMD);
6829     end;
6830   end;
6831
6832 begin
6833   result        := false;
6834   BmpFormat     := tfEmpty;
6835   SpecialFormat := nil;
6836   LineBuf       := nil;
6837   SourceMD      := nil;
6838   DestMD        := nil;
6839
6840   // Header
6841   StartPos := aStream.Position;
6842   aStream.Read(Header{%H-}, SizeOf(Header));
6843
6844   if Header.bfType = BMP_MAGIC then begin
6845     try try
6846       BmpFormat        := ReadInfo(Info, Mask);
6847       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6848       if not Assigned(SpecialFormat) then
6849         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6850       aStream.Position := StartPos + Header.bfOffBits;
6851
6852       if (BmpFormat <> tfEmpty) then begin
6853         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6854         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6855         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6856         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6857
6858         //get Memory
6859         DestMD    := FormatDesc.CreateMappingData;
6860         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6861         GetMem(ImageData, ImageSize);
6862         if Assigned(SpecialFormat) then begin
6863           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6864           SourceMD := SpecialFormat.CreateMappingData;
6865         end;
6866
6867         //read Data
6868         try try
6869           FillChar(ImageData^, ImageSize, $FF);
6870           TmpData := ImageData;
6871           if (Info.biHeight > 0) then
6872             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6873           for i := 0 to Abs(Info.biHeight)-1 do begin
6874             if Assigned(SpecialFormat) then
6875               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6876             else
6877               aStream.Read(TmpData^, wbLineSize);   //else only read data
6878             if (Info.biHeight > 0) then
6879               dec(TmpData, wbLineSize)
6880             else
6881               inc(TmpData, wbLineSize);
6882             aStream.Read(PaddingBuff{%H-}, Padding);
6883           end;
6884           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6885           result := true;
6886         finally
6887           if Assigned(LineBuf) then
6888             FreeMem(LineBuf);
6889           if Assigned(SourceMD) then
6890             SpecialFormat.FreeMappingData(SourceMD);
6891           FormatDesc.FreeMappingData(DestMD);
6892         end;
6893         except
6894           if Assigned(ImageData) then
6895             FreeMem(ImageData);
6896           raise;
6897         end;
6898       end else
6899         raise EglBitmap.Create('LoadBMP - No suitable format found');
6900     except
6901       aStream.Position := StartPos;
6902       raise;
6903     end;
6904     finally
6905       FreeAndNil(SpecialFormat);
6906     end;
6907   end
6908     else aStream.Position := StartPos;
6909 end;
6910
6911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6912 procedure TglBitmap.SaveBMP(const aStream: TStream);
6913 var
6914   Header: TBMPHeader;
6915   Info: TBMPInfo;
6916   Converter: TFormatDescriptor;
6917   FormatDesc: TFormatDescriptor;
6918   SourceFD, DestFD: Pointer;
6919   pData, srcData, dstData, ConvertBuffer: pByte;
6920
6921   Pixel: TglBitmapPixelData;
6922   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6923   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6924
6925   PaddingBuff: Cardinal;
6926
6927   function GetLineWidth : Integer;
6928   begin
6929     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6930   end;
6931
6932 begin
6933   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6934     raise EglBitmapUnsupportedFormat.Create(Format);
6935
6936   Converter  := nil;
6937   FormatDesc := TFormatDescriptor.Get(Format);
6938   ImageSize  := FormatDesc.GetSize(Dimension);
6939
6940   FillChar(Header{%H-}, SizeOf(Header), 0);
6941   Header.bfType      := BMP_MAGIC;
6942   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6943   Header.bfReserved1 := 0;
6944   Header.bfReserved2 := 0;
6945   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6946
6947   FillChar(Info{%H-}, SizeOf(Info), 0);
6948   Info.biSize        := SizeOf(Info);
6949   Info.biWidth       := Width;
6950   Info.biHeight      := Height;
6951   Info.biPlanes      := 1;
6952   Info.biCompression := BMP_COMP_RGB;
6953   Info.biSizeImage   := ImageSize;
6954
6955   try
6956     case Format of
6957       tfLuminance4: begin
6958         Info.biBitCount  := 4;
6959         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6960         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6961         Converter := TbmpColorTableFormat.Create;
6962         with (Converter as TbmpColorTableFormat) do begin
6963           PixelSize := 0.5;
6964           Format    := Format;
6965           Range     := glBitmapColorRec($F, $F, $F, $0);
6966           CreateColorTable;
6967         end;
6968       end;
6969
6970       tfR3G3B2, tfLuminance8: begin
6971         Info.biBitCount  :=  8;
6972         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6973         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6974         Converter := TbmpColorTableFormat.Create;
6975         with (Converter as TbmpColorTableFormat) do begin
6976           PixelSize := 1;
6977           Format    := Format;
6978           if (Format = tfR3G3B2) then begin
6979             Range := glBitmapColorRec($7, $7, $3, $0);
6980             Shift := glBitmapShiftRec(0, 3, 6, 0);
6981           end else
6982             Range := glBitmapColorRec($FF, $FF, $FF, $0);
6983           CreateColorTable;
6984         end;
6985       end;
6986
6987       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6988       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6989         Info.biBitCount    := 16;
6990         Info.biCompression := BMP_COMP_BITFIELDS;
6991       end;
6992
6993       tfBGR8, tfRGB8: begin
6994         Info.biBitCount := 24;
6995         if (Format = tfRGB8) then
6996           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
6997       end;
6998
6999       tfRGB10, tfRGB10A2, tfRGBA8,
7000       tfBGR10, tfBGR10A2, tfBGRA8: begin
7001         Info.biBitCount    := 32;
7002         Info.biCompression := BMP_COMP_BITFIELDS;
7003       end;
7004     else
7005       raise EglBitmapUnsupportedFormat.Create(Format);
7006     end;
7007     Info.biXPelsPerMeter := 2835;
7008     Info.biYPelsPerMeter := 2835;
7009
7010     // prepare bitmasks
7011     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7012       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7013       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7014
7015       RedMask    := FormatDesc.RedMask;
7016       GreenMask  := FormatDesc.GreenMask;
7017       BlueMask   := FormatDesc.BlueMask;
7018       AlphaMask  := FormatDesc.AlphaMask;
7019     end;
7020
7021     // headers
7022     aStream.Write(Header, SizeOf(Header));
7023     aStream.Write(Info, SizeOf(Info));
7024
7025     // colortable
7026     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7027       with (Converter as TbmpColorTableFormat) do
7028         aStream.Write(ColorTable[0].b,
7029           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7030
7031     // bitmasks
7032     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7033       aStream.Write(RedMask,   SizeOf(Cardinal));
7034       aStream.Write(GreenMask, SizeOf(Cardinal));
7035       aStream.Write(BlueMask,  SizeOf(Cardinal));
7036       aStream.Write(AlphaMask, SizeOf(Cardinal));
7037     end;
7038
7039     // image data
7040     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7041     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7042     Padding     := GetLineWidth - wbLineSize;
7043     PaddingBuff := 0;
7044
7045     pData := Data;
7046     inc(pData, (Height-1) * rbLineSize);
7047
7048     // prepare row buffer. But only for RGB because RGBA supports color masks
7049     // so it's possible to change color within the image.
7050     if Assigned(Converter) then begin
7051       FormatDesc.PreparePixel(Pixel);
7052       GetMem(ConvertBuffer, wbLineSize);
7053       SourceFD := FormatDesc.CreateMappingData;
7054       DestFD   := Converter.CreateMappingData;
7055     end else
7056       ConvertBuffer := nil;
7057
7058     try
7059       for LineIdx := 0 to Height - 1 do begin
7060         // preparing row
7061         if Assigned(Converter) then begin
7062           srcData := pData;
7063           dstData := ConvertBuffer;
7064           for PixelIdx := 0 to Info.biWidth-1 do begin
7065             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7066             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7067             Converter.Map(Pixel, dstData, DestFD);
7068           end;
7069           aStream.Write(ConvertBuffer^, wbLineSize);
7070         end else begin
7071           aStream.Write(pData^, rbLineSize);
7072         end;
7073         dec(pData, rbLineSize);
7074         if (Padding > 0) then
7075           aStream.Write(PaddingBuff, Padding);
7076       end;
7077     finally
7078       // destroy row buffer
7079       if Assigned(ConvertBuffer) then begin
7080         FormatDesc.FreeMappingData(SourceFD);
7081         Converter.FreeMappingData(DestFD);
7082         FreeMem(ConvertBuffer);
7083       end;
7084     end;
7085   finally
7086     if Assigned(Converter) then
7087       Converter.Free;
7088   end;
7089 end;
7090
7091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7092 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7094 type
7095   TTGAHeader = packed record
7096     ImageID: Byte;
7097     ColorMapType: Byte;
7098     ImageType: Byte;
7099     //ColorMapSpec: Array[0..4] of Byte;
7100     ColorMapStart: Word;
7101     ColorMapLength: Word;
7102     ColorMapEntrySize: Byte;
7103     OrigX: Word;
7104     OrigY: Word;
7105     Width: Word;
7106     Height: Word;
7107     Bpp: Byte;
7108     ImageDesc: Byte;
7109   end;
7110
7111 const
7112   TGA_UNCOMPRESSED_RGB  =  2;
7113   TGA_UNCOMPRESSED_GRAY =  3;
7114   TGA_COMPRESSED_RGB    = 10;
7115   TGA_COMPRESSED_GRAY   = 11;
7116
7117   TGA_NONE_COLOR_TABLE  = 0;
7118
7119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7120 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7121 var
7122   Header: TTGAHeader;
7123   ImageData: System.PByte;
7124   StartPosition: Int64;
7125   PixelSize, LineSize: Integer;
7126   tgaFormat: TglBitmapFormat;
7127   FormatDesc: TFormatDescriptor;
7128   Counter: packed record
7129     X, Y: packed record
7130       low, high, dir: Integer;
7131     end;
7132   end;
7133
7134 const
7135   CACHE_SIZE = $4000;
7136
7137   ////////////////////////////////////////////////////////////////////////////////////////
7138   procedure ReadUncompressed;
7139   var
7140     i, j: Integer;
7141     buf, tmp1, tmp2: System.PByte;
7142   begin
7143     buf := nil;
7144     if (Counter.X.dir < 0) then
7145       GetMem(buf, LineSize);
7146     try
7147       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7148         tmp1 := ImageData;
7149         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7150         if (Counter.X.dir < 0) then begin               //flip X
7151           aStream.Read(buf^, LineSize);
7152           tmp2 := buf;
7153           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7154           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7155             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7156               tmp1^ := tmp2^;
7157               inc(tmp1);
7158               inc(tmp2);
7159             end;
7160             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7161           end;
7162         end else
7163           aStream.Read(tmp1^, LineSize);
7164         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7165       end;
7166     finally
7167       if Assigned(buf) then
7168         FreeMem(buf);
7169     end;
7170   end;
7171
7172   ////////////////////////////////////////////////////////////////////////////////////////
7173   procedure ReadCompressed;
7174
7175     /////////////////////////////////////////////////////////////////
7176     var
7177       TmpData: System.PByte;
7178       LinePixelsRead: Integer;
7179     procedure CheckLine;
7180     begin
7181       if (LinePixelsRead >= Header.Width) then begin
7182         LinePixelsRead := 0;
7183         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7184         TmpData := ImageData;
7185         inc(TmpData, Counter.Y.low * LineSize);           //set line
7186         if (Counter.X.dir < 0) then                       //if x flipped then
7187           inc(TmpData, LineSize - PixelSize);             //set last pixel
7188       end;
7189     end;
7190
7191     /////////////////////////////////////////////////////////////////
7192     var
7193       Cache: PByte;
7194       CacheSize, CachePos: Integer;
7195     procedure CachedRead(out Buffer; Count: Integer);
7196     var
7197       BytesRead: Integer;
7198     begin
7199       if (CachePos + Count > CacheSize) then begin
7200         //if buffer overflow save non read bytes
7201         BytesRead := 0;
7202         if (CacheSize - CachePos > 0) then begin
7203           BytesRead := CacheSize - CachePos;
7204           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7205           inc(CachePos, BytesRead);
7206         end;
7207
7208         //load cache from file
7209         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7210         aStream.Read(Cache^, CacheSize);
7211         CachePos := 0;
7212
7213         //read rest of requested bytes
7214         if (Count - BytesRead > 0) then begin
7215           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7216           inc(CachePos, Count - BytesRead);
7217         end;
7218       end else begin
7219         //if no buffer overflow just read the data
7220         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7221         inc(CachePos, Count);
7222       end;
7223     end;
7224
7225     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7226     begin
7227       case PixelSize of
7228         1: begin
7229           aBuffer^ := aData^;
7230           inc(aBuffer, Counter.X.dir);
7231         end;
7232         2: begin
7233           PWord(aBuffer)^ := PWord(aData)^;
7234           inc(aBuffer, 2 * Counter.X.dir);
7235         end;
7236         3: begin
7237           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7238           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7239           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7240           inc(aBuffer, 3 * Counter.X.dir);
7241         end;
7242         4: begin
7243           PCardinal(aBuffer)^ := PCardinal(aData)^;
7244           inc(aBuffer, 4 * Counter.X.dir);
7245         end;
7246       end;
7247     end;
7248
7249   var
7250     TotalPixelsToRead, TotalPixelsRead: Integer;
7251     Temp: Byte;
7252     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7253     PixelRepeat: Boolean;
7254     PixelsToRead, PixelCount: Integer;
7255   begin
7256     CacheSize := 0;
7257     CachePos  := 0;
7258
7259     TotalPixelsToRead := Header.Width * Header.Height;
7260     TotalPixelsRead   := 0;
7261     LinePixelsRead    := 0;
7262
7263     GetMem(Cache, CACHE_SIZE);
7264     try
7265       TmpData := ImageData;
7266       inc(TmpData, Counter.Y.low * LineSize);           //set line
7267       if (Counter.X.dir < 0) then                       //if x flipped then
7268         inc(TmpData, LineSize - PixelSize);             //set last pixel
7269
7270       repeat
7271         //read CommandByte
7272         CachedRead(Temp, 1);
7273         PixelRepeat  := (Temp and $80) > 0;
7274         PixelsToRead := (Temp and $7F) + 1;
7275         inc(TotalPixelsRead, PixelsToRead);
7276
7277         if PixelRepeat then
7278           CachedRead(buf[0], PixelSize);
7279         while (PixelsToRead > 0) do begin
7280           CheckLine;
7281           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7282           while (PixelCount > 0) do begin
7283             if not PixelRepeat then
7284               CachedRead(buf[0], PixelSize);
7285             PixelToBuffer(@buf[0], TmpData);
7286             inc(LinePixelsRead);
7287             dec(PixelsToRead);
7288             dec(PixelCount);
7289           end;
7290         end;
7291       until (TotalPixelsRead >= TotalPixelsToRead);
7292     finally
7293       FreeMem(Cache);
7294     end;
7295   end;
7296
7297   function IsGrayFormat: Boolean;
7298   begin
7299     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7300   end;
7301
7302 begin
7303   result := false;
7304
7305   // reading header to test file and set cursor back to begin
7306   StartPosition := aStream.Position;
7307   aStream.Read(Header{%H-}, SizeOf(Header));
7308
7309   // no colormapped files
7310   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7311     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7312   begin
7313     try
7314       if Header.ImageID <> 0 then       // skip image ID
7315         aStream.Position := aStream.Position + Header.ImageID;
7316
7317       tgaFormat := tfEmpty;
7318       case Header.Bpp of
7319          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7320                0: tgaFormat := tfLuminance8;
7321                8: tgaFormat := tfAlpha8;
7322             end;
7323
7324         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7325                0: tgaFormat := tfLuminance16;
7326                8: tgaFormat := tfLuminance8Alpha8;
7327             end else case (Header.ImageDesc and $F) of
7328                0: tgaFormat := tfBGR5;
7329                1: tgaFormat := tfBGR5A1;
7330                4: tgaFormat := tfBGRA4;
7331             end;
7332
7333         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7334                0: tgaFormat := tfBGR8;
7335             end;
7336
7337         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7338                2: tgaFormat := tfBGR10A2;
7339                8: tgaFormat := tfBGRA8;
7340             end;
7341       end;
7342
7343       if (tgaFormat = tfEmpty) then
7344         raise EglBitmap.Create('LoadTga - unsupported format');
7345
7346       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7347       PixelSize  := FormatDesc.GetSize(1, 1);
7348       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7349
7350       GetMem(ImageData, LineSize * Header.Height);
7351       try
7352         //column direction
7353         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7354           Counter.X.low  := Header.Height-1;;
7355           Counter.X.high := 0;
7356           Counter.X.dir  := -1;
7357         end else begin
7358           Counter.X.low  := 0;
7359           Counter.X.high := Header.Height-1;
7360           Counter.X.dir  := 1;
7361         end;
7362
7363         // Row direction
7364         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7365           Counter.Y.low  := 0;
7366           Counter.Y.high := Header.Height-1;
7367           Counter.Y.dir  := 1;
7368         end else begin
7369           Counter.Y.low  := Header.Height-1;;
7370           Counter.Y.high := 0;
7371           Counter.Y.dir  := -1;
7372         end;
7373
7374         // Read Image
7375         case Header.ImageType of
7376           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7377             ReadUncompressed;
7378           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7379             ReadCompressed;
7380         end;
7381
7382         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7383         result := true;
7384       except
7385         if Assigned(ImageData) then
7386           FreeMem(ImageData);
7387         raise;
7388       end;
7389     finally
7390       aStream.Position := StartPosition;
7391     end;
7392   end
7393     else aStream.Position := StartPosition;
7394 end;
7395
7396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7397 procedure TglBitmap.SaveTGA(const aStream: TStream);
7398 var
7399   Header: TTGAHeader;
7400   LineSize, Size, x, y: Integer;
7401   Pixel: TglBitmapPixelData;
7402   LineBuf, SourceData, DestData: PByte;
7403   SourceMD, DestMD: Pointer;
7404   FormatDesc: TFormatDescriptor;
7405   Converter: TFormatDescriptor;
7406 begin
7407   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7408     raise EglBitmapUnsupportedFormat.Create(Format);
7409
7410   //prepare header
7411   FillChar(Header{%H-}, SizeOf(Header), 0);
7412
7413   //set ImageType
7414   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7415                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7416     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7417   else
7418     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7419
7420   //set BitsPerPixel
7421   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7422     Header.Bpp := 8
7423   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7424                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7425     Header.Bpp := 16
7426   else if (Format in [tfBGR8, tfRGB8]) then
7427     Header.Bpp := 24
7428   else
7429     Header.Bpp := 32;
7430
7431   //set AlphaBitCount
7432   case Format of
7433     tfRGB5A1, tfBGR5A1:
7434       Header.ImageDesc := 1 and $F;
7435     tfRGB10A2, tfBGR10A2:
7436       Header.ImageDesc := 2 and $F;
7437     tfRGBA4, tfBGRA4:
7438       Header.ImageDesc := 4 and $F;
7439     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7440       Header.ImageDesc := 8 and $F;
7441   end;
7442
7443   Header.Width     := Width;
7444   Header.Height    := Height;
7445   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7446   aStream.Write(Header, SizeOf(Header));
7447
7448   // convert RGB(A) to BGR(A)
7449   Converter  := nil;
7450   FormatDesc := TFormatDescriptor.Get(Format);
7451   Size       := FormatDesc.GetSize(Dimension);
7452   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7453     if (FormatDesc.RGBInverted = tfEmpty) then
7454       raise EglBitmap.Create('inverted RGB format is empty');
7455     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7456     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7457        (Converter.PixelSize <> FormatDesc.PixelSize) then
7458       raise EglBitmap.Create('invalid inverted RGB format');
7459   end;
7460
7461   if Assigned(Converter) then begin
7462     LineSize := FormatDesc.GetSize(Width, 1);
7463     GetMem(LineBuf, LineSize);
7464     SourceMD := FormatDesc.CreateMappingData;
7465     DestMD   := Converter.CreateMappingData;
7466     try
7467       SourceData := Data;
7468       for y := 0 to Height-1 do begin
7469         DestData := LineBuf;
7470         for x := 0 to Width-1 do begin
7471           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7472           Converter.Map(Pixel, DestData, DestMD);
7473         end;
7474         aStream.Write(LineBuf^, LineSize);
7475       end;
7476     finally
7477       FreeMem(LineBuf);
7478       FormatDesc.FreeMappingData(SourceMD);
7479       FormatDesc.FreeMappingData(DestMD);
7480     end;
7481   end else
7482     aStream.Write(Data^, Size);
7483 end;
7484
7485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7486 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7488 const
7489   DDS_MAGIC: Cardinal         = $20534444;
7490
7491   // DDS_header.dwFlags
7492   DDSD_CAPS                   = $00000001;
7493   DDSD_HEIGHT                 = $00000002;
7494   DDSD_WIDTH                  = $00000004;
7495   DDSD_PIXELFORMAT            = $00001000;
7496
7497   // DDS_header.sPixelFormat.dwFlags
7498   DDPF_ALPHAPIXELS            = $00000001;
7499   DDPF_ALPHA                  = $00000002;
7500   DDPF_FOURCC                 = $00000004;
7501   DDPF_RGB                    = $00000040;
7502   DDPF_LUMINANCE              = $00020000;
7503
7504   // DDS_header.sCaps.dwCaps1
7505   DDSCAPS_TEXTURE             = $00001000;
7506
7507   // DDS_header.sCaps.dwCaps2
7508   DDSCAPS2_CUBEMAP            = $00000200;
7509
7510   D3DFMT_DXT1                 = $31545844;
7511   D3DFMT_DXT3                 = $33545844;
7512   D3DFMT_DXT5                 = $35545844;
7513
7514 type
7515   TDDSPixelFormat = packed record
7516     dwSize: Cardinal;
7517     dwFlags: Cardinal;
7518     dwFourCC: Cardinal;
7519     dwRGBBitCount: Cardinal;
7520     dwRBitMask: Cardinal;
7521     dwGBitMask: Cardinal;
7522     dwBBitMask: Cardinal;
7523     dwABitMask: Cardinal;
7524   end;
7525
7526   TDDSCaps = packed record
7527     dwCaps1: Cardinal;
7528     dwCaps2: Cardinal;
7529     dwDDSX: Cardinal;
7530     dwReserved: Cardinal;
7531   end;
7532
7533   TDDSHeader = packed record
7534     dwSize: Cardinal;
7535     dwFlags: Cardinal;
7536     dwHeight: Cardinal;
7537     dwWidth: Cardinal;
7538     dwPitchOrLinearSize: Cardinal;
7539     dwDepth: Cardinal;
7540     dwMipMapCount: Cardinal;
7541     dwReserved: array[0..10] of Cardinal;
7542     PixelFormat: TDDSPixelFormat;
7543     Caps: TDDSCaps;
7544     dwReserved2: Cardinal;
7545   end;
7546
7547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7548 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7549 var
7550   Header: TDDSHeader;
7551   Converter: TbmpBitfieldFormat;
7552
7553   function GetDDSFormat: TglBitmapFormat;
7554   var
7555     fd: TFormatDescriptor;
7556     i: Integer;
7557     Range: TglBitmapColorRec;
7558     match: Boolean;
7559   begin
7560     result := tfEmpty;
7561     with Header.PixelFormat do begin
7562       // Compresses
7563       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7564         case Header.PixelFormat.dwFourCC of
7565           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7566           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7567           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7568         end;
7569       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7570
7571         //find matching format
7572         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7573           fd := TFormatDescriptor.Get(result);
7574           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7575              (8 * fd.PixelSize = dwRGBBitCount) then
7576             exit;
7577         end;
7578
7579         //find format with same Range
7580         Range.r := dwRBitMask;
7581         Range.g := dwGBitMask;
7582         Range.b := dwBBitMask;
7583         Range.a := dwABitMask;
7584         for i := 0 to 3 do begin
7585           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7586             Range.arr[i] := Range.arr[i] shr 1;
7587         end;
7588         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7589           fd := TFormatDescriptor.Get(result);
7590           match := true;
7591           for i := 0 to 3 do
7592             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7593               match := false;
7594               break;
7595             end;
7596           if match then
7597             break;
7598         end;
7599
7600         //no format with same range found -> use default
7601         if (result = tfEmpty) then begin
7602           if (dwABitMask > 0) then
7603             result := tfBGRA8
7604           else
7605             result := tfBGR8;
7606         end;
7607
7608         Converter := TbmpBitfieldFormat.Create;
7609         Converter.RedMask   := dwRBitMask;
7610         Converter.GreenMask := dwGBitMask;
7611         Converter.BlueMask  := dwBBitMask;
7612         Converter.AlphaMask := dwABitMask;
7613         Converter.PixelSize := dwRGBBitCount / 8;
7614       end;
7615     end;
7616   end;
7617
7618 var
7619   StreamPos: Int64;
7620   x, y, LineSize, RowSize, Magic: Cardinal;
7621   NewImage, TmpData, RowData, SrcData: System.PByte;
7622   SourceMD, DestMD: Pointer;
7623   Pixel: TglBitmapPixelData;
7624   ddsFormat: TglBitmapFormat;
7625   FormatDesc: TFormatDescriptor;
7626
7627 begin
7628   result    := false;
7629   Converter := nil;
7630   StreamPos := aStream.Position;
7631
7632   // Magic
7633   aStream.Read(Magic{%H-}, sizeof(Magic));
7634   if (Magic <> DDS_MAGIC) then begin
7635     aStream.Position := StreamPos;
7636     exit;
7637   end;
7638
7639   //Header
7640   aStream.Read(Header{%H-}, sizeof(Header));
7641   if (Header.dwSize <> SizeOf(Header)) or
7642      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7643         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7644   begin
7645     aStream.Position := StreamPos;
7646     exit;
7647   end;
7648
7649   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7650     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7651
7652   ddsFormat := GetDDSFormat;
7653   try
7654     if (ddsFormat = tfEmpty) then
7655       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7656
7657     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7658     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7659     GetMem(NewImage, Header.dwHeight * LineSize);
7660     try
7661       TmpData := NewImage;
7662
7663       //Converter needed
7664       if Assigned(Converter) then begin
7665         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7666         GetMem(RowData, RowSize);
7667         SourceMD := Converter.CreateMappingData;
7668         DestMD   := FormatDesc.CreateMappingData;
7669         try
7670           for y := 0 to Header.dwHeight-1 do begin
7671             TmpData := NewImage;
7672             inc(TmpData, y * LineSize);
7673             SrcData := RowData;
7674             aStream.Read(SrcData^, RowSize);
7675             for x := 0 to Header.dwWidth-1 do begin
7676               Converter.Unmap(SrcData, Pixel, SourceMD);
7677               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7678               FormatDesc.Map(Pixel, TmpData, DestMD);
7679             end;
7680           end;
7681         finally
7682           Converter.FreeMappingData(SourceMD);
7683           FormatDesc.FreeMappingData(DestMD);
7684           FreeMem(RowData);
7685         end;
7686       end else
7687
7688       // Compressed
7689       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7690         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7691         for Y := 0 to Header.dwHeight-1 do begin
7692           aStream.Read(TmpData^, RowSize);
7693           Inc(TmpData, LineSize);
7694         end;
7695       end else
7696
7697       // Uncompressed
7698       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7699         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7700         for Y := 0 to Header.dwHeight-1 do begin
7701           aStream.Read(TmpData^, RowSize);
7702           Inc(TmpData, LineSize);
7703         end;
7704       end else
7705         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7706
7707       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7708       result := true;
7709     except
7710       if Assigned(NewImage) then
7711         FreeMem(NewImage);
7712       raise;
7713     end;
7714   finally
7715     FreeAndNil(Converter);
7716   end;
7717 end;
7718
7719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7720 procedure TglBitmap.SaveDDS(const aStream: TStream);
7721 var
7722   Header: TDDSHeader;
7723   FormatDesc: TFormatDescriptor;
7724 begin
7725   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7726     raise EglBitmapUnsupportedFormat.Create(Format);
7727
7728   FormatDesc := TFormatDescriptor.Get(Format);
7729
7730   // Generell
7731   FillChar(Header{%H-}, SizeOf(Header), 0);
7732   Header.dwSize  := SizeOf(Header);
7733   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7734
7735   Header.dwWidth  := Max(1, Width);
7736   Header.dwHeight := Max(1, Height);
7737
7738   // Caps
7739   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7740
7741   // Pixelformat
7742   Header.PixelFormat.dwSize := sizeof(Header);
7743   if (FormatDesc.IsCompressed) then begin
7744     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7745     case Format of
7746       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7747       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7748       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7749     end;
7750   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7751     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7752     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7753     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7754   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7755     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7756     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7757     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7758     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7759   end else begin
7760     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7761     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7762     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7763     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7764     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7765     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7766   end;
7767
7768   if (FormatDesc.HasAlpha) then
7769     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7770
7771   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7772   aStream.Write(Header, SizeOf(Header));
7773   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7774 end;
7775
7776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7777 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7779 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7780   const aWidth: Integer; const aHeight: Integer);
7781 var
7782   pTemp: pByte;
7783   Size: Integer;
7784 begin
7785   if (aHeight > 1) then begin
7786     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7787     GetMem(pTemp, Size);
7788     try
7789       Move(aData^, pTemp^, Size);
7790       FreeMem(aData);
7791       aData := nil;
7792     except
7793       FreeMem(pTemp);
7794       raise;
7795     end;
7796   end else
7797     pTemp := aData;
7798   inherited SetDataPointer(pTemp, aFormat, aWidth);
7799 end;
7800
7801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7802 function TglBitmap1D.FlipHorz: Boolean;
7803 var
7804   Col: Integer;
7805   pTempDest, pDest, pSource: PByte;
7806 begin
7807   result := inherited FlipHorz;
7808   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7809     pSource := Data;
7810     GetMem(pDest, fRowSize);
7811     try
7812       pTempDest := pDest;
7813       Inc(pTempDest, fRowSize);
7814       for Col := 0 to Width-1 do begin
7815         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7816         Move(pSource^, pTempDest^, fPixelSize);
7817         Inc(pSource, fPixelSize);
7818       end;
7819       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7820       result := true;
7821     except
7822       if Assigned(pDest) then
7823         FreeMem(pDest);
7824       raise;
7825     end;
7826   end;
7827 end;
7828
7829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7830 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7831 var
7832   FormatDesc: TFormatDescriptor;
7833 begin
7834   // Upload data
7835   FormatDesc := TFormatDescriptor.Get(Format);
7836   if FormatDesc.IsCompressed then begin
7837     if not Assigned(glCompressedTexImage1D) then
7838       raise EglBitmap.Create('compressed formats not supported by video adapter');
7839     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7840   end else if aBuildWithGlu then
7841     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7842   else
7843     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7844
7845   // Free Data
7846   if (FreeDataAfterGenTexture) then
7847     FreeData;
7848 end;
7849
7850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7851 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7852 var
7853   BuildWithGlu, TexRec: Boolean;
7854   TexSize: Integer;
7855 begin
7856   if Assigned(Data) then begin
7857     // Check Texture Size
7858     if (aTestTextureSize) then begin
7859       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7860
7861       if (Width > TexSize) then
7862         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7863
7864       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7865                 (Target = GL_TEXTURE_RECTANGLE);
7866       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7867         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7868     end;
7869
7870     CreateId;
7871     SetupParameters(BuildWithGlu);
7872     UploadData(BuildWithGlu);
7873     glAreTexturesResident(1, @fID, @fIsResident);
7874   end;
7875 end;
7876
7877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7878 procedure TglBitmap1D.AfterConstruction;
7879 begin
7880   inherited;
7881   Target := GL_TEXTURE_1D;
7882 end;
7883
7884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7885 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7887 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7888 begin
7889   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7890     result := fLines[aIndex]
7891   else
7892     result := nil;
7893 end;
7894
7895 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7896 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7897   const aWidth: Integer; const aHeight: Integer);
7898 var
7899   Idx, LineWidth: Integer;
7900 begin
7901   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7902
7903   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7904     // Assigning Data
7905     if Assigned(Data) then begin
7906       SetLength(fLines, GetHeight);
7907       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7908
7909       for Idx := 0 to GetHeight-1 do begin
7910         fLines[Idx] := Data;
7911         Inc(fLines[Idx], Idx * LineWidth);
7912       end;
7913     end
7914       else SetLength(fLines, 0);
7915   end else begin
7916     SetLength(fLines, 0);
7917   end;
7918 end;
7919
7920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7921 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7922 var
7923   FormatDesc: TFormatDescriptor;
7924 begin
7925   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7926
7927   FormatDesc := TFormatDescriptor.Get(Format);
7928   if FormatDesc.IsCompressed then begin
7929     if not Assigned(glCompressedTexImage2D) then
7930       raise EglBitmap.Create('compressed formats not supported by video adapter');
7931     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7932   end else if aBuildWithGlu then begin
7933     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7934       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7935   end else begin
7936     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7937       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7938   end;
7939
7940   // Freigeben
7941   if (FreeDataAfterGenTexture) then
7942     FreeData;
7943 end;
7944
7945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7946 procedure TglBitmap2D.AfterConstruction;
7947 begin
7948   inherited;
7949   Target := GL_TEXTURE_2D;
7950 end;
7951
7952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7953 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7954 var
7955   Temp: pByte;
7956   Size, w, h: Integer;
7957   FormatDesc: TFormatDescriptor;
7958 begin
7959   FormatDesc := TFormatDescriptor.Get(aFormat);
7960   if FormatDesc.IsCompressed then
7961     raise EglBitmapUnsupportedFormat.Create(aFormat);
7962
7963   w    := aRight  - aLeft;
7964   h    := aBottom - aTop;
7965   Size := FormatDesc.GetSize(w, h);
7966   GetMem(Temp, Size);
7967   try
7968     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7969     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7970     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7971     FlipVert;
7972   except
7973     if Assigned(Temp) then
7974       FreeMem(Temp);
7975     raise;
7976   end;
7977 end;
7978
7979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7980 procedure TglBitmap2D.GetDataFromTexture;
7981 var
7982   Temp: PByte;
7983   TempWidth, TempHeight: Integer;
7984   TempIntFormat: Cardinal;
7985   IntFormat, f: TglBitmapFormat;
7986   FormatDesc: TFormatDescriptor;
7987 begin
7988   Bind;
7989
7990   // Request Data
7991   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7992   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7993   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7994
7995   IntFormat := tfEmpty;
7996   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7997     FormatDesc := TFormatDescriptor.Get(f);
7998     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7999       IntFormat := FormatDesc.Format;
8000       break;
8001     end;
8002   end;
8003
8004   // Getting data from OpenGL
8005   FormatDesc := TFormatDescriptor.Get(IntFormat);
8006   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8007   try
8008     if FormatDesc.IsCompressed then begin
8009       if not Assigned(glGetCompressedTexImage) then
8010         raise EglBitmap.Create('compressed formats not supported by video adapter');
8011       glGetCompressedTexImage(Target, 0, Temp)
8012     end else
8013       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8014     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8015   except
8016     if Assigned(Temp) then
8017       FreeMem(Temp);
8018     raise;
8019   end;
8020 end;
8021
8022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8023 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8024 var
8025   BuildWithGlu, PotTex, TexRec: Boolean;
8026   TexSize: Integer;
8027 begin
8028   if Assigned(Data) then begin
8029     // Check Texture Size
8030     if (aTestTextureSize) then begin
8031       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8032
8033       if ((Height > TexSize) or (Width > TexSize)) then
8034         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8035
8036       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8037       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8038       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8039         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8040     end;
8041
8042     CreateId;
8043     SetupParameters(BuildWithGlu);
8044     UploadData(Target, BuildWithGlu);
8045     glAreTexturesResident(1, @fID, @fIsResident);
8046   end;
8047 end;
8048
8049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8050 function TglBitmap2D.FlipHorz: Boolean;
8051 var
8052   Col, Row: Integer;
8053   TempDestData, DestData, SourceData: PByte;
8054   ImgSize: Integer;
8055 begin
8056   result := inherited FlipHorz;
8057   if Assigned(Data) then begin
8058     SourceData := Data;
8059     ImgSize := Height * fRowSize;
8060     GetMem(DestData, ImgSize);
8061     try
8062       TempDestData := DestData;
8063       Dec(TempDestData, fRowSize + fPixelSize);
8064       for Row := 0 to Height -1 do begin
8065         Inc(TempDestData, fRowSize * 2);
8066         for Col := 0 to Width -1 do begin
8067           Move(SourceData^, TempDestData^, fPixelSize);
8068           Inc(SourceData, fPixelSize);
8069           Dec(TempDestData, fPixelSize);
8070         end;
8071       end;
8072       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8073       result := true;
8074     except
8075       if Assigned(DestData) then
8076         FreeMem(DestData);
8077       raise;
8078     end;
8079   end;
8080 end;
8081
8082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8083 function TglBitmap2D.FlipVert: Boolean;
8084 var
8085   Row: Integer;
8086   TempDestData, DestData, SourceData: PByte;
8087 begin
8088   result := inherited FlipVert;
8089   if Assigned(Data) then begin
8090     SourceData := Data;
8091     GetMem(DestData, Height * fRowSize);
8092     try
8093       TempDestData := DestData;
8094       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8095       for Row := 0 to Height -1 do begin
8096         Move(SourceData^, TempDestData^, fRowSize);
8097         Dec(TempDestData, fRowSize);
8098         Inc(SourceData, fRowSize);
8099       end;
8100       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8101       result := true;
8102     except
8103       if Assigned(DestData) then
8104         FreeMem(DestData);
8105       raise;
8106     end;
8107   end;
8108 end;
8109
8110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8111 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8113 type
8114   TMatrixItem = record
8115     X, Y: Integer;
8116     W: Single;
8117   end;
8118
8119   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8120   TglBitmapToNormalMapRec = Record
8121     Scale: Single;
8122     Heights: array of Single;
8123     MatrixU : array of TMatrixItem;
8124     MatrixV : array of TMatrixItem;
8125   end;
8126
8127 const
8128   ONE_OVER_255 = 1 / 255;
8129
8130   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8131 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8132 var
8133   Val: Single;
8134 begin
8135   with FuncRec do begin
8136     Val :=
8137       Source.Data.r * LUMINANCE_WEIGHT_R +
8138       Source.Data.g * LUMINANCE_WEIGHT_G +
8139       Source.Data.b * LUMINANCE_WEIGHT_B;
8140     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8141   end;
8142 end;
8143
8144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8145 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8146 begin
8147   with FuncRec do
8148     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8149 end;
8150
8151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8152 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8153 type
8154   TVec = Array[0..2] of Single;
8155 var
8156   Idx: Integer;
8157   du, dv: Double;
8158   Len: Single;
8159   Vec: TVec;
8160
8161   function GetHeight(X, Y: Integer): Single;
8162   begin
8163     with FuncRec do begin
8164       X := Max(0, Min(Size.X -1, X));
8165       Y := Max(0, Min(Size.Y -1, Y));
8166       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8167     end;
8168   end;
8169
8170 begin
8171   with FuncRec do begin
8172     with PglBitmapToNormalMapRec(Args)^ do begin
8173       du := 0;
8174       for Idx := Low(MatrixU) to High(MatrixU) do
8175         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8176
8177       dv := 0;
8178       for Idx := Low(MatrixU) to High(MatrixU) do
8179         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8180
8181       Vec[0] := -du * Scale;
8182       Vec[1] := -dv * Scale;
8183       Vec[2] := 1;
8184     end;
8185
8186     // Normalize
8187     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8188     if Len <> 0 then begin
8189       Vec[0] := Vec[0] * Len;
8190       Vec[1] := Vec[1] * Len;
8191       Vec[2] := Vec[2] * Len;
8192     end;
8193
8194     // Farbe zuweisem
8195     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8196     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8197     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8198   end;
8199 end;
8200
8201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8203 var
8204   Rec: TglBitmapToNormalMapRec;
8205
8206   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8207   begin
8208     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8209       Matrix[Index].X := X;
8210       Matrix[Index].Y := Y;
8211       Matrix[Index].W := W;
8212     end;
8213   end;
8214
8215 begin
8216   if TFormatDescriptor.Get(Format).IsCompressed then
8217     raise EglBitmapUnsupportedFormat.Create(Format);
8218
8219   if aScale > 100 then
8220     Rec.Scale := 100
8221   else if aScale < -100 then
8222     Rec.Scale := -100
8223   else
8224     Rec.Scale := aScale;
8225
8226   SetLength(Rec.Heights, Width * Height);
8227   try
8228     case aFunc of
8229       nm4Samples: begin
8230         SetLength(Rec.MatrixU, 2);
8231         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8232         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8233
8234         SetLength(Rec.MatrixV, 2);
8235         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8236         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8237       end;
8238
8239       nmSobel: begin
8240         SetLength(Rec.MatrixU, 6);
8241         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8242         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8243         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8244         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8245         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8246         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8247
8248         SetLength(Rec.MatrixV, 6);
8249         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8250         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8251         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8252         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8253         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8254         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8255       end;
8256
8257       nm3x3: begin
8258         SetLength(Rec.MatrixU, 6);
8259         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8260         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8261         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8262         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8263         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8264         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8265
8266         SetLength(Rec.MatrixV, 6);
8267         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8268         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8269         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8270         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8271         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8272         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8273       end;
8274
8275       nm5x5: begin
8276         SetLength(Rec.MatrixU, 20);
8277         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8278         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8279         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8280         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8281         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8282         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8283         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8284         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8285         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8286         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8287         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8288         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8289         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8290         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8291         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8292         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8293         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8294         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8295         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8296         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8297
8298         SetLength(Rec.MatrixV, 20);
8299         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8300         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8301         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8302         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8303         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8304         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8305         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8306         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8307         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8308         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8309         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8310         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8311         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8312         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8313         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8314         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8315         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8316         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8317         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8318         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8319       end;
8320     end;
8321
8322     // Daten Sammeln
8323     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8324       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8325     else
8326       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8327     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8328   finally
8329     SetLength(Rec.Heights, 0);
8330   end;
8331 end;
8332
8333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8334 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8336 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8337 begin
8338   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8339 end;
8340
8341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8342 procedure TglBitmapCubeMap.AfterConstruction;
8343 begin
8344   inherited;
8345
8346   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8347     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8348
8349   SetWrap;
8350   Target   := GL_TEXTURE_CUBE_MAP;
8351   fGenMode := GL_REFLECTION_MAP;
8352 end;
8353
8354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8355 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8356 var
8357   BuildWithGlu: Boolean;
8358   TexSize: Integer;
8359 begin
8360   if (aTestTextureSize) then begin
8361     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8362
8363     if (Height > TexSize) or (Width > TexSize) then
8364       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8365
8366     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8367       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8368   end;
8369
8370   if (ID = 0) then
8371     CreateID;
8372   SetupParameters(BuildWithGlu);
8373   UploadData(aCubeTarget, BuildWithGlu);
8374 end;
8375
8376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8377 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8378 begin
8379   inherited Bind (aEnableTextureUnit);
8380   if aEnableTexCoordsGen then begin
8381     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8382     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8383     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8384     glEnable(GL_TEXTURE_GEN_S);
8385     glEnable(GL_TEXTURE_GEN_T);
8386     glEnable(GL_TEXTURE_GEN_R);
8387   end;
8388 end;
8389
8390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8391 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8392 begin
8393   inherited Unbind(aDisableTextureUnit);
8394   if aDisableTexCoordsGen then begin
8395     glDisable(GL_TEXTURE_GEN_S);
8396     glDisable(GL_TEXTURE_GEN_T);
8397     glDisable(GL_TEXTURE_GEN_R);
8398   end;
8399 end;
8400
8401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8402 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8404 type
8405   TVec = Array[0..2] of Single;
8406   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8407
8408   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8409   TglBitmapNormalMapRec = record
8410     HalfSize : Integer;
8411     Func: TglBitmapNormalMapGetVectorFunc;
8412   end;
8413
8414   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8415 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8416 begin
8417   aVec[0] := aHalfSize;
8418   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8419   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8420 end;
8421
8422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8423 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8424 begin
8425   aVec[0] := - aHalfSize;
8426   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8427   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8428 end;
8429
8430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8431 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8432 begin
8433   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8434   aVec[1] := aHalfSize;
8435   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8436 end;
8437
8438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8439 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8440 begin
8441   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8442   aVec[1] := - aHalfSize;
8443   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8444 end;
8445
8446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8447 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8448 begin
8449   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8450   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8451   aVec[2] := aHalfSize;
8452 end;
8453
8454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8455 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8456 begin
8457   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8458   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8459   aVec[2] := - aHalfSize;
8460 end;
8461
8462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8463 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8464 var
8465   i: Integer;
8466   Vec: TVec;
8467   Len: Single;
8468 begin
8469   with FuncRec do begin
8470     with PglBitmapNormalMapRec(Args)^ do begin
8471       Func(Vec, Position, HalfSize);
8472
8473       // Normalize
8474       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8475       if Len <> 0 then begin
8476         Vec[0] := Vec[0] * Len;
8477         Vec[1] := Vec[1] * Len;
8478         Vec[2] := Vec[2] * Len;
8479       end;
8480
8481       // Scale Vector and AddVectro
8482       Vec[0] := Vec[0] * 0.5 + 0.5;
8483       Vec[1] := Vec[1] * 0.5 + 0.5;
8484       Vec[2] := Vec[2] * 0.5 + 0.5;
8485     end;
8486
8487     // Set Color
8488     for i := 0 to 2 do
8489       Dest.Data.arr[i] := Round(Vec[i] * 255);
8490   end;
8491 end;
8492
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 procedure TglBitmapNormalMap.AfterConstruction;
8495 begin
8496   inherited;
8497   fGenMode := GL_NORMAL_MAP;
8498 end;
8499
8500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8501 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8502 var
8503   Rec: TglBitmapNormalMapRec;
8504   SizeRec: TglBitmapPixelPosition;
8505 begin
8506   Rec.HalfSize := aSize div 2;
8507   FreeDataAfterGenTexture := false;
8508
8509   SizeRec.Fields := [ffX, ffY];
8510   SizeRec.X := aSize;
8511   SizeRec.Y := aSize;
8512
8513   // Positive X
8514   Rec.Func := glBitmapNormalMapPosX;
8515   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8516   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8517
8518   // Negative X
8519   Rec.Func := glBitmapNormalMapNegX;
8520   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8521   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8522
8523   // Positive Y
8524   Rec.Func := glBitmapNormalMapPosY;
8525   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8526   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8527
8528   // Negative Y
8529   Rec.Func := glBitmapNormalMapNegY;
8530   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8531   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8532
8533   // Positive Z
8534   Rec.Func := glBitmapNormalMapPosZ;
8535   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8536   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8537
8538   // Negative Z
8539   Rec.Func := glBitmapNormalMapNegZ;
8540   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8541   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8542 end;
8543
8544
8545 initialization
8546   glBitmapSetDefaultFormat (tfEmpty);
8547   glBitmapSetDefaultMipmap (mmMipmap);
8548   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8549   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8550   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8551
8552   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8553   glBitmapSetDefaultDeleteTextureOnFree    (true);
8554
8555   TFormatDescriptor.Init;
8556
8557 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8558   OpenGLInitialized := false;
8559   InitOpenGLCS := TCriticalSection.Create;
8560 {$ENDIF}
8561
8562 finalization
8563   TFormatDescriptor.Finalize;
8564
8565 {$IFDEF GLB_NATIVE_OGL}
8566   if Assigned(GL_LibHandle) then
8567     glbFreeLibrary(GL_LibHandle);
8568
8569 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8570   if Assigned(GLU_LibHandle) then
8571     glbFreeLibrary(GLU_LibHandle);
8572   FreeAndNil(InitOpenGLCS);
8573 {$ENDIF}
8574 {$ENDIF}
8575
8576 end.