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)} windows,                            {$IFEND}
 447
 448   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 449   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 450   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,                  {$ENDIF}
 451
 452   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 453   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 454   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 455   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 456   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 457
 458   Classes, SysUtils;
 459
 460 {$IFDEF GLB_NATIVE_OGL}
 461 const
 462   GL_TRUE   = 1;
 463   GL_FALSE  = 0;
 464
 465   GL_ZERO = 0;
 466   GL_ONE  = 1;
 467
 468   GL_VERSION    = $1F02;
 469   GL_EXTENSIONS = $1F03;
 470
 471   GL_TEXTURE_1D         = $0DE0;
 472   GL_TEXTURE_2D         = $0DE1;
 473   GL_TEXTURE_RECTANGLE  = $84F5;
 474
 475   GL_NORMAL_MAP                   = $8511;
 476   GL_TEXTURE_CUBE_MAP             = $8513;
 477   GL_REFLECTION_MAP               = $8512;
 478   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 479   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 480   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 481   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 482   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 483   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 484
 485   GL_TEXTURE_WIDTH            = $1000;
 486   GL_TEXTURE_HEIGHT           = $1001;
 487   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 488   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 489
 490   GL_S = $2000;
 491   GL_T = $2001;
 492   GL_R = $2002;
 493   GL_Q = $2003;
 494
 495   GL_TEXTURE_GEN_S = $0C60;
 496   GL_TEXTURE_GEN_T = $0C61;
 497   GL_TEXTURE_GEN_R = $0C62;
 498   GL_TEXTURE_GEN_Q = $0C63;
 499
 500   GL_RED    = $1903;
 501   GL_GREEN  = $1904;
 502   GL_BLUE   = $1905;
 503
 504   GL_ALPHA    = $1906;
 505   GL_ALPHA4   = $803B;
 506   GL_ALPHA8   = $803C;
 507   GL_ALPHA12  = $803D;
 508   GL_ALPHA16  = $803E;
 509
 510   GL_LUMINANCE    = $1909;
 511   GL_LUMINANCE4   = $803F;
 512   GL_LUMINANCE8   = $8040;
 513   GL_LUMINANCE12  = $8041;
 514   GL_LUMINANCE16  = $8042;
 515
 516   GL_LUMINANCE_ALPHA      = $190A;
 517   GL_LUMINANCE4_ALPHA4    = $8043;
 518   GL_LUMINANCE6_ALPHA2    = $8044;
 519   GL_LUMINANCE8_ALPHA8    = $8045;
 520   GL_LUMINANCE12_ALPHA4   = $8046;
 521   GL_LUMINANCE12_ALPHA12  = $8047;
 522   GL_LUMINANCE16_ALPHA16  = $8048;
 523
 524   GL_RGB      = $1907;
 525   GL_BGR      = $80E0;
 526   GL_R3_G3_B2 = $2A10;
 527   GL_RGB4     = $804F;
 528   GL_RGB5     = $8050;
 529   GL_RGB565   = $8D62;
 530   GL_RGB8     = $8051;
 531   GL_RGB10    = $8052;
 532   GL_RGB12    = $8053;
 533   GL_RGB16    = $8054;
 534
 535   GL_RGBA     = $1908;
 536   GL_BGRA     = $80E1;
 537   GL_RGBA2    = $8055;
 538   GL_RGBA4    = $8056;
 539   GL_RGB5_A1  = $8057;
 540   GL_RGBA8    = $8058;
 541   GL_RGB10_A2 = $8059;
 542   GL_RGBA12   = $805A;
 543   GL_RGBA16   = $805B;
 544
 545   GL_DEPTH_COMPONENT    = $1902;
 546   GL_DEPTH_COMPONENT16  = $81A5;
 547   GL_DEPTH_COMPONENT24  = $81A6;
 548   GL_DEPTH_COMPONENT32  = $81A7;
 549
 550   GL_COMPRESSED_RGB                 = $84ED;
 551   GL_COMPRESSED_RGBA                = $84EE;
 552   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 553   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 554   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 555   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 556
 557   GL_UNSIGNED_BYTE            = $1401;
 558   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 559   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 560
 561   GL_UNSIGNED_SHORT             = $1403;
 562   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 563   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 564   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 565   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 566   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 567   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 568
 569   GL_UNSIGNED_INT                 = $1405;
 570   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 571   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 572   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 573   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 574
 575   { Texture Filter }
 576   GL_TEXTURE_MAG_FILTER     = $2800;
 577   GL_TEXTURE_MIN_FILTER     = $2801;
 578   GL_NEAREST                = $2600;
 579   GL_NEAREST_MIPMAP_NEAREST = $2700;
 580   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 581   GL_LINEAR                 = $2601;
 582   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 583   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 584
 585   { Texture Wrap }
 586   GL_TEXTURE_WRAP_S   = $2802;
 587   GL_TEXTURE_WRAP_T   = $2803;
 588   GL_TEXTURE_WRAP_R   = $8072;
 589   GL_CLAMP            = $2900;
 590   GL_REPEAT           = $2901;
 591   GL_CLAMP_TO_EDGE    = $812F;
 592   GL_CLAMP_TO_BORDER  = $812D;
 593   GL_MIRRORED_REPEAT  = $8370;
 594
 595   { Other }
 596   GL_GENERATE_MIPMAP      = $8191;
 597   GL_TEXTURE_BORDER_COLOR = $1004;
 598   GL_MAX_TEXTURE_SIZE     = $0D33;
 599   GL_PACK_ALIGNMENT       = $0D05;
 600   GL_UNPACK_ALIGNMENT     = $0CF5;
 601
 602   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 603   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 604   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 605   GL_TEXTURE_GEN_MODE               = $2500;
 606
 607 {$IF DEFINED(GLB_WIN)}
 608   libglu    = 'glu32.dll';
 609   libopengl = 'opengl32.dll';
 610 {$ELSEIF DEFINED(GLB_LINUX)}
 611   libglu    = 'libGLU.so.1';
 612   libopengl = 'libGL.so.1';
 613 {$IFEND}
 614
 615 type
 616   GLboolean = BYTEBOOL;
 617   GLint     = Integer;
 618   GLsizei   = Integer;
 619   GLuint    = Cardinal;
 620   GLfloat   = Single;
 621   GLenum    = Cardinal;
 622
 623   PGLvoid    = Pointer;
 624   PGLboolean = ^GLboolean;
 625   PGLint     = ^GLint;
 626   PGLuint    = ^GLuint;
 627   PGLfloat   = ^GLfloat;
 628
 629   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 630   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}
 631   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632
 633 {$IF DEFINED(GLB_WIN)}
 634   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 635 {$ELSEIF DEFINED(GLB_LINUX)}
 636   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 637   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 638 {$IFEND}
 639
 640 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 641   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 642   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643
 644   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 645   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646
 647   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 648   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654
 655   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 656   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659
 660   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 661   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663
 664   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}
 665   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}
 666   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667
 668   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 669   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670
 671 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 672   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 673   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674
 675   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 676   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677
 678   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 679   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685
 686   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 687   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690
 691   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 692   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;
 693   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694
 695   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;
 696   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;
 697   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698
 699   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 700   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701 {$IFEND}
 702
 703 var
 704   GL_VERSION_1_2,
 705   GL_VERSION_1_3,
 706   GL_VERSION_1_4,
 707   GL_VERSION_2_0,
 708   GL_VERSION_3_3,
 709
 710   GL_SGIS_generate_mipmap,
 711
 712   GL_ARB_texture_border_clamp,
 713   GL_ARB_texture_mirrored_repeat,
 714   GL_ARB_texture_rectangle,
 715   GL_ARB_texture_non_power_of_two,
 716   GL_ARB_texture_swizzle,
 717   GL_ARB_texture_cube_map,
 718
 719   GL_IBM_texture_mirrored_repeat,
 720
 721   GL_NV_texture_rectangle,
 722
 723   GL_EXT_texture_edge_clamp,
 724   GL_EXT_texture_rectangle,
 725   GL_EXT_texture_swizzle,
 726   GL_EXT_texture_cube_map,
 727   GL_EXT_texture_filter_anisotropic: Boolean;
 728
 729   glCompressedTexImage1D: TglCompressedTexImage1D;
 730   glCompressedTexImage2D: TglCompressedTexImage2D;
 731   glGetCompressedTexImage: TglGetCompressedTexImage;
 732
 733 {$IF DEFINED(GLB_WIN)}
 734   wglGetProcAddress: TwglGetProcAddress;
 735 {$ELSEIF DEFINED(GLB_LINUX)}
 736   glXGetProcAddress: TglXGetProcAddress;
 737   glXGetProcAddressARB: TglXGetProcAddress;
 738 {$IFEND}
 739
 740 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 741   glEnable: TglEnable;
 742   glDisable: TglDisable;
 743
 744   glGetString: TglGetString;
 745   glGetIntegerv: TglGetIntegerv;
 746
 747   glTexParameteri: TglTexParameteri;
 748   glTexParameteriv: TglTexParameteriv;
 749   glTexParameterfv: TglTexParameterfv;
 750   glGetTexParameteriv: TglGetTexParameteriv;
 751   glGetTexParameterfv: TglGetTexParameterfv;
 752   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 753   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 754
 755   glTexGeni: TglTexGeni;
 756   glGenTextures: TglGenTextures;
 757   glBindTexture: TglBindTexture;
 758   glDeleteTextures: TglDeleteTextures;
 759
 760   glAreTexturesResident: TglAreTexturesResident;
 761   glReadPixels: TglReadPixels;
 762   glPixelStorei: TglPixelStorei;
 763
 764   glTexImage1D: TglTexImage1D;
 765   glTexImage2D: TglTexImage2D;
 766   glGetTexImage: TglGetTexImage;
 767
 768   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 769   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 770 {$ENDIF}
 771 {$ENDIF}
 772
 773 type
 774 ////////////////////////////////////////////////////////////////////////////////////////////////////
 775   TglBitmapFormat = (
 776     tfEmpty = 0, //must be smallest value!
 777
 778     tfAlpha4,
 779     tfAlpha8,
 780     tfAlpha12,
 781     tfAlpha16,
 782
 783     tfLuminance4,
 784     tfLuminance8,
 785     tfLuminance12,
 786     tfLuminance16,
 787
 788     tfLuminance4Alpha4,
 789     tfLuminance6Alpha2,
 790     tfLuminance8Alpha8,
 791     tfLuminance12Alpha4,
 792     tfLuminance12Alpha12,
 793     tfLuminance16Alpha16,
 794
 795     tfR3G3B2,
 796     tfRGB4,
 797     tfR5G6B5,
 798     tfRGB5,
 799     tfRGB8,
 800     tfRGB10,
 801     tfRGB12,
 802     tfRGB16,
 803
 804     tfRGBA2,
 805     tfRGBA4,
 806     tfRGB5A1,
 807     tfRGBA8,
 808     tfRGB10A2,
 809     tfRGBA12,
 810     tfRGBA16,
 811
 812     tfBGR4,
 813     tfB5G6R5,
 814     tfBGR5,
 815     tfBGR8,
 816     tfBGR10,
 817     tfBGR12,
 818     tfBGR16,
 819
 820     tfBGRA2,
 821     tfBGRA4,
 822     tfBGR5A1,
 823     tfBGRA8,
 824     tfBGR10A2,
 825     tfBGRA12,
 826     tfBGRA16,
 827
 828     tfDepth16,
 829     tfDepth24,
 830     tfDepth32,
 831
 832     tfS3tcDtx1RGBA,
 833     tfS3tcDtx3RGBA,
 834     tfS3tcDtx5RGBA
 835   );
 836
 837   TglBitmapFileType = (
 838      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 839      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 840      ftDDS,
 841      ftTGA,
 842      ftBMP);
 843    TglBitmapFileTypes = set of TglBitmapFileType;
 844
 845    TglBitmapMipMap = (
 846      mmNone,
 847      mmMipmap,
 848      mmMipmapGlu);
 849
 850    TglBitmapNormalMapFunc = (
 851      nm4Samples,
 852      nmSobel,
 853      nm3x3,
 854      nm5x5);
 855
 856  ////////////////////////////////////////////////////////////////////////////////////////////////////
 857    EglBitmap                  = class(Exception);
 858    EglBitmapNotSupported      = class(Exception);
 859    EglBitmapSizeToLarge       = class(EglBitmap);
 860    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 861    EglBitmapUnsupportedFormat = class(EglBitmap)
 862      constructor Create(const aFormat: TglBitmapFormat); overload;
 863      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 864    end;
 865
 866 ////////////////////////////////////////////////////////////////////////////////////////////////////
 867   TglBitmapColorRec = packed record
 868   case Integer of
 869     0: (r, g, b, a: Cardinal);
 870     1: (arr: array[0..3] of Cardinal);
 871   end;
 872
 873   TglBitmapPixelData = packed record
 874     Data, Range: TglBitmapColorRec;
 875     Format: TglBitmapFormat;
 876   end;
 877   PglBitmapPixelData = ^TglBitmapPixelData;
 878
 879 ////////////////////////////////////////////////////////////////////////////////////////////////////
 880   TglBitmapPixelPositionFields = set of (ffX, ffY);
 881   TglBitmapPixelPosition = record
 882     Fields : TglBitmapPixelPositionFields;
 883     X : Word;
 884     Y : Word;
 885   end;
 886
 887   TglBitmapFormatDescriptor = class(TObject)
 888   protected
 889     function GetIsCompressed: Boolean; virtual; abstract;
 890     function GetHasAlpha:     Boolean; virtual; abstract;
 891
 892     function GetglDataFormat:     GLenum;  virtual; abstract;
 893     function GetglFormat:         GLenum;  virtual; abstract;
 894     function GetglInternalFormat: GLenum;  virtual; abstract;
 895   public
 896     property IsCompressed: Boolean read GetIsCompressed;
 897     property HasAlpha:     Boolean read GetHasAlpha;
 898
 899     property glFormat:         GLenum  read GetglFormat;
 900     property glInternalFormat: GLenum  read GetglInternalFormat;
 901     property glDataFormat:     GLenum  read GetglDataFormat;
 902   end;
 903
 904 ////////////////////////////////////////////////////////////////////////////////////////////////////
 905   TglBitmap = class;
 906   TglBitmapFunctionRec = record
 907     Sender:   TglBitmap;
 908     Size:     TglBitmapPixelPosition;
 909     Position: TglBitmapPixelPosition;
 910     Source:   TglBitmapPixelData;
 911     Dest:     TglBitmapPixelData;
 912     Args:     Pointer;
 913   end;
 914   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 915
 916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 917   TglBitmap = class
 918   private
 919     function GetFormatDesc: TglBitmapFormatDescriptor;
 920   protected
 921     fID: GLuint;
 922     fTarget: GLuint;
 923     fAnisotropic: Integer;
 924     fDeleteTextureOnFree: Boolean;
 925     fFreeDataAfterGenTexture: Boolean;
 926     fData: PByte;
 927     fIsResident: Boolean;
 928     fBorderColor: array[0..3] of Single;
 929
 930     fDimension: TglBitmapPixelPosition;
 931     fMipMap: TglBitmapMipMap;
 932     fFormat: TglBitmapFormat;
 933
 934     // Mapping
 935     fPixelSize: Integer;
 936     fRowSize: Integer;
 937
 938     // Filtering
 939     fFilterMin: GLenum;
 940     fFilterMag: GLenum;
 941
 942     // TexturWarp
 943     fWrapS: GLenum;
 944     fWrapT: GLenum;
 945     fWrapR: GLenum;
 946
 947     //Swizzle
 948     fSwizzle: array[0..3] of GLenum;
 949
 950     // CustomData
 951     fFilename: String;
 952     fCustomName: String;
 953     fCustomNameW: WideString;
 954     fCustomData: Pointer;
 955
 956     //Getter
 957     function GetWidth:  Integer; virtual;
 958     function GetHeight: Integer; virtual;
 959
 960     function GetFileWidth:  Integer; virtual;
 961     function GetFileHeight: Integer; virtual;
 962
 963     //Setter
 964     procedure SetCustomData(const aValue: Pointer);
 965     procedure SetCustomName(const aValue: String);
 966     procedure SetCustomNameW(const aValue: WideString);
 967     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 968     procedure SetFormat(const aValue: TglBitmapFormat);
 969     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 970     procedure SetID(const aValue: Cardinal);
 971     procedure SetMipMap(const aValue: TglBitmapMipMap);
 972     procedure SetTarget(const aValue: Cardinal);
 973     procedure SetAnisotropic(const aValue: Integer);
 974
 975     procedure CreateID;
 976     procedure SetupParameters(out aBuildWithGlu: Boolean);
 977     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 978       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 979     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 980
 981     function FlipHorz: Boolean; virtual;
 982     function FlipVert: Boolean; virtual;
 983
 984     property Width:  Integer read GetWidth;
 985     property Height: Integer read GetHeight;
 986
 987     property FileWidth:  Integer read GetFileWidth;
 988     property FileHeight: Integer read GetFileHeight;
 989   public
 990     //Properties
 991     property ID:           Cardinal        read fID          write SetID;
 992     property Target:       Cardinal        read fTarget      write SetTarget;
 993     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 994     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 995     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 996
 997     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
 998
 999     property Filename:    String     read fFilename;
1000     property CustomName:  String     read fCustomName  write SetCustomName;
1001     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1002     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1003
1004     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1005     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1006
1007     property Dimension:  TglBitmapPixelPosition  read fDimension;
1008     property Data:       PByte                   read fData;
1009     property IsResident: Boolean                 read fIsResident;
1010
1011     procedure AfterConstruction; override;
1012     procedure BeforeDestruction; override;
1013
1014     procedure PrepareResType(var aResource: String; var aResType: PChar);
1015
1016     //Load
1017     procedure LoadFromFile(const aFilename: String);
1018     procedure LoadFromStream(const aStream: TStream); virtual;
1019     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1020       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1021     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1022     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1023
1024     //Save
1025     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1026     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1027
1028     //Convert
1029     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1030     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1031       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1032   public
1033     //Alpha & Co
1034     {$IFDEF GLB_SDL}
1035     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1036     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1037     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1038     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1039       const aArgs: Pointer = nil): Boolean;
1040     {$ENDIF}
1041
1042     {$IFDEF GLB_DELPHI}
1043     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1044     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1045     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1046     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1047       const aArgs: Pointer = nil): Boolean;
1048     {$ENDIF}
1049
1050     {$IFDEF GLB_LAZARUS}
1051     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1052     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1053     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1054     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1055       const aArgs: Pointer = nil): Boolean;
1056     {$ENDIF}
1057
1058     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1059       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1060     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1061       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1062
1063     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1064     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1065     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1066     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067
1068     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1069     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1070     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1071
1072     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1073     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1074     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1075
1076     function RemoveAlpha: Boolean; virtual;
1077   public
1078     //Common
1079     function Clone: TglBitmap;
1080     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1081     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1082     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1083     procedure FreeData;
1084
1085     //ColorFill
1086     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1087     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1088     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1089
1090     //TexParameters
1091     procedure SetFilter(const aMin, aMag: GLenum);
1092     procedure SetWrap(
1093       const S: GLenum = GL_CLAMP_TO_EDGE;
1094       const T: GLenum = GL_CLAMP_TO_EDGE;
1095       const R: GLenum = GL_CLAMP_TO_EDGE);
1096     procedure SetSwizzle(const r, g, b, a: GLenum);
1097
1098     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1099     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1100
1101     //Constructors
1102     constructor Create; overload;
1103     constructor Create(const aFileName: String); overload;
1104     constructor Create(const aStream: TStream); overload;
1105     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1106     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1107     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1108     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1109   private
1110     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1111     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1112
1113     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1114     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1115
1116     function LoadBMP(const aStream: TStream): Boolean; virtual;
1117     procedure SaveBMP(const aStream: TStream); virtual;
1118
1119     function LoadTGA(const aStream: TStream): Boolean; virtual;
1120     procedure SaveTGA(const aStream: TStream); virtual;
1121
1122     function LoadDDS(const aStream: TStream): Boolean; virtual;
1123     procedure SaveDDS(const aStream: TStream); virtual;
1124   end;
1125
1126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1127   TglBitmap1D = class(TglBitmap)
1128   protected
1129     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1130       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1131     procedure UploadData(const aBuildWithGlu: Boolean);
1132   public
1133     property Width;
1134     procedure AfterConstruction; override;
1135     function FlipHorz: Boolean; override;
1136     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1137   end;
1138
1139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1140   TglBitmap2D = class(TglBitmap)
1141   protected
1142     fLines: array of PByte;
1143     function GetScanline(const aIndex: Integer): Pointer;
1144     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1145       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1146     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1147   public
1148     property Width;
1149     property Height;
1150     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1151
1152     procedure AfterConstruction; override;
1153
1154     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1155     procedure GetDataFromTexture;
1156     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1157
1158     function FlipHorz: Boolean; override;
1159     function FlipVert: Boolean; override;
1160
1161     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1162       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1163   end;
1164
1165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1166   TglBitmapCubeMap = class(TglBitmap2D)
1167   protected
1168     fGenMode: Integer;
1169     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1170   public
1171     procedure AfterConstruction; override;
1172     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1173     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1174     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1175   end;
1176
1177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1178   TglBitmapNormalMap = class(TglBitmapCubeMap)
1179   public
1180     procedure AfterConstruction; override;
1181     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1182   end;
1183
1184 const
1185   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1186
1187 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1188 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1189 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1190 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1191 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1192 procedure glBitmapSetDefaultWrap(
1193   const S: Cardinal = GL_CLAMP_TO_EDGE;
1194   const T: Cardinal = GL_CLAMP_TO_EDGE;
1195   const R: Cardinal = GL_CLAMP_TO_EDGE);
1196
1197 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1198 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1199 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1200 function glBitmapGetDefaultFormat: TglBitmapFormat;
1201 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1202 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1203
1204 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1205 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1206 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1207
1208 var
1209   glBitmapDefaultDeleteTextureOnFree: Boolean;
1210   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1211   glBitmapDefaultFormat: TglBitmapFormat;
1212   glBitmapDefaultMipmap: TglBitmapMipMap;
1213   glBitmapDefaultFilterMin: Cardinal;
1214   glBitmapDefaultFilterMag: Cardinal;
1215   glBitmapDefaultWrapS: Cardinal;
1216   glBitmapDefaultWrapT: Cardinal;
1217   glBitmapDefaultWrapR: Cardinal;
1218   glDefaultSwizzle: array[0..3] of GLenum;
1219
1220 {$IFDEF GLB_DELPHI}
1221 function CreateGrayPalette: HPALETTE;
1222 {$ENDIF}
1223
1224 implementation
1225
1226 uses
1227   Math, syncobjs, typinfo;
1228
1229 type
1230 {$IFNDEF fpc}
1231   QWord   = System.UInt64;
1232   PQWord  = ^QWord;
1233
1234   PtrInt  = Longint;
1235   PtrUInt = DWord;
1236 {$ENDIF}
1237
1238 ////////////////////////////////////////////////////////////////////////////////////////////////////
1239   TShiftRec = packed record
1240   case Integer of
1241     0: (r, g, b, a: Byte);
1242     1: (arr: array[0..3] of Byte);
1243   end;
1244
1245   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1246   private
1247     function GetRedMask: QWord;
1248     function GetGreenMask: QWord;
1249     function GetBlueMask: QWord;
1250     function GetAlphaMask: QWord;
1251   protected
1252     fFormat: TglBitmapFormat;
1253     fWithAlpha: TglBitmapFormat;
1254     fWithoutAlpha: TglBitmapFormat;
1255     fRGBInverted: TglBitmapFormat;
1256     fUncompressed: TglBitmapFormat;
1257     fPixelSize: Single;
1258     fIsCompressed: Boolean;
1259
1260     fRange: TglBitmapColorRec;
1261     fShift: TShiftRec;
1262
1263     fglFormat:         GLenum;
1264     fglInternalFormat: GLenum;
1265     fglDataFormat:     GLenum;
1266
1267     function GetIsCompressed: Boolean; override;
1268     function GetHasAlpha: Boolean; override;
1269
1270     function GetglFormat: GLenum; override;
1271     function GetglInternalFormat: GLenum; override;
1272     function GetglDataFormat: GLenum; override;
1273
1274     function GetComponents: Integer; virtual;
1275   public
1276     property Format:       TglBitmapFormat read fFormat;
1277     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1278     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1279     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1280     property Components:   Integer         read GetComponents;
1281     property PixelSize:    Single          read fPixelSize;
1282
1283     property Range: TglBitmapColorRec read fRange;
1284     property Shift: TShiftRec         read fShift;
1285
1286     property RedMask:   QWord read GetRedMask;
1287     property GreenMask: QWord read GetGreenMask;
1288     property BlueMask:  QWord read GetBlueMask;
1289     property AlphaMask: QWord read GetAlphaMask;
1290
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1293
1294     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1295     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1296
1297     function CreateMappingData: Pointer; virtual;
1298     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1299
1300     function IsEmpty:  Boolean; virtual;
1301     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1302
1303     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1304
1305     constructor Create; virtual;
1306   public
1307     class procedure Init;
1308     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1309     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1310     class procedure Clear;
1311     class procedure Finalize;
1312   end;
1313   TFormatDescriptorClass = class of TFormatDescriptor;
1314
1315   TfdEmpty = class(TFormatDescriptor);
1316
1317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1318   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1319     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321     constructor Create; override;
1322   end;
1323
1324   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327     constructor Create; override;
1328   end;
1329
1330   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333     constructor Create; override;
1334   end;
1335
1336   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1337     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1338     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1339     constructor Create; override;
1340   end;
1341
1342   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1343     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1344     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1345     constructor Create; override;
1346   end;
1347
1348   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1349     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1350     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1351     constructor Create; override;
1352   end;
1353
1354   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357     constructor Create; override;
1358   end;
1359
1360   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363     constructor Create; override;
1364   end;
1365
1366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1367   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370     constructor Create; override;
1371   end;
1372
1373   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376     constructor Create; override;
1377   end;
1378
1379   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382     constructor Create; override;
1383   end;
1384
1385   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388     constructor Create; override;
1389   end;
1390
1391   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394     constructor Create; override;
1395   end;
1396
1397   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400     constructor Create; override;
1401   end;
1402
1403   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1404     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1405     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1406     constructor Create; override;
1407   end;
1408
1409   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1410     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1411     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1412     constructor Create; override;
1413   end;
1414
1415   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1416     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1417     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1418     constructor Create; override;
1419   end;
1420
1421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1422   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425     constructor Create; override;
1426   end;
1427
1428   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431     constructor Create; override;
1432   end;
1433
1434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1435   TfdAlpha4 = class(TfdAlpha_UB1)
1436     constructor Create; override;
1437   end;
1438
1439   TfdAlpha8 = class(TfdAlpha_UB1)
1440     constructor Create; override;
1441   end;
1442
1443   TfdAlpha12 = class(TfdAlpha_US1)
1444     constructor Create; override;
1445   end;
1446
1447   TfdAlpha16 = class(TfdAlpha_US1)
1448     constructor Create; override;
1449   end;
1450
1451   TfdLuminance4 = class(TfdLuminance_UB1)
1452     constructor Create; override;
1453   end;
1454
1455   TfdLuminance8 = class(TfdLuminance_UB1)
1456     constructor Create; override;
1457   end;
1458
1459   TfdLuminance12 = class(TfdLuminance_US1)
1460     constructor Create; override;
1461   end;
1462
1463   TfdLuminance16 = class(TfdLuminance_US1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1468     constructor Create; override;
1469   end;
1470
1471   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1472     constructor Create; override;
1473   end;
1474
1475   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1476     constructor Create; override;
1477   end;
1478
1479   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1480     constructor Create; override;
1481   end;
1482
1483   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1484     constructor Create; override;
1485   end;
1486
1487   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1488     constructor Create; override;
1489   end;
1490
1491   TfdR3G3B2 = class(TfdUniversal_UB1)
1492     constructor Create; override;
1493   end;
1494
1495   TfdRGB4 = class(TfdUniversal_US1)
1496     constructor Create; override;
1497   end;
1498
1499   TfdR5G6B5 = class(TfdUniversal_US1)
1500     constructor Create; override;
1501   end;
1502
1503   TfdRGB5 = class(TfdUniversal_US1)
1504     constructor Create; override;
1505   end;
1506
1507   TfdRGB8 = class(TfdRGB_UB3)
1508     constructor Create; override;
1509   end;
1510
1511   TfdRGB10 = class(TfdUniversal_UI1)
1512     constructor Create; override;
1513   end;
1514
1515   TfdRGB12 = class(TfdRGB_US3)
1516     constructor Create; override;
1517   end;
1518
1519   TfdRGB16 = class(TfdRGB_US3)
1520     constructor Create; override;
1521   end;
1522
1523   TfdRGBA2 = class(TfdRGBA_UB4)
1524     constructor Create; override;
1525   end;
1526
1527   TfdRGBA4 = class(TfdUniversal_US1)
1528     constructor Create; override;
1529   end;
1530
1531   TfdRGB5A1 = class(TfdUniversal_US1)
1532     constructor Create; override;
1533   end;
1534
1535   TfdRGBA8 = class(TfdRGBA_UB4)
1536     constructor Create; override;
1537   end;
1538
1539   TfdRGB10A2 = class(TfdUniversal_UI1)
1540     constructor Create; override;
1541   end;
1542
1543   TfdRGBA12 = class(TfdRGBA_US4)
1544     constructor Create; override;
1545   end;
1546
1547   TfdRGBA16 = class(TfdRGBA_US4)
1548     constructor Create; override;
1549   end;
1550
1551   TfdBGR4 = class(TfdUniversal_US1)
1552     constructor Create; override;
1553   end;
1554
1555   TfdB5G6R5 = class(TfdUniversal_US1)
1556     constructor Create; override;
1557   end;
1558
1559   TfdBGR5 = class(TfdUniversal_US1)
1560     constructor Create; override;
1561   end;
1562
1563   TfdBGR8 = class(TfdBGR_UB3)
1564     constructor Create; override;
1565   end;
1566
1567   TfdBGR10 = class(TfdUniversal_UI1)
1568     constructor Create; override;
1569   end;
1570
1571   TfdBGR12 = class(TfdBGR_US3)
1572     constructor Create; override;
1573   end;
1574
1575   TfdBGR16 = class(TfdBGR_US3)
1576     constructor Create; override;
1577   end;
1578
1579   TfdBGRA2 = class(TfdBGRA_UB4)
1580     constructor Create; override;
1581   end;
1582
1583   TfdBGRA4 = class(TfdUniversal_US1)
1584     constructor Create; override;
1585   end;
1586
1587   TfdBGR5A1 = class(TfdUniversal_US1)
1588     constructor Create; override;
1589   end;
1590
1591   TfdBGRA8 = class(TfdBGRA_UB4)
1592     constructor Create; override;
1593   end;
1594
1595   TfdBGR10A2 = class(TfdUniversal_UI1)
1596     constructor Create; override;
1597   end;
1598
1599   TfdBGRA12 = class(TfdBGRA_US4)
1600     constructor Create; override;
1601   end;
1602
1603   TfdBGRA16 = class(TfdBGRA_US4)
1604     constructor Create; override;
1605   end;
1606
1607   TfdDepth16 = class(TfdDepth_US1)
1608     constructor Create; override;
1609   end;
1610
1611   TfdDepth24 = class(TfdDepth_UI1)
1612     constructor Create; override;
1613   end;
1614
1615   TfdDepth32 = class(TfdDepth_UI1)
1616     constructor Create; override;
1617   end;
1618
1619   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1620     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1621     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1622     constructor Create; override;
1623   end;
1624
1625   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1626     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1627     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1628     constructor Create; override;
1629   end;
1630
1631   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1632     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1633     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1634     constructor Create; override;
1635   end;
1636
1637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1638   TbmpBitfieldFormat = class(TFormatDescriptor)
1639   private
1640     procedure SetRedMask  (const aValue: QWord);
1641     procedure SetGreenMask(const aValue: QWord);
1642     procedure SetBlueMask (const aValue: QWord);
1643     procedure SetAlphaMask(const aValue: QWord);
1644
1645     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1646   public
1647     property RedMask:   QWord read GetRedMask   write SetRedMask;
1648     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1649     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1650     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1651
1652     property PixelSize: Single read fPixelSize write fPixelSize;
1653
1654     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1655     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1656   end;
1657
1658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1659   TbmpColorTableEnty = packed record
1660     b, g, r, a: Byte;
1661   end;
1662   TbmpColorTable = array of TbmpColorTableEnty;
1663   TbmpColorTableFormat = class(TFormatDescriptor)
1664   private
1665     fColorTable: TbmpColorTable;
1666   public
1667     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1668     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1669     property Range:      TglBitmapColorRec read fRange      write fRange;
1670     property Shift:      TShiftRec         read fShift      write fShift;
1671     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1672
1673     procedure CreateColorTable;
1674
1675     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1676     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1677     destructor Destroy; override;
1678   end;
1679
1680 const
1681   LUMINANCE_WEIGHT_R = 0.30;
1682   LUMINANCE_WEIGHT_G = 0.59;
1683   LUMINANCE_WEIGHT_B = 0.11;
1684
1685   ALPHA_WEIGHT_R = 0.30;
1686   ALPHA_WEIGHT_G = 0.59;
1687   ALPHA_WEIGHT_B = 0.11;
1688
1689   DEPTH_WEIGHT_R = 0.333333333;
1690   DEPTH_WEIGHT_G = 0.333333333;
1691   DEPTH_WEIGHT_B = 0.333333333;
1692
1693   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1694
1695   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1696     TfdEmpty,
1697
1698     TfdAlpha4,
1699     TfdAlpha8,
1700     TfdAlpha12,
1701     TfdAlpha16,
1702
1703     TfdLuminance4,
1704     TfdLuminance8,
1705     TfdLuminance12,
1706     TfdLuminance16,
1707
1708     TfdLuminance4Alpha4,
1709     TfdLuminance6Alpha2,
1710     TfdLuminance8Alpha8,
1711     TfdLuminance12Alpha4,
1712     TfdLuminance12Alpha12,
1713     TfdLuminance16Alpha16,
1714
1715     TfdR3G3B2,
1716     TfdRGB4,
1717     TfdR5G6B5,
1718     TfdRGB5,
1719     TfdRGB8,
1720     TfdRGB10,
1721     TfdRGB12,
1722     TfdRGB16,
1723
1724     TfdRGBA2,
1725     TfdRGBA4,
1726     TfdRGB5A1,
1727     TfdRGBA8,
1728     TfdRGB10A2,
1729     TfdRGBA12,
1730     TfdRGBA16,
1731
1732     TfdBGR4,
1733     TfdB5G6R5,
1734     TfdBGR5,
1735     TfdBGR8,
1736     TfdBGR10,
1737     TfdBGR12,
1738     TfdBGR16,
1739
1740     TfdBGRA2,
1741     TfdBGRA4,
1742     TfdBGR5A1,
1743     TfdBGRA8,
1744     TfdBGR10A2,
1745     TfdBGRA12,
1746     TfdBGRA16,
1747
1748     TfdDepth16,
1749     TfdDepth24,
1750     TfdDepth32,
1751
1752     TfdS3tcDtx1RGBA,
1753     TfdS3tcDtx3RGBA,
1754     TfdS3tcDtx5RGBA
1755   );
1756
1757 var
1758   FormatDescriptorCS: TCriticalSection;
1759   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1760
1761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1762 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1763 begin
1764   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1765 end;
1766
1767 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1768 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1769 begin
1770   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1771 end;
1772
1773 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1775 begin
1776   result.Fields := [];
1777
1778   if X >= 0 then
1779     result.Fields := result.Fields + [ffX];
1780   if Y >= 0 then
1781     result.Fields := result.Fields + [ffY];
1782
1783   result.X := Max(0, X);
1784   result.Y := Max(0, Y);
1785 end;
1786
1787 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1788 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1789 begin
1790   result.r := r;
1791   result.g := g;
1792   result.b := b;
1793   result.a := a;
1794 end;
1795
1796 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1797 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1798 var
1799   i: Integer;
1800 begin
1801   result := false;
1802   for i := 0 to high(r1.arr) do
1803     if (r1.arr[i] <> r2.arr[i]) then
1804       exit;
1805   result := true;
1806 end;
1807
1808 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1809 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1810 begin
1811   result.r := r;
1812   result.g := g;
1813   result.b := b;
1814   result.a := a;
1815 end;
1816
1817 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1818 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1819 begin
1820   result := [];
1821
1822   if (aFormat in [
1823         //4 bbp
1824         tfLuminance4,
1825
1826         //8bpp
1827         tfR3G3B2, tfLuminance8,
1828
1829         //16bpp
1830         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1831         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1832
1833         //24bpp
1834         tfBGR8, tfRGB8,
1835
1836         //32bpp
1837         tfRGB10, tfRGB10A2, tfRGBA8,
1838         tfBGR10, tfBGR10A2, tfBGRA8]) then
1839     result := result + [ftBMP];
1840
1841   if (aFormat in [
1842         //8 bpp
1843         tfLuminance8, tfAlpha8,
1844
1845         //16 bpp
1846         tfLuminance16, tfLuminance8Alpha8,
1847         tfRGB5, tfRGB5A1, tfRGBA4,
1848         tfBGR5, tfBGR5A1, tfBGRA4,
1849
1850         //24 bpp
1851         tfRGB8, tfBGR8,
1852
1853         //32 bpp
1854         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1855     result := result + [ftTGA];
1856
1857   if (aFormat in [
1858         //8 bpp
1859         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1860         tfR3G3B2, tfRGBA2, tfBGRA2,
1861
1862         //16 bpp
1863         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1864         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1865         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1866
1867         //24 bpp
1868         tfRGB8, tfBGR8,
1869
1870         //32 bbp
1871         tfLuminance16Alpha16,
1872         tfRGBA8, tfRGB10A2,
1873         tfBGRA8, tfBGR10A2,
1874
1875         //compressed
1876         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1877     result := result + [ftDDS];
1878
1879   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1880   if aFormat in [
1881       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1882       tfRGB8, tfRGBA8,
1883       tfBGR8, tfBGRA8] then
1884     result := result + [ftPNG];
1885   {$ENDIF}
1886
1887   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1888   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1889     result := result + [ftJPEG];
1890   {$ENDIF}
1891 end;
1892
1893 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1894 function IsPowerOfTwo(aNumber: Integer): Boolean;
1895 begin
1896   while (aNumber and 1) = 0 do
1897     aNumber := aNumber shr 1;
1898   result := aNumber = 1;
1899 end;
1900
1901 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1902 function GetTopMostBit(aBitSet: QWord): Integer;
1903 begin
1904   result := 0;
1905   while aBitSet > 0 do begin
1906     inc(result);
1907     aBitSet := aBitSet shr 1;
1908   end;
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function CountSetBits(aBitSet: QWord): Integer;
1913 begin
1914   result := 0;
1915   while aBitSet > 0 do begin
1916     if (aBitSet and 1) = 1 then
1917       inc(result);
1918     aBitSet := aBitSet shr 1;
1919   end;
1920 end;
1921
1922 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1923 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1924 begin
1925   result := Trunc(
1926     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1927     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1928     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1929 end;
1930
1931 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1932 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1933 begin
1934   result := Trunc(
1935     DEPTH_WEIGHT_R * aPixel.Data.r +
1936     DEPTH_WEIGHT_G * aPixel.Data.g +
1937     DEPTH_WEIGHT_B * aPixel.Data.b);
1938 end;
1939
1940 {$IFDEF GLB_NATIVE_OGL}
1941 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1942 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1943 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1944 var
1945   GL_LibHandle: Pointer = nil;
1946
1947 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1948 begin
1949   if not Assigned(aLibHandle) then
1950     aLibHandle := GL_LibHandle;
1951
1952 {$IF DEFINED(GLB_WIN)}
1953   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1954   if Assigned(result) then
1955     exit;
1956
1957   if Assigned(wglGetProcAddress) then
1958     result := wglGetProcAddress(aProcName);
1959 {$ELSEIF DEFINED(GLB_LINUX)}
1960   if Assigned(glXGetProcAddress) then begin
1961     result := glXGetProcAddress(aProcName);
1962     if Assigned(result) then
1963       exit;
1964   end;
1965
1966   if Assigned(glXGetProcAddressARB) then begin
1967     result := glXGetProcAddressARB(aProcName);
1968     if Assigned(result) then
1969       exit;
1970   end;
1971
1972   result := dlsym(aLibHandle, aProcName);
1973 {$IFEND}
1974   if not Assigned(result) and aRaiseOnErr then
1975     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1976 end;
1977
1978 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1979 var
1980   GLU_LibHandle: Pointer = nil;
1981   OpenGLInitialized: Boolean;
1982   InitOpenGLCS: TCriticalSection;
1983
1984 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1985 procedure glbInitOpenGL;
1986
1987   ////////////////////////////////////////////////////////////////////////////////
1988   function glbLoadLibrary(const aName: PChar): Pointer;
1989   begin
1990     {$IF DEFINED(GLB_WIN)}
1991     result := {%H-}Pointer(LoadLibrary(aName));
1992     {$ELSEIF DEFINED(GLB_LINUX)}
1993     result := dlopen(Name, RTLD_LAZY);
1994     {$ELSE}
1995     result := nil;
1996     {$IFEND}
1997   end;
1998
1999   ////////////////////////////////////////////////////////////////////////////////
2000   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2001   begin
2002     result := false;
2003     if not Assigned(aLibHandle) then
2004       exit;
2005
2006     {$IF DEFINED(GLB_WIN)}
2007     Result := FreeLibrary({%H-}HINST(aLibHandle));
2008     {$ELSEIF DEFINED(GLB_LINUX)}
2009     Result := dlclose(aLibHandle) = 0;
2010     {$IFEND}
2011   end;
2012
2013 begin
2014   if Assigned(GL_LibHandle) then
2015     glbFreeLibrary(GL_LibHandle);
2016
2017   if Assigned(GLU_LibHandle) then
2018     glbFreeLibrary(GLU_LibHandle);
2019
2020   GL_LibHandle := glbLoadLibrary(libopengl);
2021   if not Assigned(GL_LibHandle) then
2022     raise EglBitmap.Create('unable to load library: ' + libopengl);
2023
2024   GLU_LibHandle := glbLoadLibrary(libglu);
2025   if not Assigned(GLU_LibHandle) then
2026     raise EglBitmap.Create('unable to load library: ' + libglu);
2027
2028 {$IF DEFINED(GLB_WIN)}
2029   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2030 {$ELSEIF DEFINED(GLB_LINUX)}
2031   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2032   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2033 {$IFEND}
2034
2035   glEnable := glbGetProcAddress('glEnable');
2036   glDisable := glbGetProcAddress('glDisable');
2037   glGetString := glbGetProcAddress('glGetString');
2038   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2039   glTexParameteri := glbGetProcAddress('glTexParameteri');
2040   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2041   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2042   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2043   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2044   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2045   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2046   glTexGeni := glbGetProcAddress('glTexGeni');
2047   glGenTextures := glbGetProcAddress('glGenTextures');
2048   glBindTexture := glbGetProcAddress('glBindTexture');
2049   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2050   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2051   glReadPixels := glbGetProcAddress('glReadPixels');
2052   glPixelStorei := glbGetProcAddress('glPixelStorei');
2053   glTexImage1D := glbGetProcAddress('glTexImage1D');
2054   glTexImage2D := glbGetProcAddress('glTexImage2D');
2055   glGetTexImage := glbGetProcAddress('glGetTexImage');
2056
2057   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2058   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2059 end;
2060 {$ENDIF}
2061
2062 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2063 procedure glbReadOpenGLExtensions;
2064 var
2065   Buffer: AnsiString;
2066   MajorVersion, MinorVersion: Integer;
2067
2068   ///////////////////////////////////////////////////////////////////////////////////////////
2069   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2070   var
2071     Separator: Integer;
2072   begin
2073     aMinor := 0;
2074     aMajor := 0;
2075
2076     Separator := Pos(AnsiString('.'), aBuffer);
2077     if (Separator > 1) and (Separator < Length(aBuffer)) and
2078        (aBuffer[Separator - 1] in ['0'..'9']) and
2079        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2080
2081       Dec(Separator);
2082       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2083         Dec(Separator);
2084
2085       Delete(aBuffer, 1, Separator);
2086       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2087
2088       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2089         Inc(Separator);
2090
2091       Delete(aBuffer, Separator, 255);
2092       Separator := Pos(AnsiString('.'), aBuffer);
2093
2094       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2095       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2096     end;
2097   end;
2098
2099   ///////////////////////////////////////////////////////////////////////////////////////////
2100   function CheckExtension(const Extension: AnsiString): Boolean;
2101   var
2102     ExtPos: Integer;
2103   begin
2104     ExtPos := Pos(Extension, Buffer);
2105     result := ExtPos > 0;
2106     if result then
2107       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2108   end;
2109
2110   ///////////////////////////////////////////////////////////////////////////////////////////
2111   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2112   begin
2113     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2114   end;
2115
2116 begin
2117 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2118   InitOpenGLCS.Enter;
2119   try
2120     if not OpenGLInitialized then begin
2121       glbInitOpenGL;
2122       OpenGLInitialized := true;
2123     end;
2124   finally
2125     InitOpenGLCS.Leave;
2126   end;
2127 {$ENDIF}
2128
2129   // Version
2130   Buffer := glGetString(GL_VERSION);
2131   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2132
2133   GL_VERSION_1_2 := CheckVersion(1, 2);
2134   GL_VERSION_1_3 := CheckVersion(1, 3);
2135   GL_VERSION_1_4 := CheckVersion(1, 4);
2136   GL_VERSION_2_0 := CheckVersion(2, 0);
2137   GL_VERSION_3_3 := CheckVersion(3, 3);
2138
2139   // Extensions
2140   Buffer := glGetString(GL_EXTENSIONS);
2141   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2142   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2143   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2144   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2145   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2146   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2147   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2148   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2149   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2150   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2151   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2152   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2153   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2154   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2155
2156   if GL_VERSION_1_3 then begin
2157     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2158     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2159     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2160   end else begin
2161     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2162     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2163     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2164   end;
2165 end;
2166 {$ENDIF}
2167
2168 {$IFDEF GLB_SDL_IMAGE}
2169 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2171 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2173 begin
2174   result := TStream(context^.unknown.data1).Seek(offset, whence);
2175 end;
2176
2177 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2178 begin
2179   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2180 end;
2181
2182 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2183 begin
2184   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2185 end;
2186
2187 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2188 begin
2189   result := 0;
2190 end;
2191
2192 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2193 begin
2194   result := SDL_AllocRW;
2195
2196   if result = nil then
2197     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2198
2199   result^.seek := glBitmapRWseek;
2200   result^.read := glBitmapRWread;
2201   result^.write := glBitmapRWwrite;
2202   result^.close := glBitmapRWclose;
2203   result^.unknown.data1 := Stream;
2204 end;
2205 {$ENDIF}
2206
2207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2209 begin
2210   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2211 end;
2212
2213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2214 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2215 begin
2216   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2217 end;
2218
2219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2221 begin
2222   glBitmapDefaultMipmap := aValue;
2223 end;
2224
2225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2226 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2227 begin
2228   glBitmapDefaultFormat := aFormat;
2229 end;
2230
2231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2232 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2233 begin
2234   glBitmapDefaultFilterMin := aMin;
2235   glBitmapDefaultFilterMag := aMag;
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2240 begin
2241   glBitmapDefaultWrapS := S;
2242   glBitmapDefaultWrapT := T;
2243   glBitmapDefaultWrapR := R;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2248 begin
2249   glDefaultSwizzle[0] := r;
2250   glDefaultSwizzle[1] := g;
2251   glDefaultSwizzle[2] := b;
2252   glDefaultSwizzle[3] := a;
2253 end;
2254
2255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2257 begin
2258   result := glBitmapDefaultDeleteTextureOnFree;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2263 begin
2264   result := glBitmapDefaultFreeDataAfterGenTextures;
2265 end;
2266
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2269 begin
2270   result := glBitmapDefaultMipmap;
2271 end;
2272
2273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2274 function glBitmapGetDefaultFormat: TglBitmapFormat;
2275 begin
2276   result := glBitmapDefaultFormat;
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2281 begin
2282   aMin := glBitmapDefaultFilterMin;
2283   aMag := glBitmapDefaultFilterMag;
2284 end;
2285
2286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2287 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2288 begin
2289   S := glBitmapDefaultWrapS;
2290   T := glBitmapDefaultWrapT;
2291   R := glBitmapDefaultWrapR;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2296 begin
2297   r := glDefaultSwizzle[0];
2298   g := glDefaultSwizzle[1];
2299   b := glDefaultSwizzle[2];
2300   a := glDefaultSwizzle[3];
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 function TFormatDescriptor.GetRedMask: QWord;
2307 begin
2308   result := fRange.r shl fShift.r;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 function TFormatDescriptor.GetGreenMask: QWord;
2313 begin
2314   result := fRange.g shl fShift.g;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function TFormatDescriptor.GetBlueMask: QWord;
2319 begin
2320   result := fRange.b shl fShift.b;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function TFormatDescriptor.GetAlphaMask: QWord;
2325 begin
2326   result := fRange.a shl fShift.a;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function TFormatDescriptor.GetIsCompressed: Boolean;
2331 begin
2332   result := fIsCompressed;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function TFormatDescriptor.GetHasAlpha: Boolean;
2337 begin
2338   result := (fRange.a > 0);
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 function TFormatDescriptor.GetglFormat: GLenum;
2343 begin
2344   result := fglFormat;
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 function TFormatDescriptor.GetglInternalFormat: GLenum;
2349 begin
2350   result := fglInternalFormat;
2351 end;
2352
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 function TFormatDescriptor.GetglDataFormat: GLenum;
2355 begin
2356   result := fglDataFormat;
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 function TFormatDescriptor.GetComponents: Integer;
2361 var
2362   i: Integer;
2363 begin
2364   result := 0;
2365   for i := 0 to 3 do
2366     if (fRange.arr[i] > 0) then
2367       inc(result);
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2372 var
2373   w, h: Integer;
2374 begin
2375   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2376     w := Max(1, aSize.X);
2377     h := Max(1, aSize.Y);
2378     result := GetSize(w, h);
2379   end else
2380     result := 0;
2381 end;
2382
2383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2384 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2385 begin
2386   result := 0;
2387   if (aWidth <= 0) or (aHeight <= 0) then
2388     exit;
2389   result := Ceil(aWidth * aHeight * fPixelSize);
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 function TFormatDescriptor.CreateMappingData: Pointer;
2394 begin
2395   result := nil;
2396 end;
2397
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2400 begin
2401   //DUMMY
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 function TFormatDescriptor.IsEmpty: Boolean;
2406 begin
2407   result := (fFormat = tfEmpty);
2408 end;
2409
2410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2411 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2412 begin
2413   result := false;
2414   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2415     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2416   if (aRedMask   <> RedMask) then
2417     exit;
2418   if (aGreenMask <> GreenMask) then
2419     exit;
2420   if (aBlueMask  <> BlueMask) then
2421     exit;
2422   if (aAlphaMask <> AlphaMask) then
2423     exit;
2424   result := true;
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2429 begin
2430   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2431   aPixel.Data   := fRange;
2432   aPixel.Range  := fRange;
2433   aPixel.Format := fFormat;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 constructor TFormatDescriptor.Create;
2438 begin
2439   inherited Create;
2440
2441   fFormat       := tfEmpty;
2442   fWithAlpha    := tfEmpty;
2443   fWithoutAlpha := tfEmpty;
2444   fRGBInverted  := tfEmpty;
2445   fUncompressed := tfEmpty;
2446   fPixelSize    := 0.0;
2447   fIsCompressed := false;
2448
2449   fglFormat         := 0;
2450   fglInternalFormat := 0;
2451   fglDataFormat     := 0;
2452
2453   FillChar(fRange, 0, SizeOf(fRange));
2454   FillChar(fShift, 0, SizeOf(fShift));
2455 end;
2456
2457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2458 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2461 begin
2462   aData^ := aPixel.Data.a;
2463   inc(aData);
2464 end;
2465
2466 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2467 begin
2468   aPixel.Data.r := 0;
2469   aPixel.Data.g := 0;
2470   aPixel.Data.b := 0;
2471   aPixel.Data.a := aData^;
2472   inc(aData);
2473 end;
2474
2475 constructor TfdAlpha_UB1.Create;
2476 begin
2477   inherited Create;
2478   fPixelSize        := 1.0;
2479   fRange.a          := $FF;
2480   fglFormat         := GL_ALPHA;
2481   fglDataFormat     := GL_UNSIGNED_BYTE;
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2487 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2488 begin
2489   aData^ := LuminanceWeight(aPixel);
2490   inc(aData);
2491 end;
2492
2493 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2494 begin
2495   aPixel.Data.r := aData^;
2496   aPixel.Data.g := aData^;
2497   aPixel.Data.b := aData^;
2498   aPixel.Data.a := 0;
2499   inc(aData);
2500 end;
2501
2502 constructor TfdLuminance_UB1.Create;
2503 begin
2504   inherited Create;
2505   fPixelSize        := 1.0;
2506   fRange.r          := $FF;
2507   fRange.g          := $FF;
2508   fRange.b          := $FF;
2509   fglFormat         := GL_LUMINANCE;
2510   fglDataFormat     := GL_UNSIGNED_BYTE;
2511 end;
2512
2513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2514 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2517 var
2518   i: Integer;
2519 begin
2520   aData^ := 0;
2521   for i := 0 to 3 do
2522     if (fRange.arr[i] > 0) then
2523       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2524   inc(aData);
2525 end;
2526
2527 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2528 var
2529   i: Integer;
2530 begin
2531   for i := 0 to 3 do
2532     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2533   inc(aData);
2534 end;
2535
2536 constructor TfdUniversal_UB1.Create;
2537 begin
2538   inherited Create;
2539   fPixelSize := 1.0;
2540 end;
2541
2542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2546 begin
2547   inherited Map(aPixel, aData, aMapData);
2548   aData^ := aPixel.Data.a;
2549   inc(aData);
2550 end;
2551
2552 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2553 begin
2554   inherited Unmap(aData, aPixel, aMapData);
2555   aPixel.Data.a := aData^;
2556   inc(aData);
2557 end;
2558
2559 constructor TfdLuminanceAlpha_UB2.Create;
2560 begin
2561   inherited Create;
2562   fPixelSize        := 2.0;
2563   fRange.a          := $FF;
2564   fShift.a          :=   8;
2565   fglFormat         := GL_LUMINANCE_ALPHA;
2566   fglDataFormat     := GL_UNSIGNED_BYTE;
2567 end;
2568
2569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2573 begin
2574   aData^ := aPixel.Data.r;
2575   inc(aData);
2576   aData^ := aPixel.Data.g;
2577   inc(aData);
2578   aData^ := aPixel.Data.b;
2579   inc(aData);
2580 end;
2581
2582 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2583 begin
2584   aPixel.Data.r := aData^;
2585   inc(aData);
2586   aPixel.Data.g := aData^;
2587   inc(aData);
2588   aPixel.Data.b := aData^;
2589   inc(aData);
2590   aPixel.Data.a := 0;
2591 end;
2592
2593 constructor TfdRGB_UB3.Create;
2594 begin
2595   inherited Create;
2596   fPixelSize        := 3.0;
2597   fRange.r          := $FF;
2598   fRange.g          := $FF;
2599   fRange.b          := $FF;
2600   fShift.r          :=   0;
2601   fShift.g          :=   8;
2602   fShift.b          :=  16;
2603   fglFormat         := GL_RGB;
2604   fglDataFormat     := GL_UNSIGNED_BYTE;
2605 end;
2606
2607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2608 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2611 begin
2612   aData^ := aPixel.Data.b;
2613   inc(aData);
2614   aData^ := aPixel.Data.g;
2615   inc(aData);
2616   aData^ := aPixel.Data.r;
2617   inc(aData);
2618 end;
2619
2620 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2621 begin
2622   aPixel.Data.b := aData^;
2623   inc(aData);
2624   aPixel.Data.g := aData^;
2625   inc(aData);
2626   aPixel.Data.r := aData^;
2627   inc(aData);
2628   aPixel.Data.a := 0;
2629 end;
2630
2631 constructor TfdBGR_UB3.Create;
2632 begin
2633   fPixelSize        := 3.0;
2634   fRange.r          := $FF;
2635   fRange.g          := $FF;
2636   fRange.b          := $FF;
2637   fShift.r          :=  16;
2638   fShift.g          :=   8;
2639   fShift.b          :=   0;
2640   fglFormat         := GL_BGR;
2641   fglDataFormat     := GL_UNSIGNED_BYTE;
2642 end;
2643
2644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2648 begin
2649   inherited Map(aPixel, aData, aMapData);
2650   aData^ := aPixel.Data.a;
2651   inc(aData);
2652 end;
2653
2654 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2655 begin
2656   inherited Unmap(aData, aPixel, aMapData);
2657   aPixel.Data.a := aData^;
2658   inc(aData);
2659 end;
2660
2661 constructor TfdRGBA_UB4.Create;
2662 begin
2663   inherited Create;
2664   fPixelSize        := 4.0;
2665   fRange.a          := $FF;
2666   fShift.a          :=  24;
2667   fglFormat         := GL_RGBA;
2668   fglDataFormat     := GL_UNSIGNED_BYTE;
2669 end;
2670
2671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2675 begin
2676   inherited Map(aPixel, aData, aMapData);
2677   aData^ := aPixel.Data.a;
2678   inc(aData);
2679 end;
2680
2681 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2682 begin
2683   inherited Unmap(aData, aPixel, aMapData);
2684   aPixel.Data.a := aData^;
2685   inc(aData);
2686 end;
2687
2688 constructor TfdBGRA_UB4.Create;
2689 begin
2690   inherited Create;
2691   fPixelSize        := 4.0;
2692   fRange.a          := $FF;
2693   fShift.a          :=  24;
2694   fglFormat         := GL_BGRA;
2695   fglDataFormat     := GL_UNSIGNED_BYTE;
2696 end;
2697
2698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2701 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2702 begin
2703   PWord(aData)^ := aPixel.Data.a;
2704   inc(aData, 2);
2705 end;
2706
2707 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2708 begin
2709   aPixel.Data.r := 0;
2710   aPixel.Data.g := 0;
2711   aPixel.Data.b := 0;
2712   aPixel.Data.a := PWord(aData)^;
2713   inc(aData, 2);
2714 end;
2715
2716 constructor TfdAlpha_US1.Create;
2717 begin
2718   inherited Create;
2719   fPixelSize        := 2.0;
2720   fRange.a          := $FFFF;
2721   fglFormat         := GL_ALPHA;
2722   fglDataFormat     := GL_UNSIGNED_SHORT;
2723 end;
2724
2725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2728 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2729 begin
2730   PWord(aData)^ := LuminanceWeight(aPixel);
2731   inc(aData, 2);
2732 end;
2733
2734 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2735 begin
2736   aPixel.Data.r := PWord(aData)^;
2737   aPixel.Data.g := PWord(aData)^;
2738   aPixel.Data.b := PWord(aData)^;
2739   aPixel.Data.a := 0;
2740   inc(aData, 2);
2741 end;
2742
2743 constructor TfdLuminance_US1.Create;
2744 begin
2745   inherited Create;
2746   fPixelSize        := 2.0;
2747   fRange.r          := $FFFF;
2748   fRange.g          := $FFFF;
2749   fRange.b          := $FFFF;
2750   fglFormat         := GL_LUMINANCE;
2751   fglDataFormat     := GL_UNSIGNED_SHORT;
2752 end;
2753
2754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2755 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2758 var
2759   i: Integer;
2760 begin
2761   PWord(aData)^ := 0;
2762   for i := 0 to 3 do
2763     if (fRange.arr[i] > 0) then
2764       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2765   inc(aData, 2);
2766 end;
2767
2768 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2769 var
2770   i: Integer;
2771 begin
2772   for i := 0 to 3 do
2773     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2774   inc(aData, 2);
2775 end;
2776
2777 constructor TfdUniversal_US1.Create;
2778 begin
2779   inherited Create;
2780   fPixelSize := 2.0;
2781 end;
2782
2783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2784 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2787 begin
2788   PWord(aData)^ := DepthWeight(aPixel);
2789   inc(aData, 2);
2790 end;
2791
2792 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2793 begin
2794   aPixel.Data.r := PWord(aData)^;
2795   aPixel.Data.g := PWord(aData)^;
2796   aPixel.Data.b := PWord(aData)^;
2797   aPixel.Data.a := 0;
2798   inc(aData, 2);
2799 end;
2800
2801 constructor TfdDepth_US1.Create;
2802 begin
2803   inherited Create;
2804   fPixelSize        := 2.0;
2805   fRange.r          := $FFFF;
2806   fRange.g          := $FFFF;
2807   fRange.b          := $FFFF;
2808   fglFormat         := GL_DEPTH_COMPONENT;
2809   fglDataFormat     := GL_UNSIGNED_SHORT;
2810 end;
2811
2812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2813 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2816 begin
2817   inherited Map(aPixel, aData, aMapData);
2818   PWord(aData)^ := aPixel.Data.a;
2819   inc(aData, 2);
2820 end;
2821
2822 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2823 begin
2824   inherited Unmap(aData, aPixel, aMapData);
2825   aPixel.Data.a := PWord(aData)^;
2826   inc(aData, 2);
2827 end;
2828
2829 constructor TfdLuminanceAlpha_US2.Create;
2830 begin
2831   inherited Create;
2832   fPixelSize        :=   4.0;
2833   fRange.a          := $FFFF;
2834   fShift.a          :=    16;
2835   fglFormat         := GL_LUMINANCE_ALPHA;
2836   fglDataFormat     := GL_UNSIGNED_SHORT;
2837 end;
2838
2839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2840 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2843 begin
2844   PWord(aData)^ := aPixel.Data.r;
2845   inc(aData, 2);
2846   PWord(aData)^ := aPixel.Data.g;
2847   inc(aData, 2);
2848   PWord(aData)^ := aPixel.Data.b;
2849   inc(aData, 2);
2850 end;
2851
2852 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2853 begin
2854   aPixel.Data.r := PWord(aData)^;
2855   inc(aData, 2);
2856   aPixel.Data.g := PWord(aData)^;
2857   inc(aData, 2);
2858   aPixel.Data.b := PWord(aData)^;
2859   inc(aData, 2);
2860   aPixel.Data.a := 0;
2861 end;
2862
2863 constructor TfdRGB_US3.Create;
2864 begin
2865   inherited Create;
2866   fPixelSize        :=   6.0;
2867   fRange.r          := $FFFF;
2868   fRange.g          := $FFFF;
2869   fRange.b          := $FFFF;
2870   fShift.r          :=     0;
2871   fShift.g          :=    16;
2872   fShift.b          :=    32;
2873   fglFormat         := GL_RGB;
2874   fglDataFormat     := GL_UNSIGNED_SHORT;
2875 end;
2876
2877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2878 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2881 begin
2882   PWord(aData)^ := aPixel.Data.b;
2883   inc(aData, 2);
2884   PWord(aData)^ := aPixel.Data.g;
2885   inc(aData, 2);
2886   PWord(aData)^ := aPixel.Data.r;
2887   inc(aData, 2);
2888 end;
2889
2890 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2891 begin
2892   aPixel.Data.b := PWord(aData)^;
2893   inc(aData, 2);
2894   aPixel.Data.g := PWord(aData)^;
2895   inc(aData, 2);
2896   aPixel.Data.r := PWord(aData)^;
2897   inc(aData, 2);
2898   aPixel.Data.a := 0;
2899 end;
2900
2901 constructor TfdBGR_US3.Create;
2902 begin
2903   inherited Create;
2904   fPixelSize        :=   6.0;
2905   fRange.r          := $FFFF;
2906   fRange.g          := $FFFF;
2907   fRange.b          := $FFFF;
2908   fShift.r          :=    32;
2909   fShift.g          :=    16;
2910   fShift.b          :=     0;
2911   fglFormat         := GL_BGR;
2912   fglDataFormat     := GL_UNSIGNED_SHORT;
2913 end;
2914
2915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2916 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2919 begin
2920   inherited Map(aPixel, aData, aMapData);
2921   PWord(aData)^ := aPixel.Data.a;
2922   inc(aData, 2);
2923 end;
2924
2925 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2926 begin
2927   inherited Unmap(aData, aPixel, aMapData);
2928   aPixel.Data.a := PWord(aData)^;
2929   inc(aData, 2);
2930 end;
2931
2932 constructor TfdRGBA_US4.Create;
2933 begin
2934   inherited Create;
2935   fPixelSize        :=   8.0;
2936   fRange.a          := $FFFF;
2937   fShift.a          :=    48;
2938   fglFormat         := GL_RGBA;
2939   fglDataFormat     := GL_UNSIGNED_SHORT;
2940 end;
2941
2942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2943 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2945 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2946 begin
2947   inherited Map(aPixel, aData, aMapData);
2948   PWord(aData)^ := aPixel.Data.a;
2949   inc(aData, 2);
2950 end;
2951
2952 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2953 begin
2954   inherited Unmap(aData, aPixel, aMapData);
2955   aPixel.Data.a := PWord(aData)^;
2956   inc(aData, 2);
2957 end;
2958
2959 constructor TfdBGRA_US4.Create;
2960 begin
2961   inherited Create;
2962   fPixelSize        :=   8.0;
2963   fRange.a          := $FFFF;
2964   fShift.a          :=    48;
2965   fglFormat         := GL_BGRA;
2966   fglDataFormat     := GL_UNSIGNED_SHORT;
2967 end;
2968
2969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2970 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2972 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2973 var
2974   i: Integer;
2975 begin
2976   PCardinal(aData)^ := 0;
2977   for i := 0 to 3 do
2978     if (fRange.arr[i] > 0) then
2979       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2980   inc(aData, 4);
2981 end;
2982
2983 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2984 var
2985   i: Integer;
2986 begin
2987   for i := 0 to 3 do
2988     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2989   inc(aData, 2);
2990 end;
2991
2992 constructor TfdUniversal_UI1.Create;
2993 begin
2994   inherited Create;
2995   fPixelSize := 4.0;
2996 end;
2997
2998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2999 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3002 begin
3003   PCardinal(aData)^ := DepthWeight(aPixel);
3004   inc(aData, 4);
3005 end;
3006
3007 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3008 begin
3009   aPixel.Data.r := PCardinal(aData)^;
3010   aPixel.Data.g := PCardinal(aData)^;
3011   aPixel.Data.b := PCardinal(aData)^;
3012   aPixel.Data.a := 0;
3013   inc(aData, 4);
3014 end;
3015
3016 constructor TfdDepth_UI1.Create;
3017 begin
3018   inherited Create;
3019   fPixelSize        := 4.0;
3020   fRange.r          := $FFFFFFFF;
3021   fRange.g          := $FFFFFFFF;
3022   fRange.b          := $FFFFFFFF;
3023   fglFormat         := GL_DEPTH_COMPONENT;
3024   fglDataFormat     := GL_UNSIGNED_INT;
3025 end;
3026
3027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3030 constructor TfdAlpha4.Create;
3031 begin
3032   inherited Create;
3033   fFormat           := tfAlpha4;
3034   fWithAlpha        := tfAlpha4;
3035   fglInternalFormat := GL_ALPHA4;
3036 end;
3037
3038 constructor TfdAlpha8.Create;
3039 begin
3040   inherited Create;
3041   fFormat           := tfAlpha8;
3042   fWithAlpha        := tfAlpha8;
3043   fglInternalFormat := GL_ALPHA8;
3044 end;
3045
3046 constructor TfdAlpha12.Create;
3047 begin
3048   inherited Create;
3049   fFormat           := tfAlpha12;
3050   fWithAlpha        := tfAlpha12;
3051   fglInternalFormat := GL_ALPHA12;
3052 end;
3053
3054 constructor TfdAlpha16.Create;
3055 begin
3056   inherited Create;
3057   fFormat           := tfAlpha16;
3058   fWithAlpha        := tfAlpha16;
3059   fglInternalFormat := GL_ALPHA16;
3060 end;
3061
3062 constructor TfdLuminance4.Create;
3063 begin
3064   inherited Create;
3065   fFormat           := tfLuminance4;
3066   fWithAlpha        := tfLuminance4Alpha4;
3067   fWithoutAlpha     := tfLuminance4;
3068   fglInternalFormat := GL_LUMINANCE4;
3069 end;
3070
3071 constructor TfdLuminance8.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfLuminance8;
3075   fWithAlpha        := tfLuminance8Alpha8;
3076   fWithoutAlpha     := tfLuminance8;
3077   fglInternalFormat := GL_LUMINANCE8;
3078 end;
3079
3080 constructor TfdLuminance12.Create;
3081 begin
3082   inherited Create;
3083   fFormat           := tfLuminance12;
3084   fWithAlpha        := tfLuminance12Alpha12;
3085   fWithoutAlpha     := tfLuminance12;
3086   fglInternalFormat := GL_LUMINANCE12;
3087 end;
3088
3089 constructor TfdLuminance16.Create;
3090 begin
3091   inherited Create;
3092   fFormat           := tfLuminance16;
3093   fWithAlpha        := tfLuminance16Alpha16;
3094   fWithoutAlpha     := tfLuminance16;
3095   fglInternalFormat := GL_LUMINANCE16;
3096 end;
3097
3098 constructor TfdLuminance4Alpha4.Create;
3099 begin
3100   inherited Create;
3101   fFormat           := tfLuminance4Alpha4;
3102   fWithAlpha        := tfLuminance4Alpha4;
3103   fWithoutAlpha     := tfLuminance4;
3104   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3105 end;
3106
3107 constructor TfdLuminance6Alpha2.Create;
3108 begin
3109   inherited Create;
3110   fFormat           := tfLuminance6Alpha2;
3111   fWithAlpha        := tfLuminance6Alpha2;
3112   fWithoutAlpha     := tfLuminance8;
3113   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3114 end;
3115
3116 constructor TfdLuminance8Alpha8.Create;
3117 begin
3118   inherited Create;
3119   fFormat           := tfLuminance8Alpha8;
3120   fWithAlpha        := tfLuminance8Alpha8;
3121   fWithoutAlpha     := tfLuminance8;
3122   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3123 end;
3124
3125 constructor TfdLuminance12Alpha4.Create;
3126 begin
3127   inherited Create;
3128   fFormat           := tfLuminance12Alpha4;
3129   fWithAlpha        := tfLuminance12Alpha4;
3130   fWithoutAlpha     := tfLuminance12;
3131   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3132 end;
3133
3134 constructor TfdLuminance12Alpha12.Create;
3135 begin
3136   inherited Create;
3137   fFormat           := tfLuminance12Alpha12;
3138   fWithAlpha        := tfLuminance12Alpha12;
3139   fWithoutAlpha     := tfLuminance12;
3140   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3141 end;
3142
3143 constructor TfdLuminance16Alpha16.Create;
3144 begin
3145   inherited Create;
3146   fFormat           := tfLuminance16Alpha16;
3147   fWithAlpha        := tfLuminance16Alpha16;
3148   fWithoutAlpha     := tfLuminance16;
3149   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3150 end;
3151
3152 constructor TfdR3G3B2.Create;
3153 begin
3154   inherited Create;
3155   fFormat           := tfR3G3B2;
3156   fWithAlpha        := tfRGBA2;
3157   fWithoutAlpha     := tfR3G3B2;
3158   fRange.r          := $7;
3159   fRange.g          := $7;
3160   fRange.b          := $3;
3161   fShift.r          :=  0;
3162   fShift.g          :=  3;
3163   fShift.b          :=  6;
3164   fglFormat         := GL_RGB;
3165   fglInternalFormat := GL_R3_G3_B2;
3166   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3167 end;
3168
3169 constructor TfdRGB4.Create;
3170 begin
3171   inherited Create;
3172   fFormat           := tfRGB4;
3173   fWithAlpha        := tfRGBA4;
3174   fWithoutAlpha     := tfRGB4;
3175   fRGBInverted      := tfBGR4;
3176   fRange.r          := $F;
3177   fRange.g          := $F;
3178   fRange.b          := $F;
3179   fShift.r          :=  0;
3180   fShift.g          :=  4;
3181   fShift.b          :=  8;
3182   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3183   fglInternalFormat := GL_RGB4;
3184   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3185 end;
3186
3187 constructor TfdR5G6B5.Create;
3188 begin
3189   inherited Create;
3190   fFormat           := tfR5G6B5;
3191   fWithAlpha        := tfRGBA4;
3192   fWithoutAlpha     := tfR5G6B5;
3193   fRGBInverted      := tfB5G6R5;
3194   fRange.r          := $1F;
3195   fRange.g          := $3F;
3196   fRange.b          := $1F;
3197   fShift.r          :=   0;
3198   fShift.g          :=   5;
3199   fShift.b          :=  11;
3200   fglFormat         := GL_RGB;
3201   fglInternalFormat := GL_RGB565;
3202   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3203 end;
3204
3205 constructor TfdRGB5.Create;
3206 begin
3207   inherited Create;
3208   fFormat           := tfRGB5;
3209   fWithAlpha        := tfRGB5A1;
3210   fWithoutAlpha     := tfRGB5;
3211   fRGBInverted      := tfBGR5;
3212   fRange.r          := $1F;
3213   fRange.g          := $1F;
3214   fRange.b          := $1F;
3215   fShift.r          :=   0;
3216   fShift.g          :=   5;
3217   fShift.b          :=  10;
3218   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3219   fglInternalFormat := GL_RGB5;
3220   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3221 end;
3222
3223 constructor TfdRGB8.Create;
3224 begin
3225   inherited Create;
3226   fFormat           := tfRGB8;
3227   fWithAlpha        := tfRGBA8;
3228   fWithoutAlpha     := tfRGB8;
3229   fRGBInverted      := tfBGR8;
3230   fglInternalFormat := GL_RGB8;
3231 end;
3232
3233 constructor TfdRGB10.Create;
3234 begin
3235   inherited Create;
3236   fFormat           := tfRGB10;
3237   fWithAlpha        := tfRGB10A2;
3238   fWithoutAlpha     := tfRGB10;
3239   fRGBInverted      := tfBGR10;
3240   fRange.r          := $3FF;
3241   fRange.g          := $3FF;
3242   fRange.b          := $3FF;
3243   fShift.r          :=    0;
3244   fShift.g          :=   10;
3245   fShift.b          :=   20;
3246   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3247   fglInternalFormat := GL_RGB10;
3248   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3249 end;
3250
3251 constructor TfdRGB12.Create;
3252 begin
3253   inherited Create;
3254   fFormat           := tfRGB12;
3255   fWithAlpha        := tfRGBA12;
3256   fWithoutAlpha     := tfRGB12;
3257   fRGBInverted      := tfBGR12;
3258   fglInternalFormat := GL_RGB12;
3259 end;
3260
3261 constructor TfdRGB16.Create;
3262 begin
3263   inherited Create;
3264   fFormat           := tfRGB16;
3265   fWithAlpha        := tfRGBA16;
3266   fWithoutAlpha     := tfRGB16;
3267   fRGBInverted      := tfBGR16;
3268   fglInternalFormat := GL_RGB16;
3269 end;
3270
3271 constructor TfdRGBA2.Create;
3272 begin
3273   inherited Create;
3274   fFormat           := tfRGBA2;
3275   fWithAlpha        := tfRGBA2;
3276   fWithoutAlpha     := tfR3G3B2;
3277   fRGBInverted      := tfBGRA2;
3278   fglInternalFormat := GL_RGBA2;
3279 end;
3280
3281 constructor TfdRGBA4.Create;
3282 begin
3283   inherited Create;
3284   fFormat           := tfRGBA4;
3285   fWithAlpha        := tfRGBA4;
3286   fWithoutAlpha     := tfRGB4;
3287   fRGBInverted      := tfBGRA4;
3288   fRange.r          := $F;
3289   fRange.g          := $F;
3290   fRange.b          := $F;
3291   fRange.a          := $F;
3292   fShift.r          :=  0;
3293   fShift.g          :=  4;
3294   fShift.b          :=  8;
3295   fShift.a          := 12;
3296   fglFormat         := GL_RGBA;
3297   fglInternalFormat := GL_RGBA4;
3298   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3299 end;
3300
3301 constructor TfdRGB5A1.Create;
3302 begin
3303   inherited Create;
3304   fFormat           := tfRGB5A1;
3305   fWithAlpha        := tfRGB5A1;
3306   fWithoutAlpha     := tfRGB5;
3307   fRGBInverted      := tfBGR5A1;
3308   fRange.r          := $1F;
3309   fRange.g          := $1F;
3310   fRange.b          := $1F;
3311   fRange.a          := $01;
3312   fShift.r          :=   0;
3313   fShift.g          :=   5;
3314   fShift.b          :=  10;
3315   fShift.a          :=  15;
3316   fglFormat         := GL_RGBA;
3317   fglInternalFormat := GL_RGB5_A1;
3318   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3319 end;
3320
3321 constructor TfdRGBA8.Create;
3322 begin
3323   inherited Create;
3324   fFormat           := tfRGBA8;
3325   fWithAlpha        := tfRGBA8;
3326   fWithoutAlpha     := tfRGB8;
3327   fRGBInverted      := tfBGRA8;
3328   fglInternalFormat := GL_RGBA8;
3329 end;
3330
3331 constructor TfdRGB10A2.Create;
3332 begin
3333   inherited Create;
3334   fFormat           := tfRGB10A2;
3335   fWithAlpha        := tfRGB10A2;
3336   fWithoutAlpha     := tfRGB10;
3337   fRGBInverted      := tfBGR10A2;
3338   fRange.r          := $3FF;
3339   fRange.g          := $3FF;
3340   fRange.b          := $3FF;
3341   fRange.a          := $003;
3342   fShift.r          :=    0;
3343   fShift.g          :=   10;
3344   fShift.b          :=   20;
3345   fShift.a          :=   30;
3346   fglFormat         := GL_RGBA;
3347   fglInternalFormat := GL_RGB10_A2;
3348   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3349 end;
3350
3351 constructor TfdRGBA12.Create;
3352 begin
3353   inherited Create;
3354   fFormat           := tfRGBA12;
3355   fWithAlpha        := tfRGBA12;
3356   fWithoutAlpha     := tfRGB12;
3357   fRGBInverted      := tfBGRA12;
3358   fglInternalFormat := GL_RGBA12;
3359 end;
3360
3361 constructor TfdRGBA16.Create;
3362 begin
3363   inherited Create;
3364   fFormat           := tfRGBA16;
3365   fWithAlpha        := tfRGBA16;
3366   fWithoutAlpha     := tfRGB16;
3367   fRGBInverted      := tfBGRA16;
3368   fglInternalFormat := GL_RGBA16;
3369 end;
3370
3371 constructor TfdBGR4.Create;
3372 begin
3373   inherited Create;
3374   fPixelSize        := 2.0;
3375   fFormat           := tfBGR4;
3376   fWithAlpha        := tfBGRA4;
3377   fWithoutAlpha     := tfBGR4;
3378   fRGBInverted      := tfRGB4;
3379   fRange.r          := $F;
3380   fRange.g          := $F;
3381   fRange.b          := $F;
3382   fRange.a          := $0;
3383   fShift.r          :=  8;
3384   fShift.g          :=  4;
3385   fShift.b          :=  0;
3386   fShift.a          :=  0;
3387   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3388   fglInternalFormat := GL_RGB4;
3389   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3390 end;
3391
3392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3395 constructor TfdB5G6R5.Create;
3396 begin
3397   inherited Create;
3398   fFormat           := tfB5G6R5;
3399   fWithAlpha        := tfBGRA4;
3400   fWithoutAlpha     := tfB5G6R5;
3401   fRGBInverted      := tfR5G6B5;
3402   fRange.r          := $1F;
3403   fRange.g          := $3F;
3404   fRange.b          := $1F;
3405   fShift.r          :=  11;
3406   fShift.g          :=   5;
3407   fShift.b          :=   0;
3408   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3409   fglInternalFormat := GL_RGB8;
3410   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3411 end;
3412
3413 constructor TfdBGR5.Create;
3414 begin
3415   inherited Create;
3416   fPixelSize        := 2.0;
3417   fFormat           := tfBGR5;
3418   fWithAlpha        := tfBGR5A1;
3419   fWithoutAlpha     := tfBGR5;
3420   fRGBInverted      := tfRGB5;
3421   fRange.r          := $1F;
3422   fRange.g          := $1F;
3423   fRange.b          := $1F;
3424   fRange.a          := $00;
3425   fShift.r          :=  10;
3426   fShift.g          :=   5;
3427   fShift.b          :=   0;
3428   fShift.a          :=   0;
3429   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3430   fglInternalFormat := GL_RGB5;
3431   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3432 end;
3433
3434 constructor TfdBGR8.Create;
3435 begin
3436   inherited Create;
3437   fFormat           := tfBGR8;
3438   fWithAlpha        := tfBGRA8;
3439   fWithoutAlpha     := tfBGR8;
3440   fRGBInverted      := tfRGB8;
3441   fglInternalFormat := GL_RGB8;
3442 end;
3443
3444 constructor TfdBGR10.Create;
3445 begin
3446   inherited Create;
3447   fFormat           := tfBGR10;
3448   fWithAlpha        := tfBGR10A2;
3449   fWithoutAlpha     := tfBGR10;
3450   fRGBInverted      := tfRGB10;
3451   fRange.r          := $3FF;
3452   fRange.g          := $3FF;
3453   fRange.b          := $3FF;
3454   fRange.a          := $000;
3455   fShift.r          :=   20;
3456   fShift.g          :=   10;
3457   fShift.b          :=    0;
3458   fShift.a          :=    0;
3459   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3460   fglInternalFormat := GL_RGB10;
3461   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3462 end;
3463
3464 constructor TfdBGR12.Create;
3465 begin
3466   inherited Create;
3467   fFormat           := tfBGR12;
3468   fWithAlpha        := tfBGRA12;
3469   fWithoutAlpha     := tfBGR12;
3470   fRGBInverted      := tfRGB12;
3471   fglInternalFormat := GL_RGB12;
3472 end;
3473
3474 constructor TfdBGR16.Create;
3475 begin
3476   inherited Create;
3477   fFormat           := tfBGR16;
3478   fWithAlpha        := tfBGRA16;
3479   fWithoutAlpha     := tfBGR16;
3480   fRGBInverted      := tfRGB16;
3481   fglInternalFormat := GL_RGB16;
3482 end;
3483
3484 constructor TfdBGRA2.Create;
3485 begin
3486   inherited Create;
3487   fFormat           := tfBGRA2;
3488   fWithAlpha        := tfBGRA4;
3489   fWithoutAlpha     := tfBGR4;
3490   fRGBInverted      := tfRGBA2;
3491   fglInternalFormat := GL_RGBA2;
3492 end;
3493
3494 constructor TfdBGRA4.Create;
3495 begin
3496   inherited Create;
3497   fFormat           := tfBGRA4;
3498   fWithAlpha        := tfBGRA4;
3499   fWithoutAlpha     := tfBGR4;
3500   fRGBInverted      := tfRGBA4;
3501   fRange.r          := $F;
3502   fRange.g          := $F;
3503   fRange.b          := $F;
3504   fRange.a          := $F;
3505   fShift.r          :=  8;
3506   fShift.g          :=  4;
3507   fShift.b          :=  0;
3508   fShift.a          := 12;
3509   fglFormat         := GL_BGRA;
3510   fglInternalFormat := GL_RGBA4;
3511   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3512 end;
3513
3514 constructor TfdBGR5A1.Create;
3515 begin
3516   inherited Create;
3517   fFormat           := tfBGR5A1;
3518   fWithAlpha        := tfBGR5A1;
3519   fWithoutAlpha     := tfBGR5;
3520   fRGBInverted      := tfRGB5A1;
3521   fRange.r          := $1F;
3522   fRange.g          := $1F;
3523   fRange.b          := $1F;
3524   fRange.a          := $01;
3525   fShift.r          :=  10;
3526   fShift.g          :=   5;
3527   fShift.b          :=   0;
3528   fShift.a          :=  15;
3529   fglFormat         := GL_BGRA;
3530   fglInternalFormat := GL_RGB5_A1;
3531   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3532 end;
3533
3534 constructor TfdBGRA8.Create;
3535 begin
3536   inherited Create;
3537   fFormat           := tfBGRA8;
3538   fWithAlpha        := tfBGRA8;
3539   fWithoutAlpha     := tfBGR8;
3540   fRGBInverted      := tfRGBA8;
3541   fglInternalFormat := GL_RGBA8;
3542 end;
3543
3544 constructor TfdBGR10A2.Create;
3545 begin
3546   inherited Create;
3547   fFormat           := tfBGR10A2;
3548   fWithAlpha        := tfBGR10A2;
3549   fWithoutAlpha     := tfBGR10;
3550   fRGBInverted      := tfRGB10A2;
3551   fRange.r          := $3FF;
3552   fRange.g          := $3FF;
3553   fRange.b          := $3FF;
3554   fRange.a          := $003;
3555   fShift.r          :=   20;
3556   fShift.g          :=   10;
3557   fShift.b          :=    0;
3558   fShift.a          :=   30;
3559   fglFormat         := GL_BGRA;
3560   fglInternalFormat := GL_RGB10_A2;
3561   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3562 end;
3563
3564 constructor TfdBGRA12.Create;
3565 begin
3566   inherited Create;
3567   fFormat           := tfBGRA12;
3568   fWithAlpha        := tfBGRA12;
3569   fWithoutAlpha     := tfBGR12;
3570   fRGBInverted      := tfRGBA12;
3571   fglInternalFormat := GL_RGBA12;
3572 end;
3573
3574 constructor TfdBGRA16.Create;
3575 begin
3576   inherited Create;
3577   fFormat           := tfBGRA16;
3578   fWithAlpha        := tfBGRA16;
3579   fWithoutAlpha     := tfBGR16;
3580   fRGBInverted      := tfRGBA16;
3581   fglInternalFormat := GL_RGBA16;
3582 end;
3583
3584 constructor TfdDepth16.Create;
3585 begin
3586   inherited Create;
3587   fFormat           := tfDepth16;
3588   fWithAlpha        := tfEmpty;
3589   fWithoutAlpha     := tfDepth16;
3590   fglInternalFormat := GL_DEPTH_COMPONENT16;
3591 end;
3592
3593 constructor TfdDepth24.Create;
3594 begin
3595   inherited Create;
3596   fFormat           := tfDepth24;
3597   fWithAlpha        := tfEmpty;
3598   fWithoutAlpha     := tfDepth24;
3599   fglInternalFormat := GL_DEPTH_COMPONENT24;
3600 end;
3601
3602 constructor TfdDepth32.Create;
3603 begin
3604   inherited Create;
3605   fFormat           := tfDepth32;
3606   fWithAlpha        := tfEmpty;
3607   fWithoutAlpha     := tfDepth32;
3608   fglInternalFormat := GL_DEPTH_COMPONENT32;
3609 end;
3610
3611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3612 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3614 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3615 begin
3616   raise EglBitmap.Create('mapping for compressed formats is not supported');
3617 end;
3618
3619 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3620 begin
3621   raise EglBitmap.Create('mapping for compressed formats is not supported');
3622 end;
3623
3624 constructor TfdS3tcDtx1RGBA.Create;
3625 begin
3626   inherited Create;
3627   fFormat           := tfS3tcDtx1RGBA;
3628   fWithAlpha        := tfS3tcDtx1RGBA;
3629   fUncompressed     := tfRGB5A1;
3630   fPixelSize        := 0.5;
3631   fIsCompressed     := true;
3632   fglFormat         := GL_COMPRESSED_RGBA;
3633   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3634   fglDataFormat     := GL_UNSIGNED_BYTE;
3635 end;
3636
3637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3638 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3640 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3641 begin
3642   raise EglBitmap.Create('mapping for compressed formats is not supported');
3643 end;
3644
3645 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3646 begin
3647   raise EglBitmap.Create('mapping for compressed formats is not supported');
3648 end;
3649
3650 constructor TfdS3tcDtx3RGBA.Create;
3651 begin
3652   inherited Create;
3653   fFormat           := tfS3tcDtx3RGBA;
3654   fWithAlpha        := tfS3tcDtx3RGBA;
3655   fUncompressed     := tfRGBA8;
3656   fPixelSize        := 1.0;
3657   fIsCompressed     := true;
3658   fglFormat         := GL_COMPRESSED_RGBA;
3659   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3660   fglDataFormat     := GL_UNSIGNED_BYTE;
3661 end;
3662
3663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3664 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3667 begin
3668   raise EglBitmap.Create('mapping for compressed formats is not supported');
3669 end;
3670
3671 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3672 begin
3673   raise EglBitmap.Create('mapping for compressed formats is not supported');
3674 end;
3675
3676 constructor TfdS3tcDtx5RGBA.Create;
3677 begin
3678   inherited Create;
3679   fFormat           := tfS3tcDtx3RGBA;
3680   fWithAlpha        := tfS3tcDtx3RGBA;
3681   fUncompressed     := tfRGBA8;
3682   fPixelSize        := 1.0;
3683   fIsCompressed     := true;
3684   fglFormat         := GL_COMPRESSED_RGBA;
3685   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3686   fglDataFormat     := GL_UNSIGNED_BYTE;
3687 end;
3688
3689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3690 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3692 class procedure TFormatDescriptor.Init;
3693 begin
3694   if not Assigned(FormatDescriptorCS) then
3695     FormatDescriptorCS := TCriticalSection.Create;
3696 end;
3697
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3700 begin
3701   FormatDescriptorCS.Enter;
3702   try
3703     result := FormatDescriptors[aFormat];
3704     if not Assigned(result) then begin
3705       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3706       FormatDescriptors[aFormat] := result;
3707     end;
3708   finally
3709     FormatDescriptorCS.Leave;
3710   end;
3711 end;
3712
3713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3714 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3715 begin
3716   result := Get(Get(aFormat).WithAlpha);
3717 end;
3718
3719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 class procedure TFormatDescriptor.Clear;
3721 var
3722   f: TglBitmapFormat;
3723 begin
3724   FormatDescriptorCS.Enter;
3725   try
3726     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3727       FreeAndNil(FormatDescriptors[f]);
3728   finally
3729     FormatDescriptorCS.Leave;
3730   end;
3731 end;
3732
3733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3734 class procedure TFormatDescriptor.Finalize;
3735 begin
3736   Clear;
3737   FreeAndNil(FormatDescriptorCS);
3738 end;
3739
3740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3744 begin
3745   Update(aValue, fRange.r, fShift.r);
3746 end;
3747
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3750 begin
3751   Update(aValue, fRange.g, fShift.g);
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3756 begin
3757   Update(aValue, fRange.b, fShift.b);
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3762 begin
3763   Update(aValue, fRange.a, fShift.a);
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3768   aShift: Byte);
3769 begin
3770   aShift := 0;
3771   aRange := 0;
3772   if (aMask = 0) then
3773     exit;
3774   while (aMask > 0) and ((aMask and 1) = 0) do begin
3775     inc(aShift);
3776     aMask := aMask shr 1;
3777   end;
3778   aRange := 1;
3779   while (aMask > 0) do begin
3780     aRange := aRange shl 1;
3781     aMask  := aMask  shr 1;
3782   end;
3783   dec(aRange);
3784
3785   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3786 end;
3787
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3790 var
3791   data: QWord;
3792   s: Integer;
3793 begin
3794   data :=
3795     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3796     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3797     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3798     ((aPixel.Data.a and fRange.a) shl fShift.a);
3799   s := Round(fPixelSize);
3800   case s of
3801     1:           aData^  := data;
3802     2:     PWord(aData)^ := data;
3803     4: PCardinal(aData)^ := data;
3804     8:    PQWord(aData)^ := data;
3805   else
3806     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3807   end;
3808   inc(aData, s);
3809 end;
3810
3811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3812 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3813 var
3814   data: QWord;
3815   s, i: Integer;
3816 begin
3817   s := Round(fPixelSize);
3818   case s of
3819     1: data :=           aData^;
3820     2: data :=     PWord(aData)^;
3821     4: data := PCardinal(aData)^;
3822     8: data :=    PQWord(aData)^;
3823   else
3824     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3825   end;
3826   for i := 0 to 3 do
3827     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3828   inc(aData, s);
3829 end;
3830
3831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3832 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3834 procedure TbmpColorTableFormat.CreateColorTable;
3835 var
3836   i: Integer;
3837 begin
3838   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3839     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3840
3841   if (Format = tfLuminance4) then
3842     SetLength(fColorTable, 16)
3843   else
3844     SetLength(fColorTable, 256);
3845
3846   case Format of
3847     tfLuminance4: begin
3848       for i := 0 to High(fColorTable) do begin
3849         fColorTable[i].r := 16 * i;
3850         fColorTable[i].g := 16 * i;
3851         fColorTable[i].b := 16 * i;
3852         fColorTable[i].a := 0;
3853       end;
3854     end;
3855
3856     tfLuminance8: begin
3857       for i := 0 to High(fColorTable) do begin
3858         fColorTable[i].r := i;
3859         fColorTable[i].g := i;
3860         fColorTable[i].b := i;
3861         fColorTable[i].a := 0;
3862       end;
3863     end;
3864
3865     tfR3G3B2: begin
3866       for i := 0 to High(fColorTable) do begin
3867         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3868         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3869         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3870         fColorTable[i].a := 0;
3871       end;
3872     end;
3873   end;
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3878 var
3879   d: Byte;
3880 begin
3881   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3882     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3883
3884   case Format of
3885     tfLuminance4: begin
3886       if (aMapData = nil) then
3887         aData^ := 0;
3888       d := LuminanceWeight(aPixel) and Range.r;
3889       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3890       inc(PByte(aMapData), 4);
3891       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3892         inc(aData);
3893         aMapData := nil;
3894       end;
3895     end;
3896
3897     tfLuminance8: begin
3898       aData^ := LuminanceWeight(aPixel) and Range.r;
3899       inc(aData);
3900     end;
3901
3902     tfR3G3B2: begin
3903       aData^ := Round(
3904         ((aPixel.Data.r and Range.r) shl Shift.r) or
3905         ((aPixel.Data.g and Range.g) shl Shift.g) or
3906         ((aPixel.Data.b and Range.b) shl Shift.b));
3907       inc(aData);
3908     end;
3909   end;
3910 end;
3911
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3914 var
3915   idx: QWord;
3916   s: Integer;
3917   bits: Byte;
3918   f: Single;
3919 begin
3920   s    := Trunc(fPixelSize);
3921   f    := fPixelSize - s;
3922   bits := Round(8 * f);
3923   case s of
3924     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3925     1: idx :=           aData^;
3926     2: idx :=     PWord(aData)^;
3927     4: idx := PCardinal(aData)^;
3928     8: idx :=    PQWord(aData)^;
3929   else
3930     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3931   end;
3932   if (idx >= Length(fColorTable)) then
3933     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3934   with fColorTable[idx] do begin
3935     aPixel.Data.r := r;
3936     aPixel.Data.g := g;
3937     aPixel.Data.b := b;
3938     aPixel.Data.a := a;
3939   end;
3940   inc(PByte(aMapData), bits);
3941   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3942     inc(aData, 1);
3943     dec(PByte(aMapData), 8);
3944   end;
3945   inc(aData, s);
3946 end;
3947
3948 destructor TbmpColorTableFormat.Destroy;
3949 begin
3950   SetLength(fColorTable, 0);
3951   inherited Destroy;
3952 end;
3953
3954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3955 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3957 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3958 var
3959   i: Integer;
3960 begin
3961   for i := 0 to 3 do begin
3962     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3963       if (aSourceFD.Range.arr[i] > 0) then
3964         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3965       else
3966         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3967     end;
3968   end;
3969 end;
3970
3971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3972 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3973 begin
3974   with aFuncRec do begin
3975     if (Source.Range.r   > 0) then
3976       Dest.Data.r := Source.Data.r;
3977     if (Source.Range.g > 0) then
3978       Dest.Data.g := Source.Data.g;
3979     if (Source.Range.b  > 0) then
3980       Dest.Data.b := Source.Data.b;
3981     if (Source.Range.a > 0) then
3982       Dest.Data.a := Source.Data.a;
3983   end;
3984 end;
3985
3986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3987 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3988 var
3989   i: Integer;
3990 begin
3991   with aFuncRec do begin
3992     for i := 0 to 3 do
3993       if (Source.Range.arr[i] > 0) then
3994         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3995   end;
3996 end;
3997
3998 type
3999   TShiftData = packed record
4000     case Integer of
4001       0: (r, g, b, a: SmallInt);
4002       1: (arr: array[0..3] of SmallInt);
4003   end;
4004   PShiftData = ^TShiftData;
4005
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4008 var
4009   i: Integer;
4010 begin
4011   with aFuncRec do
4012     for i := 0 to 3 do
4013       if (Source.Range.arr[i] > 0) then
4014         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4015 end;
4016
4017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4018 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4019 begin
4020   with aFuncRec do begin
4021     Dest.Data := Source.Data;
4022     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4023       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4024       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4025       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4026     end;
4027     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4028       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4029     end;
4030   end;
4031 end;
4032
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4035 var
4036   i: Integer;
4037 begin
4038   with aFuncRec do begin
4039     for i := 0 to 3 do
4040       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4041   end;
4042 end;
4043
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4046 var
4047   Temp: Single;
4048 begin
4049   with FuncRec do begin
4050     if (FuncRec.Args = nil) then begin //source has no alpha
4051       Temp :=
4052         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4053         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4054         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4055       Dest.Data.a := Round(Dest.Range.a * Temp);
4056     end else
4057       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4058   end;
4059 end;
4060
4061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4062 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4063 type
4064   PglBitmapPixelData = ^TglBitmapPixelData;
4065 begin
4066   with FuncRec do begin
4067     Dest.Data.r := Source.Data.r;
4068     Dest.Data.g := Source.Data.g;
4069     Dest.Data.b := Source.Data.b;
4070
4071     with PglBitmapPixelData(Args)^ do
4072       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4073           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4074           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4075         Dest.Data.a := 0
4076       else
4077         Dest.Data.a := Dest.Range.a;
4078   end;
4079 end;
4080
4081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4082 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4083 begin
4084   with FuncRec do begin
4085     Dest.Data.r := Source.Data.r;
4086     Dest.Data.g := Source.Data.g;
4087     Dest.Data.b := Source.Data.b;
4088     Dest.Data.a := PCardinal(Args)^;
4089   end;
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4094 type
4095   PRGBPix = ^TRGBPix;
4096   TRGBPix = array [0..2] of byte;
4097 var
4098   Temp: Byte;
4099 begin
4100   while aWidth > 0 do begin
4101     Temp := PRGBPix(aData)^[0];
4102     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4103     PRGBPix(aData)^[2] := Temp;
4104
4105     if aHasAlpha then
4106       Inc(aData, 4)
4107     else
4108       Inc(aData, 3);
4109     dec(aWidth);
4110   end;
4111 end;
4112
4113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4114 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4117 begin
4118   result := TFormatDescriptor.Get(Format);
4119 end;
4120
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 function TglBitmap.GetWidth: Integer;
4123 begin
4124   if (ffX in fDimension.Fields) then
4125     result := fDimension.X
4126   else
4127     result := -1;
4128 end;
4129
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 function TglBitmap.GetHeight: Integer;
4132 begin
4133   if (ffY in fDimension.Fields) then
4134     result := fDimension.Y
4135   else
4136     result := -1;
4137 end;
4138
4139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4140 function TglBitmap.GetFileWidth: Integer;
4141 begin
4142   result := Max(1, Width);
4143 end;
4144
4145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 function TglBitmap.GetFileHeight: Integer;
4147 begin
4148   result := Max(1, Height);
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4153 begin
4154   if fCustomData = aValue then
4155     exit;
4156   fCustomData := aValue;
4157 end;
4158
4159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4160 procedure TglBitmap.SetCustomName(const aValue: String);
4161 begin
4162   if fCustomName = aValue then
4163     exit;
4164   fCustomName := aValue;
4165 end;
4166
4167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4168 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4169 begin
4170   if fCustomNameW = aValue then
4171     exit;
4172   fCustomNameW := aValue;
4173 end;
4174
4175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4176 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4177 begin
4178   if fDeleteTextureOnFree = aValue then
4179     exit;
4180   fDeleteTextureOnFree := aValue;
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4185 begin
4186   if fFormat = aValue then
4187     exit;
4188   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4189     raise EglBitmapUnsupportedFormat.Create(Format);
4190   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4191 end;
4192
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4195 begin
4196   if fFreeDataAfterGenTexture = aValue then
4197     exit;
4198   fFreeDataAfterGenTexture := aValue;
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetID(const aValue: Cardinal);
4203 begin
4204   if fID = aValue then
4205     exit;
4206   fID := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4211 begin
4212   if fMipMap = aValue then
4213     exit;
4214   fMipMap := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4219 begin
4220   if fTarget = aValue then
4221     exit;
4222   fTarget := aValue;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4227 var
4228   MaxAnisotropic: Integer;
4229 begin
4230   fAnisotropic := aValue;
4231   if (ID > 0) then begin
4232     if GL_EXT_texture_filter_anisotropic then begin
4233       if fAnisotropic > 0 then begin
4234         Bind(false);
4235         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4236         if aValue > MaxAnisotropic then
4237           fAnisotropic := MaxAnisotropic;
4238         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4239       end;
4240     end else begin
4241       fAnisotropic := 0;
4242     end;
4243   end;
4244 end;
4245
4246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4247 procedure TglBitmap.CreateID;
4248 begin
4249   if (ID <> 0) then
4250     glDeleteTextures(1, @fID);
4251   glGenTextures(1, @fID);
4252   Bind(false);
4253 end;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4257 begin
4258   // Set Up Parameters
4259   SetWrap(fWrapS, fWrapT, fWrapR);
4260   SetFilter(fFilterMin, fFilterMag);
4261   SetAnisotropic(fAnisotropic);
4262   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4263
4264   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4265     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4266
4267   // Mip Maps Generation Mode
4268   aBuildWithGlu := false;
4269   if (MipMap = mmMipmap) then begin
4270     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4271       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4272     else
4273       aBuildWithGlu := true;
4274   end else if (MipMap = mmMipmapGlu) then
4275     aBuildWithGlu := true;
4276 end;
4277
4278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4279 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4280   const aWidth: Integer; const aHeight: Integer);
4281 var
4282   s: Single;
4283 begin
4284   if (Data <> aData) then begin
4285     if (Assigned(Data)) then
4286       FreeMem(Data);
4287     fData := aData;
4288   end;
4289
4290   if not Assigned(fData) then begin
4291     fPixelSize := 0;
4292     fRowSize   := 0;
4293   end else begin
4294     FillChar(fDimension, SizeOf(fDimension), 0);
4295     if aWidth <> -1 then begin
4296       fDimension.Fields := fDimension.Fields + [ffX];
4297       fDimension.X := aWidth;
4298     end;
4299
4300     if aHeight <> -1 then begin
4301       fDimension.Fields := fDimension.Fields + [ffY];
4302       fDimension.Y := aHeight;
4303     end;
4304
4305     s := TFormatDescriptor.Get(aFormat).PixelSize;
4306     fFormat    := aFormat;
4307     fPixelSize := Ceil(s);
4308     fRowSize   := Ceil(s * aWidth);
4309   end;
4310 end;
4311
4312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 function TglBitmap.FlipHorz: Boolean;
4314 begin
4315   result := false;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 function TglBitmap.FlipVert: Boolean;
4320 begin
4321   result := false;
4322 end;
4323
4324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4325 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 procedure TglBitmap.AfterConstruction;
4328 begin
4329   inherited AfterConstruction;
4330
4331   fID         := 0;
4332   fTarget     := 0;
4333   fIsResident := false;
4334
4335   fFormat                  := glBitmapGetDefaultFormat;
4336   fMipMap                  := glBitmapDefaultMipmap;
4337   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4338   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4339
4340   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4341   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4342   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4343 end;
4344
4345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4346 procedure TglBitmap.BeforeDestruction;
4347 var
4348   NewData: PByte;
4349 begin
4350   NewData := nil;
4351   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4352   if (fID > 0) and fDeleteTextureOnFree then
4353     glDeleteTextures(1, @fID);
4354   inherited BeforeDestruction;
4355 end;
4356
4357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4358 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4359 var
4360   TempPos: Integer;
4361 begin
4362   if not Assigned(aResType) then begin
4363     TempPos   := Pos('.', aResource);
4364     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4365     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4366   end;
4367 end;
4368
4369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4370 procedure TglBitmap.LoadFromFile(const aFilename: String);
4371 var
4372   fs: TFileStream;
4373 begin
4374   if not FileExists(aFilename) then
4375     raise EglBitmap.Create('file does not exist: ' + aFilename);
4376   fFilename := aFilename;
4377   fs := TFileStream.Create(fFilename, fmOpenRead);
4378   try
4379     fs.Position := 0;
4380     LoadFromStream(fs);
4381   finally
4382     fs.Free;
4383   end;
4384 end;
4385
4386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4387 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4388 begin
4389   {$IFDEF GLB_SUPPORT_PNG_READ}
4390   if not LoadPNG(aStream) then
4391   {$ENDIF}
4392   {$IFDEF GLB_SUPPORT_JPEG_READ}
4393   if not LoadJPEG(aStream) then
4394   {$ENDIF}
4395   if not LoadDDS(aStream) then
4396   if not LoadTGA(aStream) then
4397   if not LoadBMP(aStream) then
4398     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4403   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4404 var
4405   tmpData: PByte;
4406   size: Integer;
4407 begin
4408   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4409   GetMem(tmpData, size);
4410   try
4411     FillChar(tmpData^, size, #$FF);
4412     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4413   except
4414     if Assigned(tmpData) then
4415       FreeMem(tmpData);
4416     raise;
4417   end;
4418   AddFunc(Self, aFunc, false, Format, aArgs);
4419 end;
4420
4421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4422 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4423 var
4424   rs: TResourceStream;
4425 begin
4426   PrepareResType(aResource, aResType);
4427   rs := TResourceStream.Create(aInstance, aResource, aResType);
4428   try
4429     LoadFromStream(rs);
4430   finally
4431     rs.Free;
4432   end;
4433 end;
4434
4435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4436 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4437 var
4438   rs: TResourceStream;
4439 begin
4440   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4441   try
4442     LoadFromStream(rs);
4443   finally
4444     rs.Free;
4445   end;
4446 end;
4447
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4450 var
4451   fs: TFileStream;
4452 begin
4453   fs := TFileStream.Create(aFileName, fmCreate);
4454   try
4455     fs.Position := 0;
4456     SaveToStream(fs, aFileType);
4457   finally
4458     fs.Free;
4459   end;
4460 end;
4461
4462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4463 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4464 begin
4465   case aFileType of
4466     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4467     ftPNG:  SavePNG(aStream);
4468     {$ENDIF}
4469     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4470     ftJPEG: SaveJPEG(aStream);
4471     {$ENDIF}
4472     ftDDS:  SaveDDS(aStream);
4473     ftTGA:  SaveTGA(aStream);
4474     ftBMP:  SaveBMP(aStream);
4475   end;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4480 begin
4481   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4482 end;
4483
4484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4485 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4486   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4487 var
4488   DestData, TmpData, SourceData: pByte;
4489   TempHeight, TempWidth: Integer;
4490   SourceFD, DestFD: TFormatDescriptor;
4491   SourceMD, DestMD: Pointer;
4492
4493   FuncRec: TglBitmapFunctionRec;
4494 begin
4495   Assert(Assigned(Data));
4496   Assert(Assigned(aSource));
4497   Assert(Assigned(aSource.Data));
4498
4499   result := false;
4500   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4501     SourceFD := TFormatDescriptor.Get(aSource.Format);
4502     DestFD   := TFormatDescriptor.Get(aFormat);
4503
4504     if (SourceFD.IsCompressed) then
4505       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4506     if (DestFD.IsCompressed) then
4507       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4508
4509     // inkompatible Formats so CreateTemp
4510     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4511       aCreateTemp := true;
4512
4513     // Values
4514     TempHeight := Max(1, aSource.Height);
4515     TempWidth  := Max(1, aSource.Width);
4516
4517     FuncRec.Sender := Self;
4518     FuncRec.Args   := aArgs;
4519
4520     TmpData := nil;
4521     if aCreateTemp then begin
4522       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4523       DestData := TmpData;
4524     end else
4525       DestData := Data;
4526
4527     try
4528       SourceFD.PreparePixel(FuncRec.Source);
4529       DestFD.PreparePixel  (FuncRec.Dest);
4530
4531       SourceMD := SourceFD.CreateMappingData;
4532       DestMD   := DestFD.CreateMappingData;
4533
4534       FuncRec.Size            := aSource.Dimension;
4535       FuncRec.Position.Fields := FuncRec.Size.Fields;
4536
4537       try
4538         SourceData := aSource.Data;
4539         FuncRec.Position.Y := 0;
4540         while FuncRec.Position.Y < TempHeight do begin
4541           FuncRec.Position.X := 0;
4542           while FuncRec.Position.X < TempWidth do begin
4543             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4544             aFunc(FuncRec);
4545             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4546             inc(FuncRec.Position.X);
4547           end;
4548           inc(FuncRec.Position.Y);
4549         end;
4550
4551         // Updating Image or InternalFormat
4552         if aCreateTemp then
4553           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4554         else if (aFormat <> fFormat) then
4555           Format := aFormat;
4556
4557         result := true;
4558       finally
4559         SourceFD.FreeMappingData(SourceMD);
4560         DestFD.FreeMappingData(DestMD);
4561       end;
4562     except
4563       if aCreateTemp and Assigned(TmpData) then
4564         FreeMem(TmpData);
4565       raise;
4566     end;
4567   end;
4568 end;
4569
4570 {$IFDEF GLB_SDL}
4571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4572 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4573 var
4574   Row, RowSize: Integer;
4575   SourceData, TmpData: PByte;
4576   TempDepth: Integer;
4577   FormatDesc: TFormatDescriptor;
4578
4579   function GetRowPointer(Row: Integer): pByte;
4580   begin
4581     result := aSurface.pixels;
4582     Inc(result, Row * RowSize);
4583   end;
4584
4585 begin
4586   result := false;
4587
4588   FormatDesc := TFormatDescriptor.Get(Format);
4589   if FormatDesc.IsCompressed then
4590     raise EglBitmapUnsupportedFormat.Create(Format);
4591
4592   if Assigned(Data) then begin
4593     case Trunc(FormatDesc.PixelSize) of
4594       1: TempDepth :=  8;
4595       2: TempDepth := 16;
4596       3: TempDepth := 24;
4597       4: TempDepth := 32;
4598     else
4599       raise EglBitmapUnsupportedFormat.Create(Format);
4600     end;
4601
4602     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4603       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4604     SourceData := Data;
4605     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4606
4607     for Row := 0 to FileHeight-1 do begin
4608       TmpData := GetRowPointer(Row);
4609       if Assigned(TmpData) then begin
4610         Move(SourceData^, TmpData^, RowSize);
4611         inc(SourceData, RowSize);
4612       end;
4613     end;
4614     result := true;
4615   end;
4616 end;
4617
4618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4619 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4620 var
4621   pSource, pData, pTempData: PByte;
4622   Row, RowSize, TempWidth, TempHeight: Integer;
4623   IntFormat: TglBitmapFormat;
4624   FormatDesc: TFormatDescriptor;
4625
4626   function GetRowPointer(Row: Integer): pByte;
4627   begin
4628     result := aSurface^.pixels;
4629     Inc(result, Row * RowSize);
4630   end;
4631
4632 begin
4633   result := false;
4634   if (Assigned(aSurface)) then begin
4635     with aSurface^.format^ do begin
4636       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4637         FormatDesc := TFormatDescriptor.Get(IntFormat);
4638         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4639           break;
4640       end;
4641       if (IntFormat = tfEmpty) then
4642         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4643     end;
4644
4645     TempWidth  := aSurface^.w;
4646     TempHeight := aSurface^.h;
4647     RowSize := FormatDesc.GetSize(TempWidth, 1);
4648     GetMem(pData, TempHeight * RowSize);
4649     try
4650       pTempData := pData;
4651       for Row := 0 to TempHeight -1 do begin
4652         pSource := GetRowPointer(Row);
4653         if (Assigned(pSource)) then begin
4654           Move(pSource^, pTempData^, RowSize);
4655           Inc(pTempData, RowSize);
4656         end;
4657       end;
4658       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4659       result := true;
4660     except
4661       if Assigned(pData) then
4662         FreeMem(pData);
4663       raise;
4664     end;
4665   end;
4666 end;
4667
4668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4669 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4670 var
4671   Row, Col, AlphaInterleave: Integer;
4672   pSource, pDest: PByte;
4673
4674   function GetRowPointer(Row: Integer): pByte;
4675   begin
4676     result := aSurface.pixels;
4677     Inc(result, Row * Width);
4678   end;
4679
4680 begin
4681   result := false;
4682   if Assigned(Data) then begin
4683     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4684       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4685
4686       AlphaInterleave := 0;
4687       case Format of
4688         tfLuminance8Alpha8:
4689           AlphaInterleave := 1;
4690         tfBGRA8, tfRGBA8:
4691           AlphaInterleave := 3;
4692       end;
4693
4694       pSource := Data;
4695       for Row := 0 to Height -1 do begin
4696         pDest := GetRowPointer(Row);
4697         if Assigned(pDest) then begin
4698           for Col := 0 to Width -1 do begin
4699             Inc(pSource, AlphaInterleave);
4700             pDest^ := pSource^;
4701             Inc(pDest);
4702             Inc(pSource);
4703           end;
4704         end;
4705       end;
4706       result := true;
4707     end;
4708   end;
4709 end;
4710
4711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4712 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4713 var
4714   bmp: TglBitmap2D;
4715 begin
4716   bmp := TglBitmap2D.Create;
4717   try
4718     bmp.AssignFromSurface(aSurface);
4719     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4720   finally
4721     bmp.Free;
4722   end;
4723 end;
4724 {$ENDIF}
4725
4726 {$IFDEF GLB_DELPHI}
4727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4728 function CreateGrayPalette: HPALETTE;
4729 var
4730   Idx: Integer;
4731   Pal: PLogPalette;
4732 begin
4733   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4734
4735   Pal.palVersion := $300;
4736   Pal.palNumEntries := 256;
4737
4738   for Idx := 0 to Pal.palNumEntries - 1 do begin
4739     Pal.palPalEntry[Idx].peRed   := Idx;
4740     Pal.palPalEntry[Idx].peGreen := Idx;
4741     Pal.palPalEntry[Idx].peBlue  := Idx;
4742     Pal.palPalEntry[Idx].peFlags := 0;
4743   end;
4744   Result := CreatePalette(Pal^);
4745   FreeMem(Pal);
4746 end;
4747
4748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4749 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4750 var
4751   Row: Integer;
4752   pSource, pData: PByte;
4753 begin
4754   result := false;
4755   if Assigned(Data) then begin
4756     if Assigned(aBitmap) then begin
4757       aBitmap.Width  := Width;
4758       aBitmap.Height := Height;
4759
4760       case Format of
4761         tfAlpha8, tfLuminance8: begin
4762           aBitmap.PixelFormat := pf8bit;
4763           aBitmap.Palette     := CreateGrayPalette;
4764         end;
4765         tfRGB5A1:
4766           aBitmap.PixelFormat := pf15bit;
4767         tfR5G6B5:
4768           aBitmap.PixelFormat := pf16bit;
4769         tfRGB8, tfBGR8:
4770           aBitmap.PixelFormat := pf24bit;
4771         tfRGBA8, tfBGRA8:
4772           aBitmap.PixelFormat := pf32bit;
4773       else
4774         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4775       end;
4776
4777       pSource := Data;
4778       for Row := 0 to FileHeight -1 do begin
4779         pData := aBitmap.Scanline[Row];
4780         Move(pSource^, pData^, fRowSize);
4781         Inc(pSource, fRowSize);
4782         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4783           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4784       end;
4785       result := true;
4786     end;
4787   end;
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4792 var
4793   pSource, pData, pTempData: PByte;
4794   Row, RowSize, TempWidth, TempHeight: Integer;
4795   IntFormat: TglBitmapFormat;
4796 begin
4797   result := false;
4798
4799   if (Assigned(aBitmap)) then begin
4800     case aBitmap.PixelFormat of
4801       pf8bit:
4802         IntFormat := tfLuminance8;
4803       pf15bit:
4804         IntFormat := tfRGB5A1;
4805       pf16bit:
4806         IntFormat := tfR5G6B5;
4807       pf24bit:
4808         IntFormat := tfBGR8;
4809       pf32bit:
4810         IntFormat := tfBGRA8;
4811     else
4812       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4813     end;
4814
4815     TempWidth  := aBitmap.Width;
4816     TempHeight := aBitmap.Height;
4817     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4818     GetMem(pData, TempHeight * RowSize);
4819     try
4820       pTempData := pData;
4821       for Row := 0 to TempHeight -1 do begin
4822         pSource := aBitmap.Scanline[Row];
4823         if (Assigned(pSource)) then begin
4824           Move(pSource^, pTempData^, RowSize);
4825           Inc(pTempData, RowSize);
4826         end;
4827       end;
4828       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4829       result := true;
4830     except
4831       if Assigned(pData) then
4832         FreeMem(pData);
4833       raise;
4834     end;
4835   end;
4836 end;
4837
4838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4839 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4840 var
4841   Row, Col, AlphaInterleave: Integer;
4842   pSource, pDest: PByte;
4843 begin
4844   result := false;
4845
4846   if Assigned(Data) then begin
4847     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4848       if Assigned(aBitmap) then begin
4849         aBitmap.PixelFormat := pf8bit;
4850         aBitmap.Palette     := CreateGrayPalette;
4851         aBitmap.Width       := Width;
4852         aBitmap.Height      := Height;
4853
4854         case Format of
4855           tfLuminance8Alpha8:
4856             AlphaInterleave := 1;
4857           tfRGBA8, tfBGRA8:
4858             AlphaInterleave := 3;
4859           else
4860             AlphaInterleave := 0;
4861         end;
4862
4863         // Copy Data
4864         pSource := Data;
4865
4866         for Row := 0 to Height -1 do begin
4867           pDest := aBitmap.Scanline[Row];
4868           if Assigned(pDest) then begin
4869             for Col := 0 to Width -1 do begin
4870               Inc(pSource, AlphaInterleave);
4871               pDest^ := pSource^;
4872               Inc(pDest);
4873               Inc(pSource);
4874             end;
4875           end;
4876         end;
4877         result := true;
4878       end;
4879     end;
4880   end;
4881 end;
4882
4883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4884 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4885 var
4886   tex: TglBitmap2D;
4887 begin
4888   tex := TglBitmap2D.Create;
4889   try
4890     tex.AssignFromBitmap(ABitmap);
4891     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4892   finally
4893     tex.Free;
4894   end;
4895 end;
4896 {$ENDIF}
4897
4898 {$IFDEF GLB_LAZARUS}
4899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4900 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4901 var
4902   rid: TRawImageDescription;
4903   FormatDesc: TFormatDescriptor;
4904 begin
4905   result := false;
4906   if not Assigned(aImage) or (Format = tfEmpty) then
4907     exit;
4908   FormatDesc := TFormatDescriptor.Get(Format);
4909   if FormatDesc.IsCompressed then
4910     exit;
4911
4912   FillChar(rid{%H-}, SizeOf(rid), 0);
4913   if (Format in [
4914        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4915        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4916        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4917     rid.Format := ricfGray
4918   else
4919     rid.Format := ricfRGBA;
4920
4921   rid.Width        := Width;
4922   rid.Height       := Height;
4923   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4924   rid.BitOrder     := riboBitsInOrder;
4925   rid.ByteOrder    := riboLSBFirst;
4926   rid.LineOrder    := riloTopToBottom;
4927   rid.LineEnd      := rileTight;
4928   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4929   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4930   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4931   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4932   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4933   rid.RedShift     := FormatDesc.Shift.r;
4934   rid.GreenShift   := FormatDesc.Shift.g;
4935   rid.BlueShift    := FormatDesc.Shift.b;
4936   rid.AlphaShift   := FormatDesc.Shift.a;
4937
4938   rid.MaskBitsPerPixel  := 0;
4939   rid.PaletteColorCount := 0;
4940
4941   aImage.DataDescription := rid;
4942   aImage.CreateData;
4943
4944   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4945
4946   result := true;
4947 end;
4948
4949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4950 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4951 var
4952   f: TglBitmapFormat;
4953   FormatDesc: TFormatDescriptor;
4954   ImageData: PByte;
4955   ImageSize: Integer;
4956 begin
4957   result := false;
4958   if not Assigned(aImage) then
4959     exit;
4960   for f := High(f) downto Low(f) do begin
4961     FormatDesc := TFormatDescriptor.Get(f);
4962     with aImage.DataDescription do
4963       if FormatDesc.MaskMatch(
4964         (QWord(1 shl RedPrec  )-1) shl RedShift,
4965         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4966         (QWord(1 shl BluePrec )-1) shl BlueShift,
4967         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4968         break;
4969   end;
4970
4971   if (f = tfEmpty) then
4972     exit;
4973
4974   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4975   ImageData := GetMem(ImageSize);
4976   try
4977     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4978     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4979   except
4980     if Assigned(ImageData) then
4981       FreeMem(ImageData);
4982     raise;
4983   end;
4984
4985   result := true;
4986 end;
4987
4988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4989 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4990 var
4991   rid: TRawImageDescription;
4992   FormatDesc: TFormatDescriptor;
4993   Pixel: TglBitmapPixelData;
4994   x, y: Integer;
4995   srcMD: Pointer;
4996   src, dst: PByte;
4997 begin
4998   result := false;
4999   if not Assigned(aImage) or (Format = tfEmpty) then
5000     exit;
5001   FormatDesc := TFormatDescriptor.Get(Format);
5002   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5003     exit;
5004
5005   FillChar(rid{%H-}, SizeOf(rid), 0);
5006   rid.Format       := ricfGray;
5007   rid.Width        := Width;
5008   rid.Height       := Height;
5009   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5010   rid.BitOrder     := riboBitsInOrder;
5011   rid.ByteOrder    := riboLSBFirst;
5012   rid.LineOrder    := riloTopToBottom;
5013   rid.LineEnd      := rileTight;
5014   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5015   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5016   rid.GreenPrec    := 0;
5017   rid.BluePrec     := 0;
5018   rid.AlphaPrec    := 0;
5019   rid.RedShift     := 0;
5020   rid.GreenShift   := 0;
5021   rid.BlueShift    := 0;
5022   rid.AlphaShift   := 0;
5023
5024   rid.MaskBitsPerPixel  := 0;
5025   rid.PaletteColorCount := 0;
5026
5027   aImage.DataDescription := rid;
5028   aImage.CreateData;
5029
5030   srcMD := FormatDesc.CreateMappingData;
5031   try
5032     FormatDesc.PreparePixel(Pixel);
5033     src := Data;
5034     dst := aImage.PixelData;
5035     for y := 0 to Height-1 do
5036       for x := 0 to Width-1 do begin
5037         FormatDesc.Unmap(src, Pixel, srcMD);
5038         case rid.BitsPerPixel of
5039            8: begin
5040             dst^ := Pixel.Data.a;
5041             inc(dst);
5042           end;
5043           16: begin
5044             PWord(dst)^ := Pixel.Data.a;
5045             inc(dst, 2);
5046           end;
5047           24: begin
5048             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5049             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5050             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5051             inc(dst, 3);
5052           end;
5053           32: begin
5054             PCardinal(dst)^ := Pixel.Data.a;
5055             inc(dst, 4);
5056           end;
5057         else
5058           raise EglBitmapUnsupportedFormat.Create(Format);
5059         end;
5060       end;
5061   finally
5062     FormatDesc.FreeMappingData(srcMD);
5063   end;
5064   result := true;
5065 end;
5066
5067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5068 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5069 var
5070   tex: TglBitmap2D;
5071 begin
5072   tex := TglBitmap2D.Create;
5073   try
5074     tex.AssignFromLazIntfImage(aImage);
5075     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5076   finally
5077     tex.Free;
5078   end;
5079 end;
5080 {$ENDIF}
5081
5082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5083 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5084   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5085 var
5086   rs: TResourceStream;
5087 begin
5088   PrepareResType(aResource, aResType);
5089   rs := TResourceStream.Create(aInstance, aResource, aResType);
5090   try
5091     result := AddAlphaFromStream(rs, aFunc, aArgs);
5092   finally
5093     rs.Free;
5094   end;
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5099   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5100 var
5101   rs: TResourceStream;
5102 begin
5103   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5104   try
5105     result := AddAlphaFromStream(rs, aFunc, aArgs);
5106   finally
5107     rs.Free;
5108   end;
5109 end;
5110
5111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5112 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5113 begin
5114   if TFormatDescriptor.Get(Format).IsCompressed then
5115     raise EglBitmapUnsupportedFormat.Create(Format);
5116   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5117 end;
5118
5119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5120 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5121 var
5122   FS: TFileStream;
5123 begin
5124   FS := TFileStream.Create(aFileName, fmOpenRead);
5125   try
5126     result := AddAlphaFromStream(FS, aFunc, aArgs);
5127   finally
5128     FS.Free;
5129   end;
5130 end;
5131
5132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5133 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5134 var
5135   tex: TglBitmap2D;
5136 begin
5137   tex := TglBitmap2D.Create(aStream);
5138   try
5139     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5140   finally
5141     tex.Free;
5142   end;
5143 end;
5144
5145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5146 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5147 var
5148   DestData, DestData2, SourceData: pByte;
5149   TempHeight, TempWidth: Integer;
5150   SourceFD, DestFD: TFormatDescriptor;
5151   SourceMD, DestMD, DestMD2: Pointer;
5152
5153   FuncRec: TglBitmapFunctionRec;
5154 begin
5155   result := false;
5156
5157   Assert(Assigned(Data));
5158   Assert(Assigned(aBitmap));
5159   Assert(Assigned(aBitmap.Data));
5160
5161   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5162     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5163
5164     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5165     DestFD   := TFormatDescriptor.Get(Format);
5166
5167     if not Assigned(aFunc) then begin
5168       aFunc        := glBitmapAlphaFunc;
5169       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5170     end else
5171       FuncRec.Args := aArgs;
5172
5173     // Values
5174     TempHeight := aBitmap.FileHeight;
5175     TempWidth  := aBitmap.FileWidth;
5176
5177     FuncRec.Sender          := Self;
5178     FuncRec.Size            := Dimension;
5179     FuncRec.Position.Fields := FuncRec.Size.Fields;
5180
5181     DestData   := Data;
5182     DestData2  := Data;
5183     SourceData := aBitmap.Data;
5184
5185     // Mapping
5186     SourceFD.PreparePixel(FuncRec.Source);
5187     DestFD.PreparePixel  (FuncRec.Dest);
5188
5189     SourceMD := SourceFD.CreateMappingData;
5190     DestMD   := DestFD.CreateMappingData;
5191     DestMD2  := DestFD.CreateMappingData;
5192     try
5193       FuncRec.Position.Y := 0;
5194       while FuncRec.Position.Y < TempHeight do begin
5195         FuncRec.Position.X := 0;
5196         while FuncRec.Position.X < TempWidth do begin
5197           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5198           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5199           aFunc(FuncRec);
5200           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5201           inc(FuncRec.Position.X);
5202         end;
5203         inc(FuncRec.Position.Y);
5204       end;
5205     finally
5206       SourceFD.FreeMappingData(SourceMD);
5207       DestFD.FreeMappingData(DestMD);
5208       DestFD.FreeMappingData(DestMD2);
5209     end;
5210   end;
5211 end;
5212
5213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5214 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5215 begin
5216   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5217 end;
5218
5219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5220 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5221 var
5222   PixelData: TglBitmapPixelData;
5223 begin
5224   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5225   result := AddAlphaFromColorKeyFloat(
5226     aRed   / PixelData.Range.r,
5227     aGreen / PixelData.Range.g,
5228     aBlue  / PixelData.Range.b,
5229     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5230 end;
5231
5232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5233 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5234 var
5235   values: array[0..2] of Single;
5236   tmp: Cardinal;
5237   i: Integer;
5238   PixelData: TglBitmapPixelData;
5239 begin
5240   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5241   with PixelData do begin
5242     values[0] := aRed;
5243     values[1] := aGreen;
5244     values[2] := aBlue;
5245
5246     for i := 0 to 2 do begin
5247       tmp          := Trunc(Range.arr[i] * aDeviation);
5248       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5249       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5250     end;
5251     Data.a  := 0;
5252     Range.a := 0;
5253   end;
5254   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5255 end;
5256
5257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5258 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5259 begin
5260   result := AddAlphaFromValueFloat(aAlpha / $FF);
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5265 var
5266   PixelData: TglBitmapPixelData;
5267 begin
5268   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5269   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5270 end;
5271
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5274 var
5275   PixelData: TglBitmapPixelData;
5276 begin
5277   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5278   with PixelData do
5279     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5280   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 function TglBitmap.RemoveAlpha: Boolean;
5285 var
5286   FormatDesc: TFormatDescriptor;
5287 begin
5288   result := false;
5289   FormatDesc := TFormatDescriptor.Get(Format);
5290   if Assigned(Data) then begin
5291     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5292       raise EglBitmapUnsupportedFormat.Create(Format);
5293     result := ConvertTo(FormatDesc.WithoutAlpha);
5294   end;
5295 end;
5296
5297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5298 function TglBitmap.Clone: TglBitmap;
5299 var
5300   Temp: TglBitmap;
5301   TempPtr: PByte;
5302   Size: Integer;
5303 begin
5304   result := nil;
5305   Temp := (ClassType.Create as TglBitmap);
5306   try
5307     // copy texture data if assigned
5308     if Assigned(Data) then begin
5309       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5310       GetMem(TempPtr, Size);
5311       try
5312         Move(Data^, TempPtr^, Size);
5313         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5314       except
5315         if Assigned(TempPtr) then
5316           FreeMem(TempPtr);
5317         raise;
5318       end;
5319     end else begin
5320       TempPtr := nil;
5321       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5322     end;
5323
5324         // copy properties
5325     Temp.fID                      := ID;
5326     Temp.fTarget                  := Target;
5327     Temp.fFormat                  := Format;
5328     Temp.fMipMap                  := MipMap;
5329     Temp.fAnisotropic             := Anisotropic;
5330     Temp.fBorderColor             := fBorderColor;
5331     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5332     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5333     Temp.fFilterMin               := fFilterMin;
5334     Temp.fFilterMag               := fFilterMag;
5335     Temp.fWrapS                   := fWrapS;
5336     Temp.fWrapT                   := fWrapT;
5337     Temp.fWrapR                   := fWrapR;
5338     Temp.fFilename                := fFilename;
5339     Temp.fCustomName              := fCustomName;
5340     Temp.fCustomNameW             := fCustomNameW;
5341     Temp.fCustomData              := fCustomData;
5342
5343     result := Temp;
5344   except
5345     FreeAndNil(Temp);
5346     raise;
5347   end;
5348 end;
5349
5350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5351 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5352 var
5353   SourceFD, DestFD: TFormatDescriptor;
5354   SourcePD, DestPD: TglBitmapPixelData;
5355   ShiftData: TShiftData;
5356
5357   function CanCopyDirect: Boolean;
5358   begin
5359     result :=
5360       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5361       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5362       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5363       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5364   end;
5365
5366   function CanShift: Boolean;
5367   begin
5368     result :=
5369       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5370       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5371       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5372       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5373   end;
5374
5375   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5376   begin
5377     result := 0;
5378     while (aSource > aDest) and (aSource > 0) do begin
5379       inc(result);
5380       aSource := aSource shr 1;
5381     end;
5382   end;
5383
5384 begin
5385   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5386     SourceFD := TFormatDescriptor.Get(Format);
5387     DestFD   := TFormatDescriptor.Get(aFormat);
5388
5389     SourceFD.PreparePixel(SourcePD);
5390     DestFD.PreparePixel  (DestPD);
5391
5392     if CanCopyDirect then
5393       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5394     else if CanShift then begin
5395       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5396       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5397       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5398       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5399       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5400     end else
5401       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5402   end else
5403     result := true;
5404 end;
5405
5406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5407 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5408 begin
5409   if aUseRGB or aUseAlpha then
5410     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5411       ((Byte(aUseAlpha) and 1) shl 1) or
5412        (Byte(aUseRGB)   and 1)      ));
5413 end;
5414
5415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5417 begin
5418   fBorderColor[0] := aRed;
5419   fBorderColor[1] := aGreen;
5420   fBorderColor[2] := aBlue;
5421   fBorderColor[3] := aAlpha;
5422   if (ID > 0) then begin
5423     Bind(false);
5424     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5425   end;
5426 end;
5427
5428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5429 procedure TglBitmap.FreeData;
5430 var
5431   TempPtr: PByte;
5432 begin
5433   TempPtr := nil;
5434   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5439   const aAlpha: Byte);
5440 begin
5441   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5442 end;
5443
5444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5445 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5446 var
5447   PixelData: TglBitmapPixelData;
5448 begin
5449   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5450   FillWithColorFloat(
5451     aRed   / PixelData.Range.r,
5452     aGreen / PixelData.Range.g,
5453     aBlue  / PixelData.Range.b,
5454     aAlpha / PixelData.Range.a);
5455 end;
5456
5457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5458 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5459 var
5460   PixelData: TglBitmapPixelData;
5461 begin
5462   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5463   with PixelData do begin
5464     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5465     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5466     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5467     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5468   end;
5469   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5470 end;
5471
5472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5473 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5474 begin
5475   //check MIN filter
5476   case aMin of
5477     GL_NEAREST:
5478       fFilterMin := GL_NEAREST;
5479     GL_LINEAR:
5480       fFilterMin := GL_LINEAR;
5481     GL_NEAREST_MIPMAP_NEAREST:
5482       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5483     GL_LINEAR_MIPMAP_NEAREST:
5484       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5485     GL_NEAREST_MIPMAP_LINEAR:
5486       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5487     GL_LINEAR_MIPMAP_LINEAR:
5488       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5489     else
5490       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5491   end;
5492
5493   //check MAG filter
5494   case aMag of
5495     GL_NEAREST:
5496       fFilterMag := GL_NEAREST;
5497     GL_LINEAR:
5498       fFilterMag := GL_LINEAR;
5499     else
5500       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5501   end;
5502
5503   //apply filter
5504   if (ID > 0) then begin
5505     Bind(false);
5506     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5507
5508     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5509       case fFilterMin of
5510         GL_NEAREST, GL_LINEAR:
5511           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5512         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5513           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5514         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5515           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5516       end;
5517     end else
5518       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5519   end;
5520 end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5524
5525   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5526   begin
5527     case aValue of
5528       GL_CLAMP:
5529         aTarget := GL_CLAMP;
5530
5531       GL_REPEAT:
5532         aTarget := GL_REPEAT;
5533
5534       GL_CLAMP_TO_EDGE: begin
5535         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5536           aTarget := GL_CLAMP_TO_EDGE
5537         else
5538           aTarget := GL_CLAMP;
5539       end;
5540
5541       GL_CLAMP_TO_BORDER: begin
5542         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5543           aTarget := GL_CLAMP_TO_BORDER
5544         else
5545           aTarget := GL_CLAMP;
5546       end;
5547
5548       GL_MIRRORED_REPEAT: begin
5549         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5550           aTarget := GL_MIRRORED_REPEAT
5551         else
5552           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5553       end;
5554     else
5555       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5556     end;
5557   end;
5558
5559 begin
5560   CheckAndSetWrap(S, fWrapS);
5561   CheckAndSetWrap(T, fWrapT);
5562   CheckAndSetWrap(R, fWrapR);
5563
5564   if (ID > 0) then begin
5565     Bind(false);
5566     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5567     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5568     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5569   end;
5570 end;
5571
5572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5573 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5574
5575   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5576   begin
5577     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5578        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5579       fSwizzle[aIndex] := aValue
5580     else
5581       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5582   end;
5583
5584 begin
5585   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5586     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5587   CheckAndSetValue(r, 0);
5588   CheckAndSetValue(g, 1);
5589   CheckAndSetValue(b, 2);
5590   CheckAndSetValue(a, 3);
5591
5592   if (ID > 0) then begin
5593     Bind(false);
5594     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5595   end;
5596 end;
5597
5598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5599 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5600 begin
5601   if aEnableTextureUnit then
5602     glEnable(Target);
5603   if (ID > 0) then
5604     glBindTexture(Target, ID);
5605 end;
5606
5607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5608 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5609 begin
5610   if aDisableTextureUnit then
5611     glDisable(Target);
5612   glBindTexture(Target, 0);
5613 end;
5614
5615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5616 constructor TglBitmap.Create;
5617 begin
5618   if (ClassType = TglBitmap) then
5619     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5620 {$IFDEF GLB_NATIVE_OGL}
5621   glbReadOpenGLExtensions;
5622 {$ENDIF}
5623   inherited Create;
5624 end;
5625
5626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5627 constructor TglBitmap.Create(const aFileName: String);
5628 begin
5629   Create;
5630   LoadFromFile(aFileName);
5631 end;
5632
5633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5634 constructor TglBitmap.Create(const aStream: TStream);
5635 begin
5636   Create;
5637   LoadFromStream(aStream);
5638 end;
5639
5640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5641 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5642 var
5643   Image: PByte;
5644   ImageSize: Integer;
5645 begin
5646   Create;
5647   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5648   GetMem(Image, ImageSize);
5649   try
5650     FillChar(Image^, ImageSize, #$FF);
5651     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5652   except
5653     if Assigned(Image) then
5654       FreeMem(Image);
5655     raise;
5656   end;
5657 end;
5658
5659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5660 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5661   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5662 begin
5663   Create;
5664   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5665 end;
5666
5667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5668 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5669 begin
5670   Create;
5671   LoadFromResource(aInstance, aResource, aResType);
5672 end;
5673
5674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5675 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5676 begin
5677   Create;
5678   LoadFromResourceID(aInstance, aResourceID, aResType);
5679 end;
5680
5681 {$IFDEF GLB_SUPPORT_PNG_READ}
5682 {$IF DEFINED(GLB_LAZ_PNG)}
5683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5684 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5686 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5687 const
5688   MAGIC_LEN = 8;
5689   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5690 var
5691   png: TPortableNetworkGraphic;
5692   intf: TLazIntfImage;
5693   StreamPos: Int64;
5694   magic: String[MAGIC_LEN];
5695 begin
5696   result := true;
5697   StreamPos := aStream.Position;
5698
5699   SetLength(magic, MAGIC_LEN);
5700   aStream.Read(magic[1], MAGIC_LEN);
5701   aStream.Position := StreamPos;
5702   if (magic <> PNG_MAGIC) then begin
5703     result := false;
5704     exit;
5705   end;
5706
5707   png := TPortableNetworkGraphic.Create;
5708   try try
5709     png.LoadFromStream(aStream);
5710     intf := png.CreateIntfImage;
5711     try try
5712       AssignFromLazIntfImage(intf);
5713     except
5714       result := false;
5715       aStream.Position := StreamPos;
5716       exit;
5717     end;
5718     finally
5719       intf.Free;
5720     end;
5721   except
5722     result := false;
5723     aStream.Position := StreamPos;
5724     exit;
5725   end;
5726   finally
5727     png.Free;
5728   end;
5729 end;
5730
5731 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5733 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5734 var
5735   Surface: PSDL_Surface;
5736   RWops: PSDL_RWops;
5737 begin
5738   result := false;
5739   RWops := glBitmapCreateRWops(aStream);
5740   try
5741     if IMG_isPNG(RWops) > 0 then begin
5742       Surface := IMG_LoadPNG_RW(RWops);
5743       try
5744         AssignFromSurface(Surface);
5745         result := true;
5746       finally
5747         SDL_FreeSurface(Surface);
5748       end;
5749     end;
5750   finally
5751     SDL_FreeRW(RWops);
5752   end;
5753 end;
5754
5755 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5757 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5758 begin
5759   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5760 end;
5761
5762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5763 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5764 var
5765   StreamPos: Int64;
5766   signature: array [0..7] of byte;
5767   png: png_structp;
5768   png_info: png_infop;
5769
5770   TempHeight, TempWidth: Integer;
5771   Format: TglBitmapFormat;
5772
5773   png_data: pByte;
5774   png_rows: array of pByte;
5775   Row, LineSize: Integer;
5776 begin
5777   result := false;
5778
5779   if not init_libPNG then
5780     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5781
5782   try
5783     // signature
5784     StreamPos := aStream.Position;
5785     aStream.Read(signature{%H-}, 8);
5786     aStream.Position := StreamPos;
5787
5788     if png_check_sig(@signature, 8) <> 0 then begin
5789       // png read struct
5790       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5791       if png = nil then
5792         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5793
5794       // png info
5795       png_info := png_create_info_struct(png);
5796       if png_info = nil then begin
5797         png_destroy_read_struct(@png, nil, nil);
5798         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5799       end;
5800
5801       // set read callback
5802       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5803
5804       // read informations
5805       png_read_info(png, png_info);
5806
5807       // size
5808       TempHeight := png_get_image_height(png, png_info);
5809       TempWidth := png_get_image_width(png, png_info);
5810
5811       // format
5812       case png_get_color_type(png, png_info) of
5813         PNG_COLOR_TYPE_GRAY:
5814           Format := tfLuminance8;
5815         PNG_COLOR_TYPE_GRAY_ALPHA:
5816           Format := tfLuminance8Alpha8;
5817         PNG_COLOR_TYPE_RGB:
5818           Format := tfRGB8;
5819         PNG_COLOR_TYPE_RGB_ALPHA:
5820           Format := tfRGBA8;
5821         else
5822           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5823       end;
5824
5825       // cut upper 8 bit from 16 bit formats
5826       if png_get_bit_depth(png, png_info) > 8 then
5827         png_set_strip_16(png);
5828
5829       // expand bitdepth smaller than 8
5830       if png_get_bit_depth(png, png_info) < 8 then
5831         png_set_expand(png);
5832
5833       // allocating mem for scanlines
5834       LineSize := png_get_rowbytes(png, png_info);
5835       GetMem(png_data, TempHeight * LineSize);
5836       try
5837         SetLength(png_rows, TempHeight);
5838         for Row := Low(png_rows) to High(png_rows) do begin
5839           png_rows[Row] := png_data;
5840           Inc(png_rows[Row], Row * LineSize);
5841         end;
5842
5843         // read complete image into scanlines
5844         png_read_image(png, @png_rows[0]);
5845
5846         // read end
5847         png_read_end(png, png_info);
5848
5849         // destroy read struct
5850         png_destroy_read_struct(@png, @png_info, nil);
5851
5852         SetLength(png_rows, 0);
5853
5854         // set new data
5855         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5856
5857         result := true;
5858       except
5859         if Assigned(png_data) then
5860           FreeMem(png_data);
5861         raise;
5862       end;
5863     end;
5864   finally
5865     quit_libPNG;
5866   end;
5867 end;
5868
5869 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5871 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5872 var
5873   StreamPos: Int64;
5874   Png: TPNGObject;
5875   Header: String[8];
5876   Row, Col, PixSize, LineSize: Integer;
5877   NewImage, pSource, pDest, pAlpha: pByte;
5878   PngFormat: TglBitmapFormat;
5879   FormatDesc: TFormatDescriptor;
5880
5881 const
5882   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5883
5884 begin
5885   result := false;
5886
5887   StreamPos := aStream.Position;
5888   aStream.Read(Header[0], SizeOf(Header));
5889   aStream.Position := StreamPos;
5890
5891   {Test if the header matches}
5892   if Header = PngHeader then begin
5893     Png := TPNGObject.Create;
5894     try
5895       Png.LoadFromStream(aStream);
5896
5897       case Png.Header.ColorType of
5898         COLOR_GRAYSCALE:
5899           PngFormat := tfLuminance8;
5900         COLOR_GRAYSCALEALPHA:
5901           PngFormat := tfLuminance8Alpha8;
5902         COLOR_RGB:
5903           PngFormat := tfBGR8;
5904         COLOR_RGBALPHA:
5905           PngFormat := tfBGRA8;
5906         else
5907           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5908       end;
5909
5910       FormatDesc := TFormatDescriptor.Get(PngFormat);
5911       PixSize    := Round(FormatDesc.PixelSize);
5912       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5913
5914       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5915       try
5916         pDest := NewImage;
5917
5918         case Png.Header.ColorType of
5919           COLOR_RGB, COLOR_GRAYSCALE:
5920             begin
5921               for Row := 0 to Png.Height -1 do begin
5922                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5923                 Inc(pDest, LineSize);
5924               end;
5925             end;
5926           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5927             begin
5928               PixSize := PixSize -1;
5929
5930               for Row := 0 to Png.Height -1 do begin
5931                 pSource := Png.Scanline[Row];
5932                 pAlpha := pByte(Png.AlphaScanline[Row]);
5933
5934                 for Col := 0 to Png.Width -1 do begin
5935                   Move (pSource^, pDest^, PixSize);
5936                   Inc(pSource, PixSize);
5937                   Inc(pDest, PixSize);
5938
5939                   pDest^ := pAlpha^;
5940                   inc(pAlpha);
5941                   Inc(pDest);
5942                 end;
5943               end;
5944             end;
5945           else
5946             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5947         end;
5948
5949         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5950
5951         result := true;
5952       except
5953         if Assigned(NewImage) then
5954           FreeMem(NewImage);
5955         raise;
5956       end;
5957     finally
5958       Png.Free;
5959     end;
5960   end;
5961 end;
5962 {$IFEND}
5963 {$ENDIF}
5964
5965 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5966 {$IFDEF GLB_LIB_PNG}
5967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5968 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5969 begin
5970   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5971 end;
5972 {$ENDIF}
5973
5974 {$IF DEFINED(GLB_LAZ_PNG)}
5975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5976 procedure TglBitmap.SavePNG(const aStream: TStream);
5977 var
5978   png: TPortableNetworkGraphic;
5979   intf: TLazIntfImage;
5980   raw: TRawImage;
5981 begin
5982   png  := TPortableNetworkGraphic.Create;
5983   intf := TLazIntfImage.Create(0, 0);
5984   try
5985     if not AssignToLazIntfImage(intf) then
5986       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5987     intf.GetRawImage(raw);
5988     png.LoadFromRawImage(raw, false);
5989     png.SaveToStream(aStream);
5990   finally
5991     png.Free;
5992     intf.Free;
5993   end;
5994 end;
5995
5996 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5998 procedure TglBitmap.SavePNG(const aStream: TStream);
5999 var
6000   png: png_structp;
6001   png_info: png_infop;
6002   png_rows: array of pByte;
6003   LineSize: Integer;
6004   ColorType: Integer;
6005   Row: Integer;
6006   FormatDesc: TFormatDescriptor;
6007 begin
6008   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6009     raise EglBitmapUnsupportedFormat.Create(Format);
6010
6011   if not init_libPNG then
6012     raise Exception.Create('unable to initialize libPNG.');
6013
6014   try
6015     case Format of
6016       tfAlpha8, tfLuminance8:
6017         ColorType := PNG_COLOR_TYPE_GRAY;
6018       tfLuminance8Alpha8:
6019         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6020       tfBGR8, tfRGB8:
6021         ColorType := PNG_COLOR_TYPE_RGB;
6022       tfBGRA8, tfRGBA8:
6023         ColorType := PNG_COLOR_TYPE_RGBA;
6024       else
6025         raise EglBitmapUnsupportedFormat.Create(Format);
6026     end;
6027
6028     FormatDesc := TFormatDescriptor.Get(Format);
6029     LineSize := FormatDesc.GetSize(Width, 1);
6030
6031     // creating array for scanline
6032     SetLength(png_rows, Height);
6033     try
6034       for Row := 0 to Height - 1 do begin
6035         png_rows[Row] := Data;
6036         Inc(png_rows[Row], Row * LineSize)
6037       end;
6038
6039       // write struct
6040       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6041       if png = nil then
6042         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6043
6044       // create png info
6045       png_info := png_create_info_struct(png);
6046       if png_info = nil then begin
6047         png_destroy_write_struct(@png, nil);
6048         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6049       end;
6050
6051       // set read callback
6052       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6053
6054       // set compression
6055       png_set_compression_level(png, 6);
6056
6057       if Format in [tfBGR8, tfBGRA8] then
6058         png_set_bgr(png);
6059
6060       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6061       png_write_info(png, png_info);
6062       png_write_image(png, @png_rows[0]);
6063       png_write_end(png, png_info);
6064       png_destroy_write_struct(@png, @png_info);
6065     finally
6066       SetLength(png_rows, 0);
6067     end;
6068   finally
6069     quit_libPNG;
6070   end;
6071 end;
6072
6073 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6075 procedure TglBitmap.SavePNG(const aStream: TStream);
6076 var
6077   Png: TPNGObject;
6078
6079   pSource, pDest: pByte;
6080   X, Y, PixSize: Integer;
6081   ColorType: Cardinal;
6082   Alpha: Boolean;
6083
6084   pTemp: pByte;
6085   Temp: Byte;
6086 begin
6087   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6088     raise EglBitmapUnsupportedFormat.Create(Format);
6089
6090   case Format of
6091     tfAlpha8, tfLuminance8: begin
6092       ColorType := COLOR_GRAYSCALE;
6093       PixSize   := 1;
6094       Alpha     := false;
6095     end;
6096     tfLuminance8Alpha8: begin
6097       ColorType := COLOR_GRAYSCALEALPHA;
6098       PixSize   := 1;
6099       Alpha     := true;
6100     end;
6101     tfBGR8, tfRGB8: begin
6102       ColorType := COLOR_RGB;
6103       PixSize   := 3;
6104       Alpha     := false;
6105     end;
6106     tfBGRA8, tfRGBA8: begin
6107       ColorType := COLOR_RGBALPHA;
6108       PixSize   := 3;
6109       Alpha     := true
6110     end;
6111   else
6112     raise EglBitmapUnsupportedFormat.Create(Format);
6113   end;
6114
6115   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6116   try
6117     // Copy ImageData
6118     pSource := Data;
6119     for Y := 0 to Height -1 do begin
6120       pDest := png.ScanLine[Y];
6121       for X := 0 to Width -1 do begin
6122         Move(pSource^, pDest^, PixSize);
6123         Inc(pDest, PixSize);
6124         Inc(pSource, PixSize);
6125         if Alpha then begin
6126           png.AlphaScanline[Y]^[X] := pSource^;
6127           Inc(pSource);
6128         end;
6129       end;
6130
6131       // convert RGB line to BGR
6132       if Format in [tfRGB8, tfRGBA8] then begin
6133         pTemp := png.ScanLine[Y];
6134         for X := 0 to Width -1 do begin
6135           Temp := pByteArray(pTemp)^[0];
6136           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6137           pByteArray(pTemp)^[2] := Temp;
6138           Inc(pTemp, 3);
6139         end;
6140       end;
6141     end;
6142
6143     // Save to Stream
6144     Png.CompressionLevel := 6;
6145     Png.SaveToStream(aStream);
6146   finally
6147     FreeAndNil(Png);
6148   end;
6149 end;
6150 {$IFEND}
6151 {$ENDIF}
6152
6153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6154 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6156 {$IFDEF GLB_LIB_JPEG}
6157 type
6158   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6159   glBitmap_libJPEG_source_mgr = record
6160     pub: jpeg_source_mgr;
6161
6162     SrcStream: TStream;
6163     SrcBuffer: array [1..4096] of byte;
6164   end;
6165
6166   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6167   glBitmap_libJPEG_dest_mgr = record
6168     pub: jpeg_destination_mgr;
6169
6170     DestStream: TStream;
6171     DestBuffer: array [1..4096] of byte;
6172   end;
6173
6174 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6175 begin
6176   //DUMMY
6177 end;
6178
6179
6180 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6181 begin
6182   //DUMMY
6183 end;
6184
6185
6186 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6187 begin
6188   //DUMMY
6189 end;
6190
6191 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6192 begin
6193   //DUMMY
6194 end;
6195
6196
6197 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6198 begin
6199   //DUMMY
6200 end;
6201
6202
6203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6204 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6205 var
6206   src: glBitmap_libJPEG_source_mgr_ptr;
6207   bytes: integer;
6208 begin
6209   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6210
6211   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6212         if (bytes <= 0) then begin
6213                 src^.SrcBuffer[1] := $FF;
6214                 src^.SrcBuffer[2] := JPEG_EOI;
6215                 bytes := 2;
6216         end;
6217
6218         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6219         src^.pub.bytes_in_buffer := bytes;
6220
6221   result := true;
6222 end;
6223
6224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6225 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6226 var
6227   src: glBitmap_libJPEG_source_mgr_ptr;
6228 begin
6229   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6230
6231   if num_bytes > 0 then begin
6232     // wanted byte isn't in buffer so set stream position and read buffer
6233     if num_bytes > src^.pub.bytes_in_buffer then begin
6234       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6235       src^.pub.fill_input_buffer(cinfo);
6236     end else begin
6237       // wanted byte is in buffer so only skip
6238                 inc(src^.pub.next_input_byte, num_bytes);
6239                 dec(src^.pub.bytes_in_buffer, num_bytes);
6240     end;
6241   end;
6242 end;
6243
6244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6245 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6246 var
6247   dest: glBitmap_libJPEG_dest_mgr_ptr;
6248 begin
6249   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6250
6251   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6252     // write complete buffer
6253     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6254
6255     // reset buffer
6256     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6257     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6258   end;
6259
6260   result := true;
6261 end;
6262
6263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6264 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6265 var
6266   Idx: Integer;
6267   dest: glBitmap_libJPEG_dest_mgr_ptr;
6268 begin
6269   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6270
6271   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6272     // check for endblock
6273     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6274       // write endblock
6275       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6276
6277       // leave
6278       break;
6279     end else
6280       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6281   end;
6282 end;
6283 {$ENDIF}
6284
6285 {$IFDEF GLB_SUPPORT_JPEG_READ}
6286 {$IF DEFINED(GLB_LAZ_JPEG)}
6287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6288 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6289 const
6290   MAGIC_LEN = 2;
6291   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6292 var
6293   jpeg: TJPEGImage;
6294   intf: TLazIntfImage;
6295   StreamPos: Int64;
6296   magic: String[MAGIC_LEN];
6297 begin
6298   result := true;
6299   StreamPos := aStream.Position;
6300
6301   SetLength(magic, MAGIC_LEN);
6302   aStream.Read(magic[1], MAGIC_LEN);
6303   aStream.Position := StreamPos;
6304   if (magic <> JPEG_MAGIC) then begin
6305     result := false;
6306     exit;
6307   end;
6308
6309   jpeg := TJPEGImage.Create;
6310   try try
6311     jpeg.LoadFromStream(aStream);
6312     intf := TLazIntfImage.Create(0, 0);
6313     try try
6314       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6315       AssignFromLazIntfImage(intf);
6316     except
6317       result := false;
6318       aStream.Position := StreamPos;
6319       exit;
6320     end;
6321     finally
6322       intf.Free;
6323     end;
6324   except
6325     result := false;
6326     aStream.Position := StreamPos;
6327     exit;
6328   end;
6329   finally
6330     jpeg.Free;
6331   end;
6332 end;
6333
6334 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6336 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6337 var
6338   Surface: PSDL_Surface;
6339   RWops: PSDL_RWops;
6340 begin
6341   result := false;
6342
6343   RWops := glBitmapCreateRWops(aStream);
6344   try
6345     if IMG_isJPG(RWops) > 0 then begin
6346       Surface := IMG_LoadJPG_RW(RWops);
6347       try
6348         AssignFromSurface(Surface);
6349         result := true;
6350       finally
6351         SDL_FreeSurface(Surface);
6352       end;
6353     end;
6354   finally
6355     SDL_FreeRW(RWops);
6356   end;
6357 end;
6358
6359 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6361 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6362 var
6363   StreamPos: Int64;
6364   Temp: array[0..1]of Byte;
6365
6366   jpeg: jpeg_decompress_struct;
6367   jpeg_err: jpeg_error_mgr;
6368
6369   IntFormat: TglBitmapFormat;
6370   pImage: pByte;
6371   TempHeight, TempWidth: Integer;
6372
6373   pTemp: pByte;
6374   Row: Integer;
6375
6376   FormatDesc: TFormatDescriptor;
6377 begin
6378   result := false;
6379
6380   if not init_libJPEG then
6381     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6382
6383   try
6384     // reading first two bytes to test file and set cursor back to begin
6385     StreamPos := aStream.Position;
6386     aStream.Read({%H-}Temp[0], 2);
6387     aStream.Position := StreamPos;
6388
6389     // if Bitmap then read file.
6390     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6391       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6392       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6393
6394       // error managment
6395       jpeg.err := jpeg_std_error(@jpeg_err);
6396       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6397       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6398
6399       // decompression struct
6400       jpeg_create_decompress(@jpeg);
6401
6402       // allocation space for streaming methods
6403       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6404
6405       // seeting up custom functions
6406       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6407         pub.init_source       := glBitmap_libJPEG_init_source;
6408         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6409         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6410         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6411         pub.term_source       := glBitmap_libJPEG_term_source;
6412
6413         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6414         pub.next_input_byte := nil;   // until buffer loaded
6415
6416         SrcStream := aStream;
6417       end;
6418
6419       // set global decoding state
6420       jpeg.global_state := DSTATE_START;
6421
6422       // read header of jpeg
6423       jpeg_read_header(@jpeg, false);
6424
6425       // setting output parameter
6426       case jpeg.jpeg_color_space of
6427         JCS_GRAYSCALE:
6428           begin
6429             jpeg.out_color_space := JCS_GRAYSCALE;
6430             IntFormat := tfLuminance8;
6431           end;
6432         else
6433           jpeg.out_color_space := JCS_RGB;
6434           IntFormat := tfRGB8;
6435       end;
6436
6437       // reading image
6438       jpeg_start_decompress(@jpeg);
6439
6440       TempHeight := jpeg.output_height;
6441       TempWidth := jpeg.output_width;
6442
6443       FormatDesc := TFormatDescriptor.Get(IntFormat);
6444
6445       // creating new image
6446       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6447       try
6448         pTemp := pImage;
6449
6450         for Row := 0 to TempHeight -1 do begin
6451           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6452           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6453         end;
6454
6455         // finish decompression
6456         jpeg_finish_decompress(@jpeg);
6457
6458         // destroy decompression
6459         jpeg_destroy_decompress(@jpeg);
6460
6461         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6462
6463         result := true;
6464       except
6465         if Assigned(pImage) then
6466           FreeMem(pImage);
6467         raise;
6468       end;
6469     end;
6470   finally
6471     quit_libJPEG;
6472   end;
6473 end;
6474
6475 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6477 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6478 var
6479   bmp: TBitmap;
6480   jpg: TJPEGImage;
6481   StreamPos: Int64;
6482   Temp: array[0..1]of Byte;
6483 begin
6484   result := false;
6485
6486   // reading first two bytes to test file and set cursor back to begin
6487   StreamPos := aStream.Position;
6488   aStream.Read(Temp[0], 2);
6489   aStream.Position := StreamPos;
6490
6491   // if Bitmap then read file.
6492   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6493     bmp := TBitmap.Create;
6494     try
6495       jpg := TJPEGImage.Create;
6496       try
6497         jpg.LoadFromStream(aStream);
6498         bmp.Assign(jpg);
6499         result := AssignFromBitmap(bmp);
6500       finally
6501         jpg.Free;
6502       end;
6503     finally
6504       bmp.Free;
6505     end;
6506   end;
6507 end;
6508 {$IFEND}
6509 {$ENDIF}
6510
6511 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6512 {$IF DEFINED(GLB_LAZ_JPEG)}
6513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6514 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6515 var
6516   jpeg: TJPEGImage;
6517   intf: TLazIntfImage;
6518   raw: TRawImage;
6519 begin
6520   jpeg := TJPEGImage.Create;
6521   intf := TLazIntfImage.Create(0, 0);
6522   try
6523     if not AssignToLazIntfImage(intf) then
6524       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6525     intf.GetRawImage(raw);
6526     jpeg.LoadFromRawImage(raw, false);
6527     jpeg.SaveToStream(aStream);
6528   finally
6529     intf.Free;
6530     jpeg.Free;
6531   end;
6532 end;
6533
6534 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6536 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6537 var
6538   jpeg: jpeg_compress_struct;
6539   jpeg_err: jpeg_error_mgr;
6540   Row: Integer;
6541   pTemp, pTemp2: pByte;
6542
6543   procedure CopyRow(pDest, pSource: pByte);
6544   var
6545     X: Integer;
6546   begin
6547     for X := 0 to Width - 1 do begin
6548       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6549       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6550       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6551       Inc(pDest, 3);
6552       Inc(pSource, 3);
6553     end;
6554   end;
6555
6556 begin
6557   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6558     raise EglBitmapUnsupportedFormat.Create(Format);
6559
6560   if not init_libJPEG then
6561     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6562
6563   try
6564     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6565     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6566
6567     // error managment
6568     jpeg.err := jpeg_std_error(@jpeg_err);
6569     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6570     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6571
6572     // compression struct
6573     jpeg_create_compress(@jpeg);
6574
6575     // allocation space for streaming methods
6576     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6577
6578     // seeting up custom functions
6579     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6580       pub.init_destination    := glBitmap_libJPEG_init_destination;
6581       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6582       pub.term_destination    := glBitmap_libJPEG_term_destination;
6583
6584       pub.next_output_byte  := @DestBuffer[1];
6585       pub.free_in_buffer    := Length(DestBuffer);
6586
6587       DestStream := aStream;
6588     end;
6589
6590     // very important state
6591     jpeg.global_state := CSTATE_START;
6592     jpeg.image_width  := Width;
6593     jpeg.image_height := Height;
6594     case Format of
6595       tfAlpha8, tfLuminance8: begin
6596         jpeg.input_components := 1;
6597         jpeg.in_color_space   := JCS_GRAYSCALE;
6598       end;
6599       tfRGB8, tfBGR8: begin
6600         jpeg.input_components := 3;
6601         jpeg.in_color_space   := JCS_RGB;
6602       end;
6603     end;
6604
6605     jpeg_set_defaults(@jpeg);
6606     jpeg_set_quality(@jpeg, 95, true);
6607     jpeg_start_compress(@jpeg, true);
6608     pTemp := Data;
6609
6610     if Format = tfBGR8 then
6611       GetMem(pTemp2, fRowSize)
6612     else
6613       pTemp2 := pTemp;
6614
6615     try
6616       for Row := 0 to jpeg.image_height -1 do begin
6617         // prepare row
6618         if Format = tfBGR8 then
6619           CopyRow(pTemp2, pTemp)
6620         else
6621           pTemp2 := pTemp;
6622
6623         // write row
6624         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6625         inc(pTemp, fRowSize);
6626       end;
6627     finally
6628       // free memory
6629       if Format = tfBGR8 then
6630         FreeMem(pTemp2);
6631     end;
6632     jpeg_finish_compress(@jpeg);
6633     jpeg_destroy_compress(@jpeg);
6634   finally
6635     quit_libJPEG;
6636   end;
6637 end;
6638
6639 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6641 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6642 var
6643   Bmp: TBitmap;
6644   Jpg: TJPEGImage;
6645 begin
6646   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6647     raise EglBitmapUnsupportedFormat.Create(Format);
6648
6649   Bmp := TBitmap.Create;
6650   try
6651     Jpg := TJPEGImage.Create;
6652     try
6653       AssignToBitmap(Bmp);
6654       if (Format in [tfAlpha8, tfLuminance8]) then begin
6655         Jpg.Grayscale   := true;
6656         Jpg.PixelFormat := jf8Bit;
6657       end;
6658       Jpg.Assign(Bmp);
6659       Jpg.SaveToStream(aStream);
6660     finally
6661       FreeAndNil(Jpg);
6662     end;
6663   finally
6664     FreeAndNil(Bmp);
6665   end;
6666 end;
6667 {$IFEND}
6668 {$ENDIF}
6669
6670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6671 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6673 const
6674   BMP_MAGIC          = $4D42;
6675
6676   BMP_COMP_RGB       = 0;
6677   BMP_COMP_RLE8      = 1;
6678   BMP_COMP_RLE4      = 2;
6679   BMP_COMP_BITFIELDS = 3;
6680
6681 type
6682   TBMPHeader = packed record
6683     bfType: Word;
6684     bfSize: Cardinal;
6685     bfReserved1: Word;
6686     bfReserved2: Word;
6687     bfOffBits: Cardinal;
6688   end;
6689
6690   TBMPInfo = packed record
6691     biSize: Cardinal;
6692     biWidth: Longint;
6693     biHeight: Longint;
6694     biPlanes: Word;
6695     biBitCount: Word;
6696     biCompression: Cardinal;
6697     biSizeImage: Cardinal;
6698     biXPelsPerMeter: Longint;
6699     biYPelsPerMeter: Longint;
6700     biClrUsed: Cardinal;
6701     biClrImportant: Cardinal;
6702   end;
6703
6704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6705 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6706
6707   //////////////////////////////////////////////////////////////////////////////////////////////////
6708   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6709   begin
6710     result := tfEmpty;
6711     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6712     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6713
6714     //Read Compression
6715     case aInfo.biCompression of
6716       BMP_COMP_RLE4,
6717       BMP_COMP_RLE8: begin
6718         raise EglBitmap.Create('RLE compression is not supported');
6719       end;
6720       BMP_COMP_BITFIELDS: begin
6721         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6722           aStream.Read(aMask.r, SizeOf(aMask.r));
6723           aStream.Read(aMask.g, SizeOf(aMask.g));
6724           aStream.Read(aMask.b, SizeOf(aMask.b));
6725           aStream.Read(aMask.a, SizeOf(aMask.a));
6726         end else
6727           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6728       end;
6729     end;
6730
6731     //get suitable format
6732     case aInfo.biBitCount of
6733        8: result := tfLuminance8;
6734       16: result := tfBGR5;
6735       24: result := tfBGR8;
6736       32: result := tfBGRA8;
6737     end;
6738   end;
6739
6740   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6741   var
6742     i, c: Integer;
6743     ColorTable: TbmpColorTable;
6744   begin
6745     result := nil;
6746     if (aInfo.biBitCount >= 16) then
6747       exit;
6748     aFormat := tfLuminance8;
6749     c := aInfo.biClrUsed;
6750     if (c = 0) then
6751       c := 1 shl aInfo.biBitCount;
6752     SetLength(ColorTable, c);
6753     for i := 0 to c-1 do begin
6754       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6755       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6756         aFormat := tfRGB8;
6757     end;
6758
6759     result := TbmpColorTableFormat.Create;
6760     result.PixelSize  := aInfo.biBitCount / 8;
6761     result.ColorTable := ColorTable;
6762     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6763   end;
6764
6765   //////////////////////////////////////////////////////////////////////////////////////////////////
6766   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6767     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6768   var
6769     TmpFormat: TglBitmapFormat;
6770     FormatDesc: TFormatDescriptor;
6771   begin
6772     result := nil;
6773     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6774       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6775         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6776         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6777           aFormat := FormatDesc.Format;
6778           exit;
6779         end;
6780       end;
6781
6782       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6783         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6784       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6785         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6786
6787       result := TbmpBitfieldFormat.Create;
6788       result.PixelSize := aInfo.biBitCount / 8;
6789       result.RedMask   := aMask.r;
6790       result.GreenMask := aMask.g;
6791       result.BlueMask  := aMask.b;
6792       result.AlphaMask := aMask.a;
6793     end;
6794   end;
6795
6796 var
6797   //simple types
6798   StartPos: Int64;
6799   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6800   PaddingBuff: Cardinal;
6801   LineBuf, ImageData, TmpData: PByte;
6802   SourceMD, DestMD: Pointer;
6803   BmpFormat: TglBitmapFormat;
6804
6805   //records
6806   Mask: TglBitmapColorRec;
6807   Header: TBMPHeader;
6808   Info: TBMPInfo;
6809
6810   //classes
6811   SpecialFormat: TFormatDescriptor;
6812   FormatDesc: TFormatDescriptor;
6813
6814   //////////////////////////////////////////////////////////////////////////////////////////////////
6815   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6816   var
6817     i: Integer;
6818     Pixel: TglBitmapPixelData;
6819   begin
6820     aStream.Read(aLineBuf^, rbLineSize);
6821     SpecialFormat.PreparePixel(Pixel);
6822     for i := 0 to Info.biWidth-1 do begin
6823       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6824       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6825       FormatDesc.Map(Pixel, aData, DestMD);
6826     end;
6827   end;
6828
6829 begin
6830   result        := false;
6831   BmpFormat     := tfEmpty;
6832   SpecialFormat := nil;
6833   LineBuf       := nil;
6834   SourceMD      := nil;
6835   DestMD        := nil;
6836
6837   // Header
6838   StartPos := aStream.Position;
6839   aStream.Read(Header{%H-}, SizeOf(Header));
6840
6841   if Header.bfType = BMP_MAGIC then begin
6842     try try
6843       BmpFormat        := ReadInfo(Info, Mask);
6844       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6845       if not Assigned(SpecialFormat) then
6846         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6847       aStream.Position := StartPos + Header.bfOffBits;
6848
6849       if (BmpFormat <> tfEmpty) then begin
6850         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6851         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6852         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6853         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6854
6855         //get Memory
6856         DestMD    := FormatDesc.CreateMappingData;
6857         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6858         GetMem(ImageData, ImageSize);
6859         if Assigned(SpecialFormat) then begin
6860           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6861           SourceMD := SpecialFormat.CreateMappingData;
6862         end;
6863
6864         //read Data
6865         try try
6866           FillChar(ImageData^, ImageSize, $FF);
6867           TmpData := ImageData;
6868           if (Info.biHeight > 0) then
6869             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6870           for i := 0 to Abs(Info.biHeight)-1 do begin
6871             if Assigned(SpecialFormat) then
6872               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6873             else
6874               aStream.Read(TmpData^, wbLineSize);   //else only read data
6875             if (Info.biHeight > 0) then
6876               dec(TmpData, wbLineSize)
6877             else
6878               inc(TmpData, wbLineSize);
6879             aStream.Read(PaddingBuff{%H-}, Padding);
6880           end;
6881           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6882           result := true;
6883         finally
6884           if Assigned(LineBuf) then
6885             FreeMem(LineBuf);
6886           if Assigned(SourceMD) then
6887             SpecialFormat.FreeMappingData(SourceMD);
6888           FormatDesc.FreeMappingData(DestMD);
6889         end;
6890         except
6891           if Assigned(ImageData) then
6892             FreeMem(ImageData);
6893           raise;
6894         end;
6895       end else
6896         raise EglBitmap.Create('LoadBMP - No suitable format found');
6897     except
6898       aStream.Position := StartPos;
6899       raise;
6900     end;
6901     finally
6902       FreeAndNil(SpecialFormat);
6903     end;
6904   end
6905     else aStream.Position := StartPos;
6906 end;
6907
6908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6909 procedure TglBitmap.SaveBMP(const aStream: TStream);
6910 var
6911   Header: TBMPHeader;
6912   Info: TBMPInfo;
6913   Converter: TFormatDescriptor;
6914   FormatDesc: TFormatDescriptor;
6915   SourceFD, DestFD: Pointer;
6916   pData, srcData, dstData, ConvertBuffer: pByte;
6917
6918   Pixel: TglBitmapPixelData;
6919   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6920   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6921
6922   PaddingBuff: Cardinal;
6923
6924   function GetLineWidth : Integer;
6925   begin
6926     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6927   end;
6928
6929 begin
6930   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6931     raise EglBitmapUnsupportedFormat.Create(Format);
6932
6933   Converter  := nil;
6934   FormatDesc := TFormatDescriptor.Get(Format);
6935   ImageSize  := FormatDesc.GetSize(Dimension);
6936
6937   FillChar(Header{%H-}, SizeOf(Header), 0);
6938   Header.bfType      := BMP_MAGIC;
6939   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6940   Header.bfReserved1 := 0;
6941   Header.bfReserved2 := 0;
6942   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6943
6944   FillChar(Info{%H-}, SizeOf(Info), 0);
6945   Info.biSize        := SizeOf(Info);
6946   Info.biWidth       := Width;
6947   Info.biHeight      := Height;
6948   Info.biPlanes      := 1;
6949   Info.biCompression := BMP_COMP_RGB;
6950   Info.biSizeImage   := ImageSize;
6951
6952   try
6953     case Format of
6954       tfLuminance4: begin
6955         Info.biBitCount  := 4;
6956         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6957         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6958         Converter := TbmpColorTableFormat.Create;
6959         with (Converter as TbmpColorTableFormat) do begin
6960           PixelSize := 0.5;
6961           Format    := Format;
6962           Range     := glBitmapColorRec($F, $F, $F, $0);
6963           CreateColorTable;
6964         end;
6965       end;
6966
6967       tfR3G3B2, tfLuminance8: begin
6968         Info.biBitCount  :=  8;
6969         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6970         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6971         Converter := TbmpColorTableFormat.Create;
6972         with (Converter as TbmpColorTableFormat) do begin
6973           PixelSize := 1;
6974           Format    := Format;
6975           if (Format = tfR3G3B2) then begin
6976             Range := glBitmapColorRec($7, $7, $3, $0);
6977             Shift := glBitmapShiftRec(0, 3, 6, 0);
6978           end else
6979             Range := glBitmapColorRec($FF, $FF, $FF, $0);
6980           CreateColorTable;
6981         end;
6982       end;
6983
6984       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6985       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6986         Info.biBitCount    := 16;
6987         Info.biCompression := BMP_COMP_BITFIELDS;
6988       end;
6989
6990       tfBGR8, tfRGB8: begin
6991         Info.biBitCount := 24;
6992         if (Format = tfRGB8) then
6993           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
6994       end;
6995
6996       tfRGB10, tfRGB10A2, tfRGBA8,
6997       tfBGR10, tfBGR10A2, tfBGRA8: begin
6998         Info.biBitCount    := 32;
6999         Info.biCompression := BMP_COMP_BITFIELDS;
7000       end;
7001     else
7002       raise EglBitmapUnsupportedFormat.Create(Format);
7003     end;
7004     Info.biXPelsPerMeter := 2835;
7005     Info.biYPelsPerMeter := 2835;
7006
7007     // prepare bitmasks
7008     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7009       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7010       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7011
7012       RedMask    := FormatDesc.RedMask;
7013       GreenMask  := FormatDesc.GreenMask;
7014       BlueMask   := FormatDesc.BlueMask;
7015       AlphaMask  := FormatDesc.AlphaMask;
7016     end;
7017
7018     // headers
7019     aStream.Write(Header, SizeOf(Header));
7020     aStream.Write(Info, SizeOf(Info));
7021
7022     // colortable
7023     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7024       with (Converter as TbmpColorTableFormat) do
7025         aStream.Write(ColorTable[0].b,
7026           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7027
7028     // bitmasks
7029     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7030       aStream.Write(RedMask,   SizeOf(Cardinal));
7031       aStream.Write(GreenMask, SizeOf(Cardinal));
7032       aStream.Write(BlueMask,  SizeOf(Cardinal));
7033       aStream.Write(AlphaMask, SizeOf(Cardinal));
7034     end;
7035
7036     // image data
7037     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7038     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7039     Padding     := GetLineWidth - wbLineSize;
7040     PaddingBuff := 0;
7041
7042     pData := Data;
7043     inc(pData, (Height-1) * rbLineSize);
7044
7045     // prepare row buffer. But only for RGB because RGBA supports color masks
7046     // so it's possible to change color within the image.
7047     if Assigned(Converter) then begin
7048       FormatDesc.PreparePixel(Pixel);
7049       GetMem(ConvertBuffer, wbLineSize);
7050       SourceFD := FormatDesc.CreateMappingData;
7051       DestFD   := Converter.CreateMappingData;
7052     end else
7053       ConvertBuffer := nil;
7054
7055     try
7056       for LineIdx := 0 to Height - 1 do begin
7057         // preparing row
7058         if Assigned(Converter) then begin
7059           srcData := pData;
7060           dstData := ConvertBuffer;
7061           for PixelIdx := 0 to Info.biWidth-1 do begin
7062             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7063             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7064             Converter.Map(Pixel, dstData, DestFD);
7065           end;
7066           aStream.Write(ConvertBuffer^, wbLineSize);
7067         end else begin
7068           aStream.Write(pData^, rbLineSize);
7069         end;
7070         dec(pData, rbLineSize);
7071         if (Padding > 0) then
7072           aStream.Write(PaddingBuff, Padding);
7073       end;
7074     finally
7075       // destroy row buffer
7076       if Assigned(ConvertBuffer) then begin
7077         FormatDesc.FreeMappingData(SourceFD);
7078         Converter.FreeMappingData(DestFD);
7079         FreeMem(ConvertBuffer);
7080       end;
7081     end;
7082   finally
7083     if Assigned(Converter) then
7084       Converter.Free;
7085   end;
7086 end;
7087
7088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7089 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7091 type
7092   TTGAHeader = packed record
7093     ImageID: Byte;
7094     ColorMapType: Byte;
7095     ImageType: Byte;
7096     //ColorMapSpec: Array[0..4] of Byte;
7097     ColorMapStart: Word;
7098     ColorMapLength: Word;
7099     ColorMapEntrySize: Byte;
7100     OrigX: Word;
7101     OrigY: Word;
7102     Width: Word;
7103     Height: Word;
7104     Bpp: Byte;
7105     ImageDesc: Byte;
7106   end;
7107
7108 const
7109   TGA_UNCOMPRESSED_RGB  =  2;
7110   TGA_UNCOMPRESSED_GRAY =  3;
7111   TGA_COMPRESSED_RGB    = 10;
7112   TGA_COMPRESSED_GRAY   = 11;
7113
7114   TGA_NONE_COLOR_TABLE  = 0;
7115
7116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7117 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7118 var
7119   Header: TTGAHeader;
7120   ImageData: System.PByte;
7121   StartPosition: Int64;
7122   PixelSize, LineSize: Integer;
7123   tgaFormat: TglBitmapFormat;
7124   FormatDesc: TFormatDescriptor;
7125   Counter: packed record
7126     X, Y: packed record
7127       low, high, dir: Integer;
7128     end;
7129   end;
7130
7131 const
7132   CACHE_SIZE = $4000;
7133
7134   ////////////////////////////////////////////////////////////////////////////////////////
7135   procedure ReadUncompressed;
7136   var
7137     i, j: Integer;
7138     buf, tmp1, tmp2: System.PByte;
7139   begin
7140     buf := nil;
7141     if (Counter.X.dir < 0) then
7142       GetMem(buf, LineSize);
7143     try
7144       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7145         tmp1 := ImageData;
7146         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7147         if (Counter.X.dir < 0) then begin               //flip X
7148           aStream.Read(buf^, LineSize);
7149           tmp2 := buf;
7150           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7151           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7152             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7153               tmp1^ := tmp2^;
7154               inc(tmp1);
7155               inc(tmp2);
7156             end;
7157             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7158           end;
7159         end else
7160           aStream.Read(tmp1^, LineSize);
7161         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7162       end;
7163     finally
7164       if Assigned(buf) then
7165         FreeMem(buf);
7166     end;
7167   end;
7168
7169   ////////////////////////////////////////////////////////////////////////////////////////
7170   procedure ReadCompressed;
7171
7172     /////////////////////////////////////////////////////////////////
7173     var
7174       TmpData: System.PByte;
7175       LinePixelsRead: Integer;
7176     procedure CheckLine;
7177     begin
7178       if (LinePixelsRead >= Header.Width) then begin
7179         LinePixelsRead := 0;
7180         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7181         TmpData := ImageData;
7182         inc(TmpData, Counter.Y.low * LineSize);           //set line
7183         if (Counter.X.dir < 0) then                       //if x flipped then
7184           inc(TmpData, LineSize - PixelSize);             //set last pixel
7185       end;
7186     end;
7187
7188     /////////////////////////////////////////////////////////////////
7189     var
7190       Cache: PByte;
7191       CacheSize, CachePos: Integer;
7192     procedure CachedRead(out Buffer; Count: Integer);
7193     var
7194       BytesRead: Integer;
7195     begin
7196       if (CachePos + Count > CacheSize) then begin
7197         //if buffer overflow save non read bytes
7198         BytesRead := 0;
7199         if (CacheSize - CachePos > 0) then begin
7200           BytesRead := CacheSize - CachePos;
7201           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7202           inc(CachePos, BytesRead);
7203         end;
7204
7205         //load cache from file
7206         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7207         aStream.Read(Cache^, CacheSize);
7208         CachePos := 0;
7209
7210         //read rest of requested bytes
7211         if (Count - BytesRead > 0) then begin
7212           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7213           inc(CachePos, Count - BytesRead);
7214         end;
7215       end else begin
7216         //if no buffer overflow just read the data
7217         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7218         inc(CachePos, Count);
7219       end;
7220     end;
7221
7222     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7223     begin
7224       case PixelSize of
7225         1: begin
7226           aBuffer^ := aData^;
7227           inc(aBuffer, Counter.X.dir);
7228         end;
7229         2: begin
7230           PWord(aBuffer)^ := PWord(aData)^;
7231           inc(aBuffer, 2 * Counter.X.dir);
7232         end;
7233         3: begin
7234           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7235           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7236           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7237           inc(aBuffer, 3 * Counter.X.dir);
7238         end;
7239         4: begin
7240           PCardinal(aBuffer)^ := PCardinal(aData)^;
7241           inc(aBuffer, 4 * Counter.X.dir);
7242         end;
7243       end;
7244     end;
7245
7246   var
7247     TotalPixelsToRead, TotalPixelsRead: Integer;
7248     Temp: Byte;
7249     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7250     PixelRepeat: Boolean;
7251     PixelsToRead, PixelCount: Integer;
7252   begin
7253     CacheSize := 0;
7254     CachePos  := 0;
7255
7256     TotalPixelsToRead := Header.Width * Header.Height;
7257     TotalPixelsRead   := 0;
7258     LinePixelsRead    := 0;
7259
7260     GetMem(Cache, CACHE_SIZE);
7261     try
7262       TmpData := ImageData;
7263       inc(TmpData, Counter.Y.low * LineSize);           //set line
7264       if (Counter.X.dir < 0) then                       //if x flipped then
7265         inc(TmpData, LineSize - PixelSize);             //set last pixel
7266
7267       repeat
7268         //read CommandByte
7269         CachedRead(Temp, 1);
7270         PixelRepeat  := (Temp and $80) > 0;
7271         PixelsToRead := (Temp and $7F) + 1;
7272         inc(TotalPixelsRead, PixelsToRead);
7273
7274         if PixelRepeat then
7275           CachedRead(buf[0], PixelSize);
7276         while (PixelsToRead > 0) do begin
7277           CheckLine;
7278           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7279           while (PixelCount > 0) do begin
7280             if not PixelRepeat then
7281               CachedRead(buf[0], PixelSize);
7282             PixelToBuffer(@buf[0], TmpData);
7283             inc(LinePixelsRead);
7284             dec(PixelsToRead);
7285             dec(PixelCount);
7286           end;
7287         end;
7288       until (TotalPixelsRead >= TotalPixelsToRead);
7289     finally
7290       FreeMem(Cache);
7291     end;
7292   end;
7293
7294   function IsGrayFormat: Boolean;
7295   begin
7296     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7297   end;
7298
7299 begin
7300   result := false;
7301
7302   // reading header to test file and set cursor back to begin
7303   StartPosition := aStream.Position;
7304   aStream.Read(Header{%H-}, SizeOf(Header));
7305
7306   // no colormapped files
7307   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7308     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7309   begin
7310     try
7311       if Header.ImageID <> 0 then       // skip image ID
7312         aStream.Position := aStream.Position + Header.ImageID;
7313
7314       tgaFormat := tfEmpty;
7315       case Header.Bpp of
7316          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7317                0: tgaFormat := tfLuminance8;
7318                8: tgaFormat := tfAlpha8;
7319             end;
7320
7321         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7322                0: tgaFormat := tfLuminance16;
7323                8: tgaFormat := tfLuminance8Alpha8;
7324             end else case (Header.ImageDesc and $F) of
7325                0: tgaFormat := tfBGR5;
7326                1: tgaFormat := tfBGR5A1;
7327                4: tgaFormat := tfBGRA4;
7328             end;
7329
7330         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7331                0: tgaFormat := tfBGR8;
7332             end;
7333
7334         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7335                2: tgaFormat := tfBGR10A2;
7336                8: tgaFormat := tfBGRA8;
7337             end;
7338       end;
7339
7340       if (tgaFormat = tfEmpty) then
7341         raise EglBitmap.Create('LoadTga - unsupported format');
7342
7343       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7344       PixelSize  := FormatDesc.GetSize(1, 1);
7345       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7346
7347       GetMem(ImageData, LineSize * Header.Height);
7348       try
7349         //column direction
7350         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7351           Counter.X.low  := Header.Height-1;;
7352           Counter.X.high := 0;
7353           Counter.X.dir  := -1;
7354         end else begin
7355           Counter.X.low  := 0;
7356           Counter.X.high := Header.Height-1;
7357           Counter.X.dir  := 1;
7358         end;
7359
7360         // Row direction
7361         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7362           Counter.Y.low  := 0;
7363           Counter.Y.high := Header.Height-1;
7364           Counter.Y.dir  := 1;
7365         end else begin
7366           Counter.Y.low  := Header.Height-1;;
7367           Counter.Y.high := 0;
7368           Counter.Y.dir  := -1;
7369         end;
7370
7371         // Read Image
7372         case Header.ImageType of
7373           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7374             ReadUncompressed;
7375           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7376             ReadCompressed;
7377         end;
7378
7379         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7380         result := true;
7381       except
7382         if Assigned(ImageData) then
7383           FreeMem(ImageData);
7384         raise;
7385       end;
7386     finally
7387       aStream.Position := StartPosition;
7388     end;
7389   end
7390     else aStream.Position := StartPosition;
7391 end;
7392
7393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7394 procedure TglBitmap.SaveTGA(const aStream: TStream);
7395 var
7396   Header: TTGAHeader;
7397   LineSize, Size, x, y: Integer;
7398   Pixel: TglBitmapPixelData;
7399   LineBuf, SourceData, DestData: PByte;
7400   SourceMD, DestMD: Pointer;
7401   FormatDesc: TFormatDescriptor;
7402   Converter: TFormatDescriptor;
7403 begin
7404   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7405     raise EglBitmapUnsupportedFormat.Create(Format);
7406
7407   //prepare header
7408   FillChar(Header{%H-}, SizeOf(Header), 0);
7409
7410   //set ImageType
7411   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7412                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7413     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7414   else
7415     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7416
7417   //set BitsPerPixel
7418   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7419     Header.Bpp := 8
7420   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7421                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7422     Header.Bpp := 16
7423   else if (Format in [tfBGR8, tfRGB8]) then
7424     Header.Bpp := 24
7425   else
7426     Header.Bpp := 32;
7427
7428   //set AlphaBitCount
7429   case Format of
7430     tfRGB5A1, tfBGR5A1:
7431       Header.ImageDesc := 1 and $F;
7432     tfRGB10A2, tfBGR10A2:
7433       Header.ImageDesc := 2 and $F;
7434     tfRGBA4, tfBGRA4:
7435       Header.ImageDesc := 4 and $F;
7436     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7437       Header.ImageDesc := 8 and $F;
7438   end;
7439
7440   Header.Width     := Width;
7441   Header.Height    := Height;
7442   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7443   aStream.Write(Header, SizeOf(Header));
7444
7445   // convert RGB(A) to BGR(A)
7446   Converter  := nil;
7447   FormatDesc := TFormatDescriptor.Get(Format);
7448   Size       := FormatDesc.GetSize(Dimension);
7449   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7450     if (FormatDesc.RGBInverted = tfEmpty) then
7451       raise EglBitmap.Create('inverted RGB format is empty');
7452     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7453     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7454        (Converter.PixelSize <> FormatDesc.PixelSize) then
7455       raise EglBitmap.Create('invalid inverted RGB format');
7456   end;
7457
7458   if Assigned(Converter) then begin
7459     LineSize := FormatDesc.GetSize(Width, 1);
7460     GetMem(LineBuf, LineSize);
7461     SourceMD := FormatDesc.CreateMappingData;
7462     DestMD   := Converter.CreateMappingData;
7463     try
7464       SourceData := Data;
7465       for y := 0 to Height-1 do begin
7466         DestData := LineBuf;
7467         for x := 0 to Width-1 do begin
7468           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7469           Converter.Map(Pixel, DestData, DestMD);
7470         end;
7471         aStream.Write(LineBuf^, LineSize);
7472       end;
7473     finally
7474       FreeMem(LineBuf);
7475       FormatDesc.FreeMappingData(SourceMD);
7476       FormatDesc.FreeMappingData(DestMD);
7477     end;
7478   end else
7479     aStream.Write(Data^, Size);
7480 end;
7481
7482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7483 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7485 const
7486   DDS_MAGIC: Cardinal         = $20534444;
7487
7488   // DDS_header.dwFlags
7489   DDSD_CAPS                   = $00000001;
7490   DDSD_HEIGHT                 = $00000002;
7491   DDSD_WIDTH                  = $00000004;
7492   DDSD_PIXELFORMAT            = $00001000;
7493
7494   // DDS_header.sPixelFormat.dwFlags
7495   DDPF_ALPHAPIXELS            = $00000001;
7496   DDPF_ALPHA                  = $00000002;
7497   DDPF_FOURCC                 = $00000004;
7498   DDPF_RGB                    = $00000040;
7499   DDPF_LUMINANCE              = $00020000;
7500
7501   // DDS_header.sCaps.dwCaps1
7502   DDSCAPS_TEXTURE             = $00001000;
7503
7504   // DDS_header.sCaps.dwCaps2
7505   DDSCAPS2_CUBEMAP            = $00000200;
7506
7507   D3DFMT_DXT1                 = $31545844;
7508   D3DFMT_DXT3                 = $33545844;
7509   D3DFMT_DXT5                 = $35545844;
7510
7511 type
7512   TDDSPixelFormat = packed record
7513     dwSize: Cardinal;
7514     dwFlags: Cardinal;
7515     dwFourCC: Cardinal;
7516     dwRGBBitCount: Cardinal;
7517     dwRBitMask: Cardinal;
7518     dwGBitMask: Cardinal;
7519     dwBBitMask: Cardinal;
7520     dwABitMask: Cardinal;
7521   end;
7522
7523   TDDSCaps = packed record
7524     dwCaps1: Cardinal;
7525     dwCaps2: Cardinal;
7526     dwDDSX: Cardinal;
7527     dwReserved: Cardinal;
7528   end;
7529
7530   TDDSHeader = packed record
7531     dwSize: Cardinal;
7532     dwFlags: Cardinal;
7533     dwHeight: Cardinal;
7534     dwWidth: Cardinal;
7535     dwPitchOrLinearSize: Cardinal;
7536     dwDepth: Cardinal;
7537     dwMipMapCount: Cardinal;
7538     dwReserved: array[0..10] of Cardinal;
7539     PixelFormat: TDDSPixelFormat;
7540     Caps: TDDSCaps;
7541     dwReserved2: Cardinal;
7542   end;
7543
7544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7545 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7546 var
7547   Header: TDDSHeader;
7548   Converter: TbmpBitfieldFormat;
7549
7550   function GetDDSFormat: TglBitmapFormat;
7551   var
7552     fd: TFormatDescriptor;
7553     i: Integer;
7554     Range: TglBitmapColorRec;
7555     match: Boolean;
7556   begin
7557     result := tfEmpty;
7558     with Header.PixelFormat do begin
7559       // Compresses
7560       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7561         case Header.PixelFormat.dwFourCC of
7562           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7563           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7564           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7565         end;
7566       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7567
7568         //find matching format
7569         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7570           fd := TFormatDescriptor.Get(result);
7571           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7572              (8 * fd.PixelSize = dwRGBBitCount) then
7573             exit;
7574         end;
7575
7576         //find format with same Range
7577         Range.r := dwRBitMask;
7578         Range.g := dwGBitMask;
7579         Range.b := dwBBitMask;
7580         Range.a := dwABitMask;
7581         for i := 0 to 3 do begin
7582           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7583             Range.arr[i] := Range.arr[i] shr 1;
7584         end;
7585         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7586           fd := TFormatDescriptor.Get(result);
7587           match := true;
7588           for i := 0 to 3 do
7589             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7590               match := false;
7591               break;
7592             end;
7593           if match then
7594             break;
7595         end;
7596
7597         //no format with same range found -> use default
7598         if (result = tfEmpty) then begin
7599           if (dwABitMask > 0) then
7600             result := tfBGRA8
7601           else
7602             result := tfBGR8;
7603         end;
7604
7605         Converter := TbmpBitfieldFormat.Create;
7606         Converter.RedMask   := dwRBitMask;
7607         Converter.GreenMask := dwGBitMask;
7608         Converter.BlueMask  := dwBBitMask;
7609         Converter.AlphaMask := dwABitMask;
7610         Converter.PixelSize := dwRGBBitCount / 8;
7611       end;
7612     end;
7613   end;
7614
7615 var
7616   StreamPos: Int64;
7617   x, y, LineSize, RowSize, Magic: Cardinal;
7618   NewImage, TmpData, RowData, SrcData: System.PByte;
7619   SourceMD, DestMD: Pointer;
7620   Pixel: TglBitmapPixelData;
7621   ddsFormat: TglBitmapFormat;
7622   FormatDesc: TFormatDescriptor;
7623
7624 begin
7625   result    := false;
7626   Converter := nil;
7627   StreamPos := aStream.Position;
7628
7629   // Magic
7630   aStream.Read(Magic{%H-}, sizeof(Magic));
7631   if (Magic <> DDS_MAGIC) then begin
7632     aStream.Position := StreamPos;
7633     exit;
7634   end;
7635
7636   //Header
7637   aStream.Read(Header{%H-}, sizeof(Header));
7638   if (Header.dwSize <> SizeOf(Header)) or
7639      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7640         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7641   begin
7642     aStream.Position := StreamPos;
7643     exit;
7644   end;
7645
7646   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7647     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7648
7649   ddsFormat := GetDDSFormat;
7650   try
7651     if (ddsFormat = tfEmpty) then
7652       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7653
7654     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7655     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7656     GetMem(NewImage, Header.dwHeight * LineSize);
7657     try
7658       TmpData := NewImage;
7659
7660       //Converter needed
7661       if Assigned(Converter) then begin
7662         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7663         GetMem(RowData, RowSize);
7664         SourceMD := Converter.CreateMappingData;
7665         DestMD   := FormatDesc.CreateMappingData;
7666         try
7667           for y := 0 to Header.dwHeight-1 do begin
7668             TmpData := NewImage;
7669             inc(TmpData, y * LineSize);
7670             SrcData := RowData;
7671             aStream.Read(SrcData^, RowSize);
7672             for x := 0 to Header.dwWidth-1 do begin
7673               Converter.Unmap(SrcData, Pixel, SourceMD);
7674               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7675               FormatDesc.Map(Pixel, TmpData, DestMD);
7676             end;
7677           end;
7678         finally
7679           Converter.FreeMappingData(SourceMD);
7680           FormatDesc.FreeMappingData(DestMD);
7681           FreeMem(RowData);
7682         end;
7683       end else
7684
7685       // Compressed
7686       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7687         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7688         for Y := 0 to Header.dwHeight-1 do begin
7689           aStream.Read(TmpData^, RowSize);
7690           Inc(TmpData, LineSize);
7691         end;
7692       end else
7693
7694       // Uncompressed
7695       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7696         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7697         for Y := 0 to Header.dwHeight-1 do begin
7698           aStream.Read(TmpData^, RowSize);
7699           Inc(TmpData, LineSize);
7700         end;
7701       end else
7702         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7703
7704       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7705       result := true;
7706     except
7707       if Assigned(NewImage) then
7708         FreeMem(NewImage);
7709       raise;
7710     end;
7711   finally
7712     FreeAndNil(Converter);
7713   end;
7714 end;
7715
7716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7717 procedure TglBitmap.SaveDDS(const aStream: TStream);
7718 var
7719   Header: TDDSHeader;
7720   FormatDesc: TFormatDescriptor;
7721 begin
7722   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7723     raise EglBitmapUnsupportedFormat.Create(Format);
7724
7725   FormatDesc := TFormatDescriptor.Get(Format);
7726
7727   // Generell
7728   FillChar(Header{%H-}, SizeOf(Header), 0);
7729   Header.dwSize  := SizeOf(Header);
7730   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7731
7732   Header.dwWidth  := Max(1, Width);
7733   Header.dwHeight := Max(1, Height);
7734
7735   // Caps
7736   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7737
7738   // Pixelformat
7739   Header.PixelFormat.dwSize := sizeof(Header);
7740   if (FormatDesc.IsCompressed) then begin
7741     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7742     case Format of
7743       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7744       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7745       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7746     end;
7747   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7748     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7749     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7750     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7751   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7752     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7753     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7754     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7755     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7756   end else begin
7757     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7758     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7759     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7760     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7761     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7762     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7763   end;
7764
7765   if (FormatDesc.HasAlpha) then
7766     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7767
7768   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7769   aStream.Write(Header, SizeOf(Header));
7770   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7771 end;
7772
7773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7774 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7776 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7777   const aWidth: Integer; const aHeight: Integer);
7778 var
7779   pTemp: pByte;
7780   Size: Integer;
7781 begin
7782   if (aHeight > 1) then begin
7783     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7784     GetMem(pTemp, Size);
7785     try
7786       Move(aData^, pTemp^, Size);
7787       FreeMem(aData);
7788       aData := nil;
7789     except
7790       FreeMem(pTemp);
7791       raise;
7792     end;
7793   end else
7794     pTemp := aData;
7795   inherited SetDataPointer(pTemp, aFormat, aWidth);
7796 end;
7797
7798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7799 function TglBitmap1D.FlipHorz: Boolean;
7800 var
7801   Col: Integer;
7802   pTempDest, pDest, pSource: PByte;
7803 begin
7804   result := inherited FlipHorz;
7805   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7806     pSource := Data;
7807     GetMem(pDest, fRowSize);
7808     try
7809       pTempDest := pDest;
7810       Inc(pTempDest, fRowSize);
7811       for Col := 0 to Width-1 do begin
7812         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7813         Move(pSource^, pTempDest^, fPixelSize);
7814         Inc(pSource, fPixelSize);
7815       end;
7816       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7817       result := true;
7818     except
7819       if Assigned(pDest) then
7820         FreeMem(pDest);
7821       raise;
7822     end;
7823   end;
7824 end;
7825
7826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7827 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7828 var
7829   FormatDesc: TFormatDescriptor;
7830 begin
7831   // Upload data
7832   FormatDesc := TFormatDescriptor.Get(Format);
7833   if FormatDesc.IsCompressed then begin
7834     if not Assigned(glCompressedTexImage1D) then
7835       raise EglBitmap.Create('compressed formats not supported by video adapter');
7836     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7837   end else if aBuildWithGlu then
7838     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7839   else
7840     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7841
7842   // Free Data
7843   if (FreeDataAfterGenTexture) then
7844     FreeData;
7845 end;
7846
7847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7848 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7849 var
7850   BuildWithGlu, TexRec: Boolean;
7851   TexSize: Integer;
7852 begin
7853   if Assigned(Data) then begin
7854     // Check Texture Size
7855     if (aTestTextureSize) then begin
7856       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7857
7858       if (Width > TexSize) then
7859         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7860
7861       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7862                 (Target = GL_TEXTURE_RECTANGLE);
7863       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7864         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7865     end;
7866
7867     CreateId;
7868     SetupParameters(BuildWithGlu);
7869     UploadData(BuildWithGlu);
7870     glAreTexturesResident(1, @fID, @fIsResident);
7871   end;
7872 end;
7873
7874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7875 procedure TglBitmap1D.AfterConstruction;
7876 begin
7877   inherited;
7878   Target := GL_TEXTURE_1D;
7879 end;
7880
7881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7882 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7884 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7885 begin
7886   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7887     result := fLines[aIndex]
7888   else
7889     result := nil;
7890 end;
7891
7892 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7893 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7894   const aWidth: Integer; const aHeight: Integer);
7895 var
7896   Idx, LineWidth: Integer;
7897 begin
7898   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7899
7900   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7901     // Assigning Data
7902     if Assigned(Data) then begin
7903       SetLength(fLines, GetHeight);
7904       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7905
7906       for Idx := 0 to GetHeight-1 do begin
7907         fLines[Idx] := Data;
7908         Inc(fLines[Idx], Idx * LineWidth);
7909       end;
7910     end
7911       else SetLength(fLines, 0);
7912   end else begin
7913     SetLength(fLines, 0);
7914   end;
7915 end;
7916
7917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7918 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7919 var
7920   FormatDesc: TFormatDescriptor;
7921 begin
7922   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7923
7924   FormatDesc := TFormatDescriptor.Get(Format);
7925   if FormatDesc.IsCompressed then begin
7926     if not Assigned(glCompressedTexImage2D) then
7927       raise EglBitmap.Create('compressed formats not supported by video adapter');
7928     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7929   end else if aBuildWithGlu then begin
7930     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7931       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7932   end else begin
7933     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7934       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7935   end;
7936
7937   // Freigeben
7938   if (FreeDataAfterGenTexture) then
7939     FreeData;
7940 end;
7941
7942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7943 procedure TglBitmap2D.AfterConstruction;
7944 begin
7945   inherited;
7946   Target := GL_TEXTURE_2D;
7947 end;
7948
7949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7950 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7951 var
7952   Temp: pByte;
7953   Size, w, h: Integer;
7954   FormatDesc: TFormatDescriptor;
7955 begin
7956   FormatDesc := TFormatDescriptor.Get(aFormat);
7957   if FormatDesc.IsCompressed then
7958     raise EglBitmapUnsupportedFormat.Create(aFormat);
7959
7960   w    := aRight  - aLeft;
7961   h    := aBottom - aTop;
7962   Size := FormatDesc.GetSize(w, h);
7963   GetMem(Temp, Size);
7964   try
7965     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7966     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7967     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7968     FlipVert;
7969   except
7970     if Assigned(Temp) then
7971       FreeMem(Temp);
7972     raise;
7973   end;
7974 end;
7975
7976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7977 procedure TglBitmap2D.GetDataFromTexture;
7978 var
7979   Temp: PByte;
7980   TempWidth, TempHeight: Integer;
7981   TempIntFormat: Cardinal;
7982   IntFormat, f: TglBitmapFormat;
7983   FormatDesc: TFormatDescriptor;
7984 begin
7985   Bind;
7986
7987   // Request Data
7988   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7989   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7990   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7991
7992   IntFormat := tfEmpty;
7993   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7994     FormatDesc := TFormatDescriptor.Get(f);
7995     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7996       IntFormat := FormatDesc.Format;
7997       break;
7998     end;
7999   end;
8000
8001   // Getting data from OpenGL
8002   FormatDesc := TFormatDescriptor.Get(IntFormat);
8003   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8004   try
8005     if FormatDesc.IsCompressed then begin
8006       if not Assigned(glGetCompressedTexImage) then
8007         raise EglBitmap.Create('compressed formats not supported by video adapter');
8008       glGetCompressedTexImage(Target, 0, Temp)
8009     end else
8010       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8011     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8012   except
8013     if Assigned(Temp) then
8014       FreeMem(Temp);
8015     raise;
8016   end;
8017 end;
8018
8019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8020 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8021 var
8022   BuildWithGlu, PotTex, TexRec: Boolean;
8023   TexSize: Integer;
8024 begin
8025   if Assigned(Data) then begin
8026     // Check Texture Size
8027     if (aTestTextureSize) then begin
8028       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8029
8030       if ((Height > TexSize) or (Width > TexSize)) then
8031         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8032
8033       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8034       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8035       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8036         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8037     end;
8038
8039     CreateId;
8040     SetupParameters(BuildWithGlu);
8041     UploadData(Target, BuildWithGlu);
8042     glAreTexturesResident(1, @fID, @fIsResident);
8043   end;
8044 end;
8045
8046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8047 function TglBitmap2D.FlipHorz: Boolean;
8048 var
8049   Col, Row: Integer;
8050   TempDestData, DestData, SourceData: PByte;
8051   ImgSize: Integer;
8052 begin
8053   result := inherited FlipHorz;
8054   if Assigned(Data) then begin
8055     SourceData := Data;
8056     ImgSize := Height * fRowSize;
8057     GetMem(DestData, ImgSize);
8058     try
8059       TempDestData := DestData;
8060       Dec(TempDestData, fRowSize + fPixelSize);
8061       for Row := 0 to Height -1 do begin
8062         Inc(TempDestData, fRowSize * 2);
8063         for Col := 0 to Width -1 do begin
8064           Move(SourceData^, TempDestData^, fPixelSize);
8065           Inc(SourceData, fPixelSize);
8066           Dec(TempDestData, fPixelSize);
8067         end;
8068       end;
8069       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8070       result := true;
8071     except
8072       if Assigned(DestData) then
8073         FreeMem(DestData);
8074       raise;
8075     end;
8076   end;
8077 end;
8078
8079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8080 function TglBitmap2D.FlipVert: Boolean;
8081 var
8082   Row: Integer;
8083   TempDestData, DestData, SourceData: PByte;
8084 begin
8085   result := inherited FlipVert;
8086   if Assigned(Data) then begin
8087     SourceData := Data;
8088     GetMem(DestData, Height * fRowSize);
8089     try
8090       TempDestData := DestData;
8091       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8092       for Row := 0 to Height -1 do begin
8093         Move(SourceData^, TempDestData^, fRowSize);
8094         Dec(TempDestData, fRowSize);
8095         Inc(SourceData, fRowSize);
8096       end;
8097       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8098       result := true;
8099     except
8100       if Assigned(DestData) then
8101         FreeMem(DestData);
8102       raise;
8103     end;
8104   end;
8105 end;
8106
8107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8108 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8110 type
8111   TMatrixItem = record
8112     X, Y: Integer;
8113     W: Single;
8114   end;
8115
8116   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8117   TglBitmapToNormalMapRec = Record
8118     Scale: Single;
8119     Heights: array of Single;
8120     MatrixU : array of TMatrixItem;
8121     MatrixV : array of TMatrixItem;
8122   end;
8123
8124 const
8125   ONE_OVER_255 = 1 / 255;
8126
8127   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8128 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8129 var
8130   Val: Single;
8131 begin
8132   with FuncRec do begin
8133     Val :=
8134       Source.Data.r * LUMINANCE_WEIGHT_R +
8135       Source.Data.g * LUMINANCE_WEIGHT_G +
8136       Source.Data.b * LUMINANCE_WEIGHT_B;
8137     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8138   end;
8139 end;
8140
8141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8142 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8143 begin
8144   with FuncRec do
8145     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8146 end;
8147
8148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8149 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8150 type
8151   TVec = Array[0..2] of Single;
8152 var
8153   Idx: Integer;
8154   du, dv: Double;
8155   Len: Single;
8156   Vec: TVec;
8157
8158   function GetHeight(X, Y: Integer): Single;
8159   begin
8160     with FuncRec do begin
8161       X := Max(0, Min(Size.X -1, X));
8162       Y := Max(0, Min(Size.Y -1, Y));
8163       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8164     end;
8165   end;
8166
8167 begin
8168   with FuncRec do begin
8169     with PglBitmapToNormalMapRec(Args)^ do begin
8170       du := 0;
8171       for Idx := Low(MatrixU) to High(MatrixU) do
8172         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8173
8174       dv := 0;
8175       for Idx := Low(MatrixU) to High(MatrixU) do
8176         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8177
8178       Vec[0] := -du * Scale;
8179       Vec[1] := -dv * Scale;
8180       Vec[2] := 1;
8181     end;
8182
8183     // Normalize
8184     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8185     if Len <> 0 then begin
8186       Vec[0] := Vec[0] * Len;
8187       Vec[1] := Vec[1] * Len;
8188       Vec[2] := Vec[2] * Len;
8189     end;
8190
8191     // Farbe zuweisem
8192     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8193     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8194     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8195   end;
8196 end;
8197
8198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8199 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8200 var
8201   Rec: TglBitmapToNormalMapRec;
8202
8203   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8204   begin
8205     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8206       Matrix[Index].X := X;
8207       Matrix[Index].Y := Y;
8208       Matrix[Index].W := W;
8209     end;
8210   end;
8211
8212 begin
8213   if TFormatDescriptor.Get(Format).IsCompressed then
8214     raise EglBitmapUnsupportedFormat.Create(Format);
8215
8216   if aScale > 100 then
8217     Rec.Scale := 100
8218   else if aScale < -100 then
8219     Rec.Scale := -100
8220   else
8221     Rec.Scale := aScale;
8222
8223   SetLength(Rec.Heights, Width * Height);
8224   try
8225     case aFunc of
8226       nm4Samples: begin
8227         SetLength(Rec.MatrixU, 2);
8228         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8229         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8230
8231         SetLength(Rec.MatrixV, 2);
8232         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8233         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8234       end;
8235
8236       nmSobel: begin
8237         SetLength(Rec.MatrixU, 6);
8238         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8239         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8240         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8241         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8242         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8243         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8244
8245         SetLength(Rec.MatrixV, 6);
8246         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8247         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8248         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8249         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8250         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8251         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8252       end;
8253
8254       nm3x3: begin
8255         SetLength(Rec.MatrixU, 6);
8256         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8257         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8258         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8259         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8260         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8261         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8262
8263         SetLength(Rec.MatrixV, 6);
8264         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8265         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8266         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8267         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8268         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8269         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8270       end;
8271
8272       nm5x5: begin
8273         SetLength(Rec.MatrixU, 20);
8274         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8275         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8276         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8277         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8278         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8279         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8280         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8281         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8282         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8283         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8284         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8285         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8286         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8287         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8288         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8289         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8290         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8291         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8292         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8293         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8294
8295         SetLength(Rec.MatrixV, 20);
8296         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8297         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8298         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8299         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8300         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8301         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8302         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8303         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8304         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8305         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8306         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8307         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8308         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8309         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8310         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8311         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8312         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8313         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8314         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8315         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8316       end;
8317     end;
8318
8319     // Daten Sammeln
8320     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8321       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8322     else
8323       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8324     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8325   finally
8326     SetLength(Rec.Heights, 0);
8327   end;
8328 end;
8329
8330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8331 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8333 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8334 begin
8335   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8336 end;
8337
8338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8339 procedure TglBitmapCubeMap.AfterConstruction;
8340 begin
8341   inherited;
8342
8343   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8344     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8345
8346   SetWrap;
8347   Target   := GL_TEXTURE_CUBE_MAP;
8348   fGenMode := GL_REFLECTION_MAP;
8349 end;
8350
8351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8352 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8353 var
8354   BuildWithGlu: Boolean;
8355   TexSize: Integer;
8356 begin
8357   if (aTestTextureSize) then begin
8358     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8359
8360     if (Height > TexSize) or (Width > TexSize) then
8361       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8362
8363     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8364       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8365   end;
8366
8367   if (ID = 0) then
8368     CreateID;
8369   SetupParameters(BuildWithGlu);
8370   UploadData(aCubeTarget, BuildWithGlu);
8371 end;
8372
8373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8374 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8375 begin
8376   inherited Bind (aEnableTextureUnit);
8377   if aEnableTexCoordsGen then begin
8378     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8379     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8380     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8381     glEnable(GL_TEXTURE_GEN_S);
8382     glEnable(GL_TEXTURE_GEN_T);
8383     glEnable(GL_TEXTURE_GEN_R);
8384   end;
8385 end;
8386
8387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8388 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8389 begin
8390   inherited Unbind(aDisableTextureUnit);
8391   if aDisableTexCoordsGen then begin
8392     glDisable(GL_TEXTURE_GEN_S);
8393     glDisable(GL_TEXTURE_GEN_T);
8394     glDisable(GL_TEXTURE_GEN_R);
8395   end;
8396 end;
8397
8398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8399 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8401 type
8402   TVec = Array[0..2] of Single;
8403   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8404
8405   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8406   TglBitmapNormalMapRec = record
8407     HalfSize : Integer;
8408     Func: TglBitmapNormalMapGetVectorFunc;
8409   end;
8410
8411   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8412 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8413 begin
8414   aVec[0] := aHalfSize;
8415   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8416   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8417 end;
8418
8419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8420 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8421 begin
8422   aVec[0] := - aHalfSize;
8423   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8424   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8425 end;
8426
8427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8428 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8429 begin
8430   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8431   aVec[1] := aHalfSize;
8432   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8433 end;
8434
8435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8436 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8437 begin
8438   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8439   aVec[1] := - aHalfSize;
8440   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8441 end;
8442
8443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8444 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8445 begin
8446   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8447   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8448   aVec[2] := aHalfSize;
8449 end;
8450
8451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8452 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8453 begin
8454   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8455   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8456   aVec[2] := - aHalfSize;
8457 end;
8458
8459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8460 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8461 var
8462   i: Integer;
8463   Vec: TVec;
8464   Len: Single;
8465 begin
8466   with FuncRec do begin
8467     with PglBitmapNormalMapRec(Args)^ do begin
8468       Func(Vec, Position, HalfSize);
8469
8470       // Normalize
8471       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8472       if Len <> 0 then begin
8473         Vec[0] := Vec[0] * Len;
8474         Vec[1] := Vec[1] * Len;
8475         Vec[2] := Vec[2] * Len;
8476       end;
8477
8478       // Scale Vector and AddVectro
8479       Vec[0] := Vec[0] * 0.5 + 0.5;
8480       Vec[1] := Vec[1] * 0.5 + 0.5;
8481       Vec[2] := Vec[2] * 0.5 + 0.5;
8482     end;
8483
8484     // Set Color
8485     for i := 0 to 2 do
8486       Dest.Data.arr[i] := Round(Vec[i] * 255);
8487   end;
8488 end;
8489
8490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8491 procedure TglBitmapNormalMap.AfterConstruction;
8492 begin
8493   inherited;
8494   fGenMode := GL_NORMAL_MAP;
8495 end;
8496
8497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8498 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8499 var
8500   Rec: TglBitmapNormalMapRec;
8501   SizeRec: TglBitmapPixelPosition;
8502 begin
8503   Rec.HalfSize := aSize div 2;
8504   FreeDataAfterGenTexture := false;
8505
8506   SizeRec.Fields := [ffX, ffY];
8507   SizeRec.X := aSize;
8508   SizeRec.Y := aSize;
8509
8510   // Positive X
8511   Rec.Func := glBitmapNormalMapPosX;
8512   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8513   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8514
8515   // Negative X
8516   Rec.Func := glBitmapNormalMapNegX;
8517   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8518   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8519
8520   // Positive Y
8521   Rec.Func := glBitmapNormalMapPosY;
8522   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8523   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8524
8525   // Negative Y
8526   Rec.Func := glBitmapNormalMapNegY;
8527   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8528   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8529
8530   // Positive Z
8531   Rec.Func := glBitmapNormalMapPosZ;
8532   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8533   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8534
8535   // Negative Z
8536   Rec.Func := glBitmapNormalMapNegZ;
8537   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8538   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8539 end;
8540
8541
8542 initialization
8543   glBitmapSetDefaultFormat (tfEmpty);
8544   glBitmapSetDefaultMipmap (mmMipmap);
8545   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8546   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8547   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8548
8549   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8550   glBitmapSetDefaultDeleteTextureOnFree    (true);
8551
8552   TFormatDescriptor.Init;
8553
8554 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8555   OpenGLInitialized := false;
8556   InitOpenGLCS := TCriticalSection.Create;
8557 {$ENDIF}
8558
8559 finalization
8560   TFormatDescriptor.Finalize;
8561
8562 {$IFDEF GLB_NATIVE_OGL}
8563   if Assigned(GL_LibHandle) then
8564     glbFreeLibrary(GL_LibHandle);
8565
8566 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8567   if Assigned(GLU_LibHandle) then
8568     glbFreeLibrary(GLU_LibHandle);
8569   FreeAndNil(InitOpenGLCS);
8570 {$ENDIF}
8571 {$ENDIF}
8572
8573 end.