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: PChar; aLibHandle: Pointer = nil): 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) 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   try
2029   {$IF DEFINED(GLB_WIN)}
2030     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2031   {$ELSEIF DEFINED(GLB_LINUX)}
2032     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2033     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2034   {$IFEND}
2035
2036     glEnable := glbGetProcAddress('glEnable');
2037     glDisable := glbGetProcAddress('glDisable');
2038     glGetString := glbGetProcAddress('glGetString');
2039     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2040     glTexParameteri := glbGetProcAddress('glTexParameteri');
2041     glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2042     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2043     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2044     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2045     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2046     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2047     glTexGeni := glbGetProcAddress('glTexGeni');
2048     glGenTextures := glbGetProcAddress('glGenTextures');
2049     glBindTexture := glbGetProcAddress('glBindTexture');
2050     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2051     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2052     glReadPixels := glbGetProcAddress('glReadPixels');
2053     glPixelStorei := glbGetProcAddress('glPixelStorei');
2054     glTexImage1D := glbGetProcAddress('glTexImage1D');
2055     glTexImage2D := glbGetProcAddress('glTexImage2D');
2056     glGetTexImage := glbGetProcAddress('glGetTexImage');
2057
2058     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2059     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2060   finally
2061     glbFreeLibrary(GL_LibHandle);
2062     glbFreeLibrary(GLU_LibHandle);
2063   end;
2064 end;
2065 {$ENDIF}
2066
2067 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 procedure glbReadOpenGLExtensions;
2069 var
2070   Buffer: AnsiString;
2071   MajorVersion, MinorVersion: Integer;
2072
2073   ///////////////////////////////////////////////////////////////////////////////////////////
2074   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2075   var
2076     Separator: Integer;
2077   begin
2078     aMinor := 0;
2079     aMajor := 0;
2080
2081     Separator := Pos(AnsiString('.'), aBuffer);
2082     if (Separator > 1) and (Separator < Length(aBuffer)) and
2083        (aBuffer[Separator - 1] in ['0'..'9']) and
2084        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2085
2086       Dec(Separator);
2087       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2088         Dec(Separator);
2089
2090       Delete(aBuffer, 1, Separator);
2091       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2092
2093       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2094         Inc(Separator);
2095
2096       Delete(aBuffer, Separator, 255);
2097       Separator := Pos(AnsiString('.'), aBuffer);
2098
2099       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2100       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2101     end;
2102   end;
2103
2104   ///////////////////////////////////////////////////////////////////////////////////////////
2105   function CheckExtension(const Extension: AnsiString): Boolean;
2106   var
2107     ExtPos: Integer;
2108   begin
2109     ExtPos := Pos(Extension, Buffer);
2110     result := ExtPos > 0;
2111     if result then
2112       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2113   end;
2114
2115   ///////////////////////////////////////////////////////////////////////////////////////////
2116   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2117   begin
2118     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2119   end;
2120
2121 begin
2122 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2123   InitOpenGLCS.Enter;
2124   try
2125     if not OpenGLInitialized then begin
2126       glbInitOpenGL;
2127       OpenGLInitialized := true;
2128     end;
2129   finally
2130     InitOpenGLCS.Leave;
2131   end;
2132 {$ENDIF}
2133
2134   // Version
2135   Buffer := glGetString(GL_VERSION);
2136   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2137
2138   GL_VERSION_1_2 := CheckVersion(1, 2);
2139   GL_VERSION_1_3 := CheckVersion(1, 3);
2140   GL_VERSION_1_4 := CheckVersion(1, 4);
2141   GL_VERSION_2_0 := CheckVersion(2, 0);
2142   GL_VERSION_3_3 := CheckVersion(3, 3);
2143
2144   // Extensions
2145   Buffer := glGetString(GL_EXTENSIONS);
2146   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2147   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2148   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2149   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2150   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2151   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2152   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2153   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2154   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2155   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2156   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2157   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2158   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2159   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2160
2161   if GL_VERSION_1_3 then begin
2162     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2163     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2164     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2165   end else begin
2166     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2167     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2168     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2169   end;
2170 end;
2171 {$ENDIF}
2172
2173 {$IFDEF GLB_SDL_IMAGE}
2174 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2175 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2176 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2177 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2178 begin
2179   result := TStream(context^.unknown.data1).Seek(offset, whence);
2180 end;
2181
2182 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2183 begin
2184   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2185 end;
2186
2187 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2188 begin
2189   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2190 end;
2191
2192 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2193 begin
2194   result := 0;
2195 end;
2196
2197 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2198 begin
2199   result := SDL_AllocRW;
2200
2201   if result = nil then
2202     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2203
2204   result^.seek := glBitmapRWseek;
2205   result^.read := glBitmapRWread;
2206   result^.write := glBitmapRWwrite;
2207   result^.close := glBitmapRWclose;
2208   result^.unknown.data1 := Stream;
2209 end;
2210 {$ENDIF}
2211
2212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2214 begin
2215   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2216 end;
2217
2218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2219 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2220 begin
2221   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2222 end;
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2226 begin
2227   glBitmapDefaultMipmap := aValue;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2232 begin
2233   glBitmapDefaultFormat := aFormat;
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2238 begin
2239   glBitmapDefaultFilterMin := aMin;
2240   glBitmapDefaultFilterMag := aMag;
2241 end;
2242
2243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2244 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2245 begin
2246   glBitmapDefaultWrapS := S;
2247   glBitmapDefaultWrapT := T;
2248   glBitmapDefaultWrapR := R;
2249 end;
2250
2251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2252 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2253 begin
2254   glDefaultSwizzle[0] := r;
2255   glDefaultSwizzle[1] := g;
2256   glDefaultSwizzle[2] := b;
2257   glDefaultSwizzle[3] := a;
2258 end;
2259
2260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2261 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2262 begin
2263   result := glBitmapDefaultDeleteTextureOnFree;
2264 end;
2265
2266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2267 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2268 begin
2269   result := glBitmapDefaultFreeDataAfterGenTextures;
2270 end;
2271
2272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2273 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2274 begin
2275   result := glBitmapDefaultMipmap;
2276 end;
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 function glBitmapGetDefaultFormat: TglBitmapFormat;
2280 begin
2281   result := glBitmapDefaultFormat;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2286 begin
2287   aMin := glBitmapDefaultFilterMin;
2288   aMag := glBitmapDefaultFilterMag;
2289 end;
2290
2291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2292 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2293 begin
2294   S := glBitmapDefaultWrapS;
2295   T := glBitmapDefaultWrapT;
2296   R := glBitmapDefaultWrapR;
2297 end;
2298
2299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2300 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2301 begin
2302   r := glDefaultSwizzle[0];
2303   g := glDefaultSwizzle[1];
2304   b := glDefaultSwizzle[2];
2305   a := glDefaultSwizzle[3];
2306 end;
2307
2308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2309 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 function TFormatDescriptor.GetRedMask: QWord;
2312 begin
2313   result := fRange.r shl fShift.r;
2314 end;
2315
2316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2317 function TFormatDescriptor.GetGreenMask: QWord;
2318 begin
2319   result := fRange.g shl fShift.g;
2320 end;
2321
2322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2323 function TFormatDescriptor.GetBlueMask: QWord;
2324 begin
2325   result := fRange.b shl fShift.b;
2326 end;
2327
2328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 function TFormatDescriptor.GetAlphaMask: QWord;
2330 begin
2331   result := fRange.a shl fShift.a;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 function TFormatDescriptor.GetIsCompressed: Boolean;
2336 begin
2337   result := fIsCompressed;
2338 end;
2339
2340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2341 function TFormatDescriptor.GetHasAlpha: Boolean;
2342 begin
2343   result := (fRange.a > 0);
2344 end;
2345
2346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2347 function TFormatDescriptor.GetglFormat: GLenum;
2348 begin
2349   result := fglFormat;
2350 end;
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 function TFormatDescriptor.GetglInternalFormat: GLenum;
2354 begin
2355   result := fglInternalFormat;
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetglDataFormat: GLenum;
2360 begin
2361   result := fglDataFormat;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetComponents: Integer;
2366 var
2367   i: Integer;
2368 begin
2369   result := 0;
2370   for i := 0 to 3 do
2371     if (fRange.arr[i] > 0) then
2372       inc(result);
2373 end;
2374
2375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2377 var
2378   w, h: Integer;
2379 begin
2380   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2381     w := Max(1, aSize.X);
2382     h := Max(1, aSize.Y);
2383     result := GetSize(w, h);
2384   end else
2385     result := 0;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2390 begin
2391   result := 0;
2392   if (aWidth <= 0) or (aHeight <= 0) then
2393     exit;
2394   result := Ceil(aWidth * aHeight * fPixelSize);
2395 end;
2396
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 function TFormatDescriptor.CreateMappingData: Pointer;
2399 begin
2400   result := nil;
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2405 begin
2406   //DUMMY
2407 end;
2408
2409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2410 function TFormatDescriptor.IsEmpty: Boolean;
2411 begin
2412   result := (fFormat = tfEmpty);
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2417 begin
2418   result := false;
2419   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2420     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2421   if (aRedMask   <> RedMask) then
2422     exit;
2423   if (aGreenMask <> GreenMask) then
2424     exit;
2425   if (aBlueMask  <> BlueMask) then
2426     exit;
2427   if (aAlphaMask <> AlphaMask) then
2428     exit;
2429   result := true;
2430 end;
2431
2432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2433 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2434 begin
2435   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2436   aPixel.Data   := fRange;
2437   aPixel.Range  := fRange;
2438   aPixel.Format := fFormat;
2439 end;
2440
2441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2442 constructor TFormatDescriptor.Create;
2443 begin
2444   inherited Create;
2445
2446   fFormat       := tfEmpty;
2447   fWithAlpha    := tfEmpty;
2448   fWithoutAlpha := tfEmpty;
2449   fRGBInverted  := tfEmpty;
2450   fUncompressed := tfEmpty;
2451   fPixelSize    := 0.0;
2452   fIsCompressed := false;
2453
2454   fglFormat         := 0;
2455   fglInternalFormat := 0;
2456   fglDataFormat     := 0;
2457
2458   FillChar(fRange, 0, SizeOf(fRange));
2459   FillChar(fShift, 0, SizeOf(fShift));
2460 end;
2461
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2466 begin
2467   aData^ := aPixel.Data.a;
2468   inc(aData);
2469 end;
2470
2471 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2472 begin
2473   aPixel.Data.r := 0;
2474   aPixel.Data.g := 0;
2475   aPixel.Data.b := 0;
2476   aPixel.Data.a := aData^;
2477   inc(aData);
2478 end;
2479
2480 constructor TfdAlpha_UB1.Create;
2481 begin
2482   inherited Create;
2483   fPixelSize        := 1.0;
2484   fRange.a          := $FF;
2485   fglFormat         := GL_ALPHA;
2486   fglDataFormat     := GL_UNSIGNED_BYTE;
2487 end;
2488
2489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2492 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2493 begin
2494   aData^ := LuminanceWeight(aPixel);
2495   inc(aData);
2496 end;
2497
2498 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2499 begin
2500   aPixel.Data.r := aData^;
2501   aPixel.Data.g := aData^;
2502   aPixel.Data.b := aData^;
2503   aPixel.Data.a := 0;
2504   inc(aData);
2505 end;
2506
2507 constructor TfdLuminance_UB1.Create;
2508 begin
2509   inherited Create;
2510   fPixelSize        := 1.0;
2511   fRange.r          := $FF;
2512   fRange.g          := $FF;
2513   fRange.b          := $FF;
2514   fglFormat         := GL_LUMINANCE;
2515   fglDataFormat     := GL_UNSIGNED_BYTE;
2516 end;
2517
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2522 var
2523   i: Integer;
2524 begin
2525   aData^ := 0;
2526   for i := 0 to 3 do
2527     if (fRange.arr[i] > 0) then
2528       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2529   inc(aData);
2530 end;
2531
2532 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2533 var
2534   i: Integer;
2535 begin
2536   for i := 0 to 3 do
2537     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2538   inc(aData);
2539 end;
2540
2541 constructor TfdUniversal_UB1.Create;
2542 begin
2543   inherited Create;
2544   fPixelSize := 1.0;
2545 end;
2546
2547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2551 begin
2552   inherited Map(aPixel, aData, aMapData);
2553   aData^ := aPixel.Data.a;
2554   inc(aData);
2555 end;
2556
2557 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2558 begin
2559   inherited Unmap(aData, aPixel, aMapData);
2560   aPixel.Data.a := aData^;
2561   inc(aData);
2562 end;
2563
2564 constructor TfdLuminanceAlpha_UB2.Create;
2565 begin
2566   inherited Create;
2567   fPixelSize        := 2.0;
2568   fRange.a          := $FF;
2569   fShift.a          :=   8;
2570   fglFormat         := GL_LUMINANCE_ALPHA;
2571   fglDataFormat     := GL_UNSIGNED_BYTE;
2572 end;
2573
2574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2578 begin
2579   aData^ := aPixel.Data.r;
2580   inc(aData);
2581   aData^ := aPixel.Data.g;
2582   inc(aData);
2583   aData^ := aPixel.Data.b;
2584   inc(aData);
2585 end;
2586
2587 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2588 begin
2589   aPixel.Data.r := aData^;
2590   inc(aData);
2591   aPixel.Data.g := aData^;
2592   inc(aData);
2593   aPixel.Data.b := aData^;
2594   inc(aData);
2595   aPixel.Data.a := 0;
2596 end;
2597
2598 constructor TfdRGB_UB3.Create;
2599 begin
2600   inherited Create;
2601   fPixelSize        := 3.0;
2602   fRange.r          := $FF;
2603   fRange.g          := $FF;
2604   fRange.b          := $FF;
2605   fShift.r          :=   0;
2606   fShift.g          :=   8;
2607   fShift.b          :=  16;
2608   fglFormat         := GL_RGB;
2609   fglDataFormat     := GL_UNSIGNED_BYTE;
2610 end;
2611
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2615 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2616 begin
2617   aData^ := aPixel.Data.b;
2618   inc(aData);
2619   aData^ := aPixel.Data.g;
2620   inc(aData);
2621   aData^ := aPixel.Data.r;
2622   inc(aData);
2623 end;
2624
2625 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2626 begin
2627   aPixel.Data.b := aData^;
2628   inc(aData);
2629   aPixel.Data.g := aData^;
2630   inc(aData);
2631   aPixel.Data.r := aData^;
2632   inc(aData);
2633   aPixel.Data.a := 0;
2634 end;
2635
2636 constructor TfdBGR_UB3.Create;
2637 begin
2638   fPixelSize        := 3.0;
2639   fRange.r          := $FF;
2640   fRange.g          := $FF;
2641   fRange.b          := $FF;
2642   fShift.r          :=  16;
2643   fShift.g          :=   8;
2644   fShift.b          :=   0;
2645   fglFormat         := GL_BGR;
2646   fglDataFormat     := GL_UNSIGNED_BYTE;
2647 end;
2648
2649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2653 begin
2654   inherited Map(aPixel, aData, aMapData);
2655   aData^ := aPixel.Data.a;
2656   inc(aData);
2657 end;
2658
2659 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2660 begin
2661   inherited Unmap(aData, aPixel, aMapData);
2662   aPixel.Data.a := aData^;
2663   inc(aData);
2664 end;
2665
2666 constructor TfdRGBA_UB4.Create;
2667 begin
2668   inherited Create;
2669   fPixelSize        := 4.0;
2670   fRange.a          := $FF;
2671   fShift.a          :=  24;
2672   fglFormat         := GL_RGBA;
2673   fglDataFormat     := GL_UNSIGNED_BYTE;
2674 end;
2675
2676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2679 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2680 begin
2681   inherited Map(aPixel, aData, aMapData);
2682   aData^ := aPixel.Data.a;
2683   inc(aData);
2684 end;
2685
2686 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2687 begin
2688   inherited Unmap(aData, aPixel, aMapData);
2689   aPixel.Data.a := aData^;
2690   inc(aData);
2691 end;
2692
2693 constructor TfdBGRA_UB4.Create;
2694 begin
2695   inherited Create;
2696   fPixelSize        := 4.0;
2697   fRange.a          := $FF;
2698   fShift.a          :=  24;
2699   fglFormat         := GL_BGRA;
2700   fglDataFormat     := GL_UNSIGNED_BYTE;
2701 end;
2702
2703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2704 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2706 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2707 begin
2708   PWord(aData)^ := aPixel.Data.a;
2709   inc(aData, 2);
2710 end;
2711
2712 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2713 begin
2714   aPixel.Data.r := 0;
2715   aPixel.Data.g := 0;
2716   aPixel.Data.b := 0;
2717   aPixel.Data.a := PWord(aData)^;
2718   inc(aData, 2);
2719 end;
2720
2721 constructor TfdAlpha_US1.Create;
2722 begin
2723   inherited Create;
2724   fPixelSize        := 2.0;
2725   fRange.a          := $FFFF;
2726   fglFormat         := GL_ALPHA;
2727   fglDataFormat     := GL_UNSIGNED_SHORT;
2728 end;
2729
2730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2731 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2733 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2734 begin
2735   PWord(aData)^ := LuminanceWeight(aPixel);
2736   inc(aData, 2);
2737 end;
2738
2739 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2740 begin
2741   aPixel.Data.r := PWord(aData)^;
2742   aPixel.Data.g := PWord(aData)^;
2743   aPixel.Data.b := PWord(aData)^;
2744   aPixel.Data.a := 0;
2745   inc(aData, 2);
2746 end;
2747
2748 constructor TfdLuminance_US1.Create;
2749 begin
2750   inherited Create;
2751   fPixelSize        := 2.0;
2752   fRange.r          := $FFFF;
2753   fRange.g          := $FFFF;
2754   fRange.b          := $FFFF;
2755   fglFormat         := GL_LUMINANCE;
2756   fglDataFormat     := GL_UNSIGNED_SHORT;
2757 end;
2758
2759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2763 var
2764   i: Integer;
2765 begin
2766   PWord(aData)^ := 0;
2767   for i := 0 to 3 do
2768     if (fRange.arr[i] > 0) then
2769       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2770   inc(aData, 2);
2771 end;
2772
2773 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2774 var
2775   i: Integer;
2776 begin
2777   for i := 0 to 3 do
2778     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2779   inc(aData, 2);
2780 end;
2781
2782 constructor TfdUniversal_US1.Create;
2783 begin
2784   inherited Create;
2785   fPixelSize := 2.0;
2786 end;
2787
2788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2792 begin
2793   PWord(aData)^ := DepthWeight(aPixel);
2794   inc(aData, 2);
2795 end;
2796
2797 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2798 begin
2799   aPixel.Data.r := PWord(aData)^;
2800   aPixel.Data.g := PWord(aData)^;
2801   aPixel.Data.b := PWord(aData)^;
2802   aPixel.Data.a := 0;
2803   inc(aData, 2);
2804 end;
2805
2806 constructor TfdDepth_US1.Create;
2807 begin
2808   inherited Create;
2809   fPixelSize        := 2.0;
2810   fRange.r          := $FFFF;
2811   fRange.g          := $FFFF;
2812   fRange.b          := $FFFF;
2813   fglFormat         := GL_DEPTH_COMPONENT;
2814   fglDataFormat     := GL_UNSIGNED_SHORT;
2815 end;
2816
2817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2818 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2821 begin
2822   inherited Map(aPixel, aData, aMapData);
2823   PWord(aData)^ := aPixel.Data.a;
2824   inc(aData, 2);
2825 end;
2826
2827 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2828 begin
2829   inherited Unmap(aData, aPixel, aMapData);
2830   aPixel.Data.a := PWord(aData)^;
2831   inc(aData, 2);
2832 end;
2833
2834 constructor TfdLuminanceAlpha_US2.Create;
2835 begin
2836   inherited Create;
2837   fPixelSize        :=   4.0;
2838   fRange.a          := $FFFF;
2839   fShift.a          :=    16;
2840   fglFormat         := GL_LUMINANCE_ALPHA;
2841   fglDataFormat     := GL_UNSIGNED_SHORT;
2842 end;
2843
2844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2845 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2848 begin
2849   PWord(aData)^ := aPixel.Data.r;
2850   inc(aData, 2);
2851   PWord(aData)^ := aPixel.Data.g;
2852   inc(aData, 2);
2853   PWord(aData)^ := aPixel.Data.b;
2854   inc(aData, 2);
2855 end;
2856
2857 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2858 begin
2859   aPixel.Data.r := PWord(aData)^;
2860   inc(aData, 2);
2861   aPixel.Data.g := PWord(aData)^;
2862   inc(aData, 2);
2863   aPixel.Data.b := PWord(aData)^;
2864   inc(aData, 2);
2865   aPixel.Data.a := 0;
2866 end;
2867
2868 constructor TfdRGB_US3.Create;
2869 begin
2870   inherited Create;
2871   fPixelSize        :=   6.0;
2872   fRange.r          := $FFFF;
2873   fRange.g          := $FFFF;
2874   fRange.b          := $FFFF;
2875   fShift.r          :=     0;
2876   fShift.g          :=    16;
2877   fShift.b          :=    32;
2878   fglFormat         := GL_RGB;
2879   fglDataFormat     := GL_UNSIGNED_SHORT;
2880 end;
2881
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2885 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2886 begin
2887   PWord(aData)^ := aPixel.Data.b;
2888   inc(aData, 2);
2889   PWord(aData)^ := aPixel.Data.g;
2890   inc(aData, 2);
2891   PWord(aData)^ := aPixel.Data.r;
2892   inc(aData, 2);
2893 end;
2894
2895 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2896 begin
2897   aPixel.Data.b := PWord(aData)^;
2898   inc(aData, 2);
2899   aPixel.Data.g := PWord(aData)^;
2900   inc(aData, 2);
2901   aPixel.Data.r := PWord(aData)^;
2902   inc(aData, 2);
2903   aPixel.Data.a := 0;
2904 end;
2905
2906 constructor TfdBGR_US3.Create;
2907 begin
2908   inherited Create;
2909   fPixelSize        :=   6.0;
2910   fRange.r          := $FFFF;
2911   fRange.g          := $FFFF;
2912   fRange.b          := $FFFF;
2913   fShift.r          :=    32;
2914   fShift.g          :=    16;
2915   fShift.b          :=     0;
2916   fglFormat         := GL_BGR;
2917   fglDataFormat     := GL_UNSIGNED_SHORT;
2918 end;
2919
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2923 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2924 begin
2925   inherited Map(aPixel, aData, aMapData);
2926   PWord(aData)^ := aPixel.Data.a;
2927   inc(aData, 2);
2928 end;
2929
2930 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2931 begin
2932   inherited Unmap(aData, aPixel, aMapData);
2933   aPixel.Data.a := PWord(aData)^;
2934   inc(aData, 2);
2935 end;
2936
2937 constructor TfdRGBA_US4.Create;
2938 begin
2939   inherited Create;
2940   fPixelSize        :=   8.0;
2941   fRange.a          := $FFFF;
2942   fShift.a          :=    48;
2943   fglFormat         := GL_RGBA;
2944   fglDataFormat     := GL_UNSIGNED_SHORT;
2945 end;
2946
2947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2948 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2950 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2951 begin
2952   inherited Map(aPixel, aData, aMapData);
2953   PWord(aData)^ := aPixel.Data.a;
2954   inc(aData, 2);
2955 end;
2956
2957 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2958 begin
2959   inherited Unmap(aData, aPixel, aMapData);
2960   aPixel.Data.a := PWord(aData)^;
2961   inc(aData, 2);
2962 end;
2963
2964 constructor TfdBGRA_US4.Create;
2965 begin
2966   inherited Create;
2967   fPixelSize        :=   8.0;
2968   fRange.a          := $FFFF;
2969   fShift.a          :=    48;
2970   fglFormat         := GL_BGRA;
2971   fglDataFormat     := GL_UNSIGNED_SHORT;
2972 end;
2973
2974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2977 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2978 var
2979   i: Integer;
2980 begin
2981   PCardinal(aData)^ := 0;
2982   for i := 0 to 3 do
2983     if (fRange.arr[i] > 0) then
2984       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2985   inc(aData, 4);
2986 end;
2987
2988 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2989 var
2990   i: Integer;
2991 begin
2992   for i := 0 to 3 do
2993     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2994   inc(aData, 2);
2995 end;
2996
2997 constructor TfdUniversal_UI1.Create;
2998 begin
2999   inherited Create;
3000   fPixelSize := 4.0;
3001 end;
3002
3003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3004 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3007 begin
3008   PCardinal(aData)^ := DepthWeight(aPixel);
3009   inc(aData, 4);
3010 end;
3011
3012 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3013 begin
3014   aPixel.Data.r := PCardinal(aData)^;
3015   aPixel.Data.g := PCardinal(aData)^;
3016   aPixel.Data.b := PCardinal(aData)^;
3017   aPixel.Data.a := 0;
3018   inc(aData, 4);
3019 end;
3020
3021 constructor TfdDepth_UI1.Create;
3022 begin
3023   inherited Create;
3024   fPixelSize        := 4.0;
3025   fRange.r          := $FFFFFFFF;
3026   fRange.g          := $FFFFFFFF;
3027   fRange.b          := $FFFFFFFF;
3028   fglFormat         := GL_DEPTH_COMPONENT;
3029   fglDataFormat     := GL_UNSIGNED_INT;
3030 end;
3031
3032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 constructor TfdAlpha4.Create;
3036 begin
3037   inherited Create;
3038   fFormat           := tfAlpha4;
3039   fWithAlpha        := tfAlpha4;
3040   fglInternalFormat := GL_ALPHA4;
3041 end;
3042
3043 constructor TfdAlpha8.Create;
3044 begin
3045   inherited Create;
3046   fFormat           := tfAlpha8;
3047   fWithAlpha        := tfAlpha8;
3048   fglInternalFormat := GL_ALPHA8;
3049 end;
3050
3051 constructor TfdAlpha12.Create;
3052 begin
3053   inherited Create;
3054   fFormat           := tfAlpha12;
3055   fWithAlpha        := tfAlpha12;
3056   fglInternalFormat := GL_ALPHA12;
3057 end;
3058
3059 constructor TfdAlpha16.Create;
3060 begin
3061   inherited Create;
3062   fFormat           := tfAlpha16;
3063   fWithAlpha        := tfAlpha16;
3064   fglInternalFormat := GL_ALPHA16;
3065 end;
3066
3067 constructor TfdLuminance4.Create;
3068 begin
3069   inherited Create;
3070   fFormat           := tfLuminance4;
3071   fWithAlpha        := tfLuminance4Alpha4;
3072   fWithoutAlpha     := tfLuminance4;
3073   fglInternalFormat := GL_LUMINANCE4;
3074 end;
3075
3076 constructor TfdLuminance8.Create;
3077 begin
3078   inherited Create;
3079   fFormat           := tfLuminance8;
3080   fWithAlpha        := tfLuminance8Alpha8;
3081   fWithoutAlpha     := tfLuminance8;
3082   fglInternalFormat := GL_LUMINANCE8;
3083 end;
3084
3085 constructor TfdLuminance12.Create;
3086 begin
3087   inherited Create;
3088   fFormat           := tfLuminance12;
3089   fWithAlpha        := tfLuminance12Alpha12;
3090   fWithoutAlpha     := tfLuminance12;
3091   fglInternalFormat := GL_LUMINANCE12;
3092 end;
3093
3094 constructor TfdLuminance16.Create;
3095 begin
3096   inherited Create;
3097   fFormat           := tfLuminance16;
3098   fWithAlpha        := tfLuminance16Alpha16;
3099   fWithoutAlpha     := tfLuminance16;
3100   fglInternalFormat := GL_LUMINANCE16;
3101 end;
3102
3103 constructor TfdLuminance4Alpha4.Create;
3104 begin
3105   inherited Create;
3106   fFormat           := tfLuminance4Alpha4;
3107   fWithAlpha        := tfLuminance4Alpha4;
3108   fWithoutAlpha     := tfLuminance4;
3109   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3110 end;
3111
3112 constructor TfdLuminance6Alpha2.Create;
3113 begin
3114   inherited Create;
3115   fFormat           := tfLuminance6Alpha2;
3116   fWithAlpha        := tfLuminance6Alpha2;
3117   fWithoutAlpha     := tfLuminance8;
3118   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3119 end;
3120
3121 constructor TfdLuminance8Alpha8.Create;
3122 begin
3123   inherited Create;
3124   fFormat           := tfLuminance8Alpha8;
3125   fWithAlpha        := tfLuminance8Alpha8;
3126   fWithoutAlpha     := tfLuminance8;
3127   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3128 end;
3129
3130 constructor TfdLuminance12Alpha4.Create;
3131 begin
3132   inherited Create;
3133   fFormat           := tfLuminance12Alpha4;
3134   fWithAlpha        := tfLuminance12Alpha4;
3135   fWithoutAlpha     := tfLuminance12;
3136   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3137 end;
3138
3139 constructor TfdLuminance12Alpha12.Create;
3140 begin
3141   inherited Create;
3142   fFormat           := tfLuminance12Alpha12;
3143   fWithAlpha        := tfLuminance12Alpha12;
3144   fWithoutAlpha     := tfLuminance12;
3145   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3146 end;
3147
3148 constructor TfdLuminance16Alpha16.Create;
3149 begin
3150   inherited Create;
3151   fFormat           := tfLuminance16Alpha16;
3152   fWithAlpha        := tfLuminance16Alpha16;
3153   fWithoutAlpha     := tfLuminance16;
3154   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3155 end;
3156
3157 constructor TfdR3G3B2.Create;
3158 begin
3159   inherited Create;
3160   fFormat           := tfR3G3B2;
3161   fWithAlpha        := tfRGBA2;
3162   fWithoutAlpha     := tfR3G3B2;
3163   fRange.r          := $7;
3164   fRange.g          := $7;
3165   fRange.b          := $3;
3166   fShift.r          :=  0;
3167   fShift.g          :=  3;
3168   fShift.b          :=  6;
3169   fglFormat         := GL_RGB;
3170   fglInternalFormat := GL_R3_G3_B2;
3171   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3172 end;
3173
3174 constructor TfdRGB4.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfRGB4;
3178   fWithAlpha        := tfRGBA4;
3179   fWithoutAlpha     := tfRGB4;
3180   fRGBInverted      := tfBGR4;
3181   fRange.r          := $F;
3182   fRange.g          := $F;
3183   fRange.b          := $F;
3184   fShift.r          :=  0;
3185   fShift.g          :=  4;
3186   fShift.b          :=  8;
3187   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3188   fglInternalFormat := GL_RGB4;
3189   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3190 end;
3191
3192 constructor TfdR5G6B5.Create;
3193 begin
3194   inherited Create;
3195   fFormat           := tfR5G6B5;
3196   fWithAlpha        := tfRGBA4;
3197   fWithoutAlpha     := tfR5G6B5;
3198   fRGBInverted      := tfB5G6R5;
3199   fRange.r          := $1F;
3200   fRange.g          := $3F;
3201   fRange.b          := $1F;
3202   fShift.r          :=   0;
3203   fShift.g          :=   5;
3204   fShift.b          :=  11;
3205   fglFormat         := GL_RGB;
3206   fglInternalFormat := GL_RGB565;
3207   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3208 end;
3209
3210 constructor TfdRGB5.Create;
3211 begin
3212   inherited Create;
3213   fFormat           := tfRGB5;
3214   fWithAlpha        := tfRGB5A1;
3215   fWithoutAlpha     := tfRGB5;
3216   fRGBInverted      := tfBGR5;
3217   fRange.r          := $1F;
3218   fRange.g          := $1F;
3219   fRange.b          := $1F;
3220   fShift.r          :=   0;
3221   fShift.g          :=   5;
3222   fShift.b          :=  10;
3223   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3224   fglInternalFormat := GL_RGB5;
3225   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3226 end;
3227
3228 constructor TfdRGB8.Create;
3229 begin
3230   inherited Create;
3231   fFormat           := tfRGB8;
3232   fWithAlpha        := tfRGBA8;
3233   fWithoutAlpha     := tfRGB8;
3234   fRGBInverted      := tfBGR8;
3235   fglInternalFormat := GL_RGB8;
3236 end;
3237
3238 constructor TfdRGB10.Create;
3239 begin
3240   inherited Create;
3241   fFormat           := tfRGB10;
3242   fWithAlpha        := tfRGB10A2;
3243   fWithoutAlpha     := tfRGB10;
3244   fRGBInverted      := tfBGR10;
3245   fRange.r          := $3FF;
3246   fRange.g          := $3FF;
3247   fRange.b          := $3FF;
3248   fShift.r          :=    0;
3249   fShift.g          :=   10;
3250   fShift.b          :=   20;
3251   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3252   fglInternalFormat := GL_RGB10;
3253   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3254 end;
3255
3256 constructor TfdRGB12.Create;
3257 begin
3258   inherited Create;
3259   fFormat           := tfRGB12;
3260   fWithAlpha        := tfRGBA12;
3261   fWithoutAlpha     := tfRGB12;
3262   fRGBInverted      := tfBGR12;
3263   fglInternalFormat := GL_RGB12;
3264 end;
3265
3266 constructor TfdRGB16.Create;
3267 begin
3268   inherited Create;
3269   fFormat           := tfRGB16;
3270   fWithAlpha        := tfRGBA16;
3271   fWithoutAlpha     := tfRGB16;
3272   fRGBInverted      := tfBGR16;
3273   fglInternalFormat := GL_RGB16;
3274 end;
3275
3276 constructor TfdRGBA2.Create;
3277 begin
3278   inherited Create;
3279   fFormat           := tfRGBA2;
3280   fWithAlpha        := tfRGBA2;
3281   fWithoutAlpha     := tfR3G3B2;
3282   fRGBInverted      := tfBGRA2;
3283   fglInternalFormat := GL_RGBA2;
3284 end;
3285
3286 constructor TfdRGBA4.Create;
3287 begin
3288   inherited Create;
3289   fFormat           := tfRGBA4;
3290   fWithAlpha        := tfRGBA4;
3291   fWithoutAlpha     := tfRGB4;
3292   fRGBInverted      := tfBGRA4;
3293   fRange.r          := $F;
3294   fRange.g          := $F;
3295   fRange.b          := $F;
3296   fRange.a          := $F;
3297   fShift.r          :=  0;
3298   fShift.g          :=  4;
3299   fShift.b          :=  8;
3300   fShift.a          := 12;
3301   fglFormat         := GL_RGBA;
3302   fglInternalFormat := GL_RGBA4;
3303   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3304 end;
3305
3306 constructor TfdRGB5A1.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfRGB5A1;
3310   fWithAlpha        := tfRGB5A1;
3311   fWithoutAlpha     := tfRGB5;
3312   fRGBInverted      := tfBGR5A1;
3313   fRange.r          := $1F;
3314   fRange.g          := $1F;
3315   fRange.b          := $1F;
3316   fRange.a          := $01;
3317   fShift.r          :=   0;
3318   fShift.g          :=   5;
3319   fShift.b          :=  10;
3320   fShift.a          :=  15;
3321   fglFormat         := GL_RGBA;
3322   fglInternalFormat := GL_RGB5_A1;
3323   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3324 end;
3325
3326 constructor TfdRGBA8.Create;
3327 begin
3328   inherited Create;
3329   fFormat           := tfRGBA8;
3330   fWithAlpha        := tfRGBA8;
3331   fWithoutAlpha     := tfRGB8;
3332   fRGBInverted      := tfBGRA8;
3333   fglInternalFormat := GL_RGBA8;
3334 end;
3335
3336 constructor TfdRGB10A2.Create;
3337 begin
3338   inherited Create;
3339   fFormat           := tfRGB10A2;
3340   fWithAlpha        := tfRGB10A2;
3341   fWithoutAlpha     := tfRGB10;
3342   fRGBInverted      := tfBGR10A2;
3343   fRange.r          := $3FF;
3344   fRange.g          := $3FF;
3345   fRange.b          := $3FF;
3346   fRange.a          := $003;
3347   fShift.r          :=    0;
3348   fShift.g          :=   10;
3349   fShift.b          :=   20;
3350   fShift.a          :=   30;
3351   fglFormat         := GL_RGBA;
3352   fglInternalFormat := GL_RGB10_A2;
3353   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3354 end;
3355
3356 constructor TfdRGBA12.Create;
3357 begin
3358   inherited Create;
3359   fFormat           := tfRGBA12;
3360   fWithAlpha        := tfRGBA12;
3361   fWithoutAlpha     := tfRGB12;
3362   fRGBInverted      := tfBGRA12;
3363   fglInternalFormat := GL_RGBA12;
3364 end;
3365
3366 constructor TfdRGBA16.Create;
3367 begin
3368   inherited Create;
3369   fFormat           := tfRGBA16;
3370   fWithAlpha        := tfRGBA16;
3371   fWithoutAlpha     := tfRGB16;
3372   fRGBInverted      := tfBGRA16;
3373   fglInternalFormat := GL_RGBA16;
3374 end;
3375
3376 constructor TfdBGR4.Create;
3377 begin
3378   inherited Create;
3379   fPixelSize        := 2.0;
3380   fFormat           := tfBGR4;
3381   fWithAlpha        := tfBGRA4;
3382   fWithoutAlpha     := tfBGR4;
3383   fRGBInverted      := tfRGB4;
3384   fRange.r          := $F;
3385   fRange.g          := $F;
3386   fRange.b          := $F;
3387   fRange.a          := $0;
3388   fShift.r          :=  8;
3389   fShift.g          :=  4;
3390   fShift.b          :=  0;
3391   fShift.a          :=  0;
3392   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3393   fglInternalFormat := GL_RGB4;
3394   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3395 end;
3396
3397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3400 constructor TfdB5G6R5.Create;
3401 begin
3402   inherited Create;
3403   fFormat           := tfB5G6R5;
3404   fWithAlpha        := tfBGRA4;
3405   fWithoutAlpha     := tfB5G6R5;
3406   fRGBInverted      := tfR5G6B5;
3407   fRange.r          := $1F;
3408   fRange.g          := $3F;
3409   fRange.b          := $1F;
3410   fShift.r          :=  11;
3411   fShift.g          :=   5;
3412   fShift.b          :=   0;
3413   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3414   fglInternalFormat := GL_RGB8;
3415   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3416 end;
3417
3418 constructor TfdBGR5.Create;
3419 begin
3420   inherited Create;
3421   fPixelSize        := 2.0;
3422   fFormat           := tfBGR5;
3423   fWithAlpha        := tfBGR5A1;
3424   fWithoutAlpha     := tfBGR5;
3425   fRGBInverted      := tfRGB5;
3426   fRange.r          := $1F;
3427   fRange.g          := $1F;
3428   fRange.b          := $1F;
3429   fRange.a          := $00;
3430   fShift.r          :=  10;
3431   fShift.g          :=   5;
3432   fShift.b          :=   0;
3433   fShift.a          :=   0;
3434   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3435   fglInternalFormat := GL_RGB5;
3436   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3437 end;
3438
3439 constructor TfdBGR8.Create;
3440 begin
3441   inherited Create;
3442   fFormat           := tfBGR8;
3443   fWithAlpha        := tfBGRA8;
3444   fWithoutAlpha     := tfBGR8;
3445   fRGBInverted      := tfRGB8;
3446   fglInternalFormat := GL_RGB8;
3447 end;
3448
3449 constructor TfdBGR10.Create;
3450 begin
3451   inherited Create;
3452   fFormat           := tfBGR10;
3453   fWithAlpha        := tfBGR10A2;
3454   fWithoutAlpha     := tfBGR10;
3455   fRGBInverted      := tfRGB10;
3456   fRange.r          := $3FF;
3457   fRange.g          := $3FF;
3458   fRange.b          := $3FF;
3459   fRange.a          := $000;
3460   fShift.r          :=   20;
3461   fShift.g          :=   10;
3462   fShift.b          :=    0;
3463   fShift.a          :=    0;
3464   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3465   fglInternalFormat := GL_RGB10;
3466   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3467 end;
3468
3469 constructor TfdBGR12.Create;
3470 begin
3471   inherited Create;
3472   fFormat           := tfBGR12;
3473   fWithAlpha        := tfBGRA12;
3474   fWithoutAlpha     := tfBGR12;
3475   fRGBInverted      := tfRGB12;
3476   fglInternalFormat := GL_RGB12;
3477 end;
3478
3479 constructor TfdBGR16.Create;
3480 begin
3481   inherited Create;
3482   fFormat           := tfBGR16;
3483   fWithAlpha        := tfBGRA16;
3484   fWithoutAlpha     := tfBGR16;
3485   fRGBInverted      := tfRGB16;
3486   fglInternalFormat := GL_RGB16;
3487 end;
3488
3489 constructor TfdBGRA2.Create;
3490 begin
3491   inherited Create;
3492   fFormat           := tfBGRA2;
3493   fWithAlpha        := tfBGRA4;
3494   fWithoutAlpha     := tfBGR4;
3495   fRGBInverted      := tfRGBA2;
3496   fglInternalFormat := GL_RGBA2;
3497 end;
3498
3499 constructor TfdBGRA4.Create;
3500 begin
3501   inherited Create;
3502   fFormat           := tfBGRA4;
3503   fWithAlpha        := tfBGRA4;
3504   fWithoutAlpha     := tfBGR4;
3505   fRGBInverted      := tfRGBA4;
3506   fRange.r          := $F;
3507   fRange.g          := $F;
3508   fRange.b          := $F;
3509   fRange.a          := $F;
3510   fShift.r          :=  8;
3511   fShift.g          :=  4;
3512   fShift.b          :=  0;
3513   fShift.a          := 12;
3514   fglFormat         := GL_BGRA;
3515   fglInternalFormat := GL_RGBA4;
3516   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3517 end;
3518
3519 constructor TfdBGR5A1.Create;
3520 begin
3521   inherited Create;
3522   fFormat           := tfBGR5A1;
3523   fWithAlpha        := tfBGR5A1;
3524   fWithoutAlpha     := tfBGR5;
3525   fRGBInverted      := tfRGB5A1;
3526   fRange.r          := $1F;
3527   fRange.g          := $1F;
3528   fRange.b          := $1F;
3529   fRange.a          := $01;
3530   fShift.r          :=  10;
3531   fShift.g          :=   5;
3532   fShift.b          :=   0;
3533   fShift.a          :=  15;
3534   fglFormat         := GL_BGRA;
3535   fglInternalFormat := GL_RGB5_A1;
3536   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3537 end;
3538
3539 constructor TfdBGRA8.Create;
3540 begin
3541   inherited Create;
3542   fFormat           := tfBGRA8;
3543   fWithAlpha        := tfBGRA8;
3544   fWithoutAlpha     := tfBGR8;
3545   fRGBInverted      := tfRGBA8;
3546   fglInternalFormat := GL_RGBA8;
3547 end;
3548
3549 constructor TfdBGR10A2.Create;
3550 begin
3551   inherited Create;
3552   fFormat           := tfBGR10A2;
3553   fWithAlpha        := tfBGR10A2;
3554   fWithoutAlpha     := tfBGR10;
3555   fRGBInverted      := tfRGB10A2;
3556   fRange.r          := $3FF;
3557   fRange.g          := $3FF;
3558   fRange.b          := $3FF;
3559   fRange.a          := $003;
3560   fShift.r          :=   20;
3561   fShift.g          :=   10;
3562   fShift.b          :=    0;
3563   fShift.a          :=   30;
3564   fglFormat         := GL_BGRA;
3565   fglInternalFormat := GL_RGB10_A2;
3566   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3567 end;
3568
3569 constructor TfdBGRA12.Create;
3570 begin
3571   inherited Create;
3572   fFormat           := tfBGRA12;
3573   fWithAlpha        := tfBGRA12;
3574   fWithoutAlpha     := tfBGR12;
3575   fRGBInverted      := tfRGBA12;
3576   fglInternalFormat := GL_RGBA12;
3577 end;
3578
3579 constructor TfdBGRA16.Create;
3580 begin
3581   inherited Create;
3582   fFormat           := tfBGRA16;
3583   fWithAlpha        := tfBGRA16;
3584   fWithoutAlpha     := tfBGR16;
3585   fRGBInverted      := tfRGBA16;
3586   fglInternalFormat := GL_RGBA16;
3587 end;
3588
3589 constructor TfdDepth16.Create;
3590 begin
3591   inherited Create;
3592   fFormat           := tfDepth16;
3593   fWithAlpha        := tfEmpty;
3594   fWithoutAlpha     := tfDepth16;
3595   fglInternalFormat := GL_DEPTH_COMPONENT16;
3596 end;
3597
3598 constructor TfdDepth24.Create;
3599 begin
3600   inherited Create;
3601   fFormat           := tfDepth24;
3602   fWithAlpha        := tfEmpty;
3603   fWithoutAlpha     := tfDepth24;
3604   fglInternalFormat := GL_DEPTH_COMPONENT24;
3605 end;
3606
3607 constructor TfdDepth32.Create;
3608 begin
3609   inherited Create;
3610   fFormat           := tfDepth32;
3611   fWithAlpha        := tfEmpty;
3612   fWithoutAlpha     := tfDepth32;
3613   fglInternalFormat := GL_DEPTH_COMPONENT32;
3614 end;
3615
3616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3617 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3619 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3620 begin
3621   raise EglBitmap.Create('mapping for compressed formats is not supported');
3622 end;
3623
3624 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3625 begin
3626   raise EglBitmap.Create('mapping for compressed formats is not supported');
3627 end;
3628
3629 constructor TfdS3tcDtx1RGBA.Create;
3630 begin
3631   inherited Create;
3632   fFormat           := tfS3tcDtx1RGBA;
3633   fWithAlpha        := tfS3tcDtx1RGBA;
3634   fUncompressed     := tfRGB5A1;
3635   fPixelSize        := 0.5;
3636   fIsCompressed     := true;
3637   fglFormat         := GL_COMPRESSED_RGBA;
3638   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3639   fglDataFormat     := GL_UNSIGNED_BYTE;
3640 end;
3641
3642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3643 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3646 begin
3647   raise EglBitmap.Create('mapping for compressed formats is not supported');
3648 end;
3649
3650 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3651 begin
3652   raise EglBitmap.Create('mapping for compressed formats is not supported');
3653 end;
3654
3655 constructor TfdS3tcDtx3RGBA.Create;
3656 begin
3657   inherited Create;
3658   fFormat           := tfS3tcDtx3RGBA;
3659   fWithAlpha        := tfS3tcDtx3RGBA;
3660   fUncompressed     := tfRGBA8;
3661   fPixelSize        := 1.0;
3662   fIsCompressed     := true;
3663   fglFormat         := GL_COMPRESSED_RGBA;
3664   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3665   fglDataFormat     := GL_UNSIGNED_BYTE;
3666 end;
3667
3668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3669 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3672 begin
3673   raise EglBitmap.Create('mapping for compressed formats is not supported');
3674 end;
3675
3676 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3677 begin
3678   raise EglBitmap.Create('mapping for compressed formats is not supported');
3679 end;
3680
3681 constructor TfdS3tcDtx5RGBA.Create;
3682 begin
3683   inherited Create;
3684   fFormat           := tfS3tcDtx3RGBA;
3685   fWithAlpha        := tfS3tcDtx3RGBA;
3686   fUncompressed     := tfRGBA8;
3687   fPixelSize        := 1.0;
3688   fIsCompressed     := true;
3689   fglFormat         := GL_COMPRESSED_RGBA;
3690   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3691   fglDataFormat     := GL_UNSIGNED_BYTE;
3692 end;
3693
3694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3695 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 class procedure TFormatDescriptor.Init;
3698 begin
3699   if not Assigned(FormatDescriptorCS) then
3700     FormatDescriptorCS := TCriticalSection.Create;
3701 end;
3702
3703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3704 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3705 begin
3706   FormatDescriptorCS.Enter;
3707   try
3708     result := FormatDescriptors[aFormat];
3709     if not Assigned(result) then begin
3710       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3711       FormatDescriptors[aFormat] := result;
3712     end;
3713   finally
3714     FormatDescriptorCS.Leave;
3715   end;
3716 end;
3717
3718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3719 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3720 begin
3721   result := Get(Get(aFormat).WithAlpha);
3722 end;
3723
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 class procedure TFormatDescriptor.Clear;
3726 var
3727   f: TglBitmapFormat;
3728 begin
3729   FormatDescriptorCS.Enter;
3730   try
3731     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3732       FreeAndNil(FormatDescriptors[f]);
3733   finally
3734     FormatDescriptorCS.Leave;
3735   end;
3736 end;
3737
3738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3739 class procedure TFormatDescriptor.Finalize;
3740 begin
3741   Clear;
3742   FreeAndNil(FormatDescriptorCS);
3743 end;
3744
3745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3746 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3749 begin
3750   Update(aValue, fRange.r, fShift.r);
3751 end;
3752
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3755 begin
3756   Update(aValue, fRange.g, fShift.g);
3757 end;
3758
3759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3760 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3761 begin
3762   Update(aValue, fRange.b, fShift.b);
3763 end;
3764
3765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3766 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3767 begin
3768   Update(aValue, fRange.a, fShift.a);
3769 end;
3770
3771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3772 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3773   aShift: Byte);
3774 begin
3775   aShift := 0;
3776   aRange := 0;
3777   if (aMask = 0) then
3778     exit;
3779   while (aMask > 0) and ((aMask and 1) = 0) do begin
3780     inc(aShift);
3781     aMask := aMask shr 1;
3782   end;
3783   aRange := 1;
3784   while (aMask > 0) do begin
3785     aRange := aRange shl 1;
3786     aMask  := aMask  shr 1;
3787   end;
3788   dec(aRange);
3789
3790   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3791 end;
3792
3793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3794 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3795 var
3796   data: QWord;
3797   s: Integer;
3798 begin
3799   data :=
3800     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3801     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3802     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3803     ((aPixel.Data.a and fRange.a) shl fShift.a);
3804   s := Round(fPixelSize);
3805   case s of
3806     1:           aData^  := data;
3807     2:     PWord(aData)^ := data;
3808     4: PCardinal(aData)^ := data;
3809     8:    PQWord(aData)^ := data;
3810   else
3811     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3812   end;
3813   inc(aData, s);
3814 end;
3815
3816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3818 var
3819   data: QWord;
3820   s, i: Integer;
3821 begin
3822   s := Round(fPixelSize);
3823   case s of
3824     1: data :=           aData^;
3825     2: data :=     PWord(aData)^;
3826     4: data := PCardinal(aData)^;
3827     8: data :=    PQWord(aData)^;
3828   else
3829     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3830   end;
3831   for i := 0 to 3 do
3832     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3833   inc(aData, s);
3834 end;
3835
3836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3837 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 procedure TbmpColorTableFormat.CreateColorTable;
3840 var
3841   i: Integer;
3842 begin
3843   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3844     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3845
3846   if (Format = tfLuminance4) then
3847     SetLength(fColorTable, 16)
3848   else
3849     SetLength(fColorTable, 256);
3850
3851   case Format of
3852     tfLuminance4: begin
3853       for i := 0 to High(fColorTable) do begin
3854         fColorTable[i].r := 16 * i;
3855         fColorTable[i].g := 16 * i;
3856         fColorTable[i].b := 16 * i;
3857         fColorTable[i].a := 0;
3858       end;
3859     end;
3860
3861     tfLuminance8: begin
3862       for i := 0 to High(fColorTable) do begin
3863         fColorTable[i].r := i;
3864         fColorTable[i].g := i;
3865         fColorTable[i].b := i;
3866         fColorTable[i].a := 0;
3867       end;
3868     end;
3869
3870     tfR3G3B2: begin
3871       for i := 0 to High(fColorTable) do begin
3872         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3873         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3874         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3875         fColorTable[i].a := 0;
3876       end;
3877     end;
3878   end;
3879 end;
3880
3881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3883 var
3884   d: Byte;
3885 begin
3886   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3887     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3888
3889   case Format of
3890     tfLuminance4: begin
3891       if (aMapData = nil) then
3892         aData^ := 0;
3893       d := LuminanceWeight(aPixel) and Range.r;
3894       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3895       inc(PByte(aMapData), 4);
3896       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3897         inc(aData);
3898         aMapData := nil;
3899       end;
3900     end;
3901
3902     tfLuminance8: begin
3903       aData^ := LuminanceWeight(aPixel) and Range.r;
3904       inc(aData);
3905     end;
3906
3907     tfR3G3B2: begin
3908       aData^ := Round(
3909         ((aPixel.Data.r and Range.r) shl Shift.r) or
3910         ((aPixel.Data.g and Range.g) shl Shift.g) or
3911         ((aPixel.Data.b and Range.b) shl Shift.b));
3912       inc(aData);
3913     end;
3914   end;
3915 end;
3916
3917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3918 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3919 var
3920   idx: QWord;
3921   s: Integer;
3922   bits: Byte;
3923   f: Single;
3924 begin
3925   s    := Trunc(fPixelSize);
3926   f    := fPixelSize - s;
3927   bits := Round(8 * f);
3928   case s of
3929     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3930     1: idx :=           aData^;
3931     2: idx :=     PWord(aData)^;
3932     4: idx := PCardinal(aData)^;
3933     8: idx :=    PQWord(aData)^;
3934   else
3935     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3936   end;
3937   if (idx >= Length(fColorTable)) then
3938     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3939   with fColorTable[idx] do begin
3940     aPixel.Data.r := r;
3941     aPixel.Data.g := g;
3942     aPixel.Data.b := b;
3943     aPixel.Data.a := a;
3944   end;
3945   inc(PByte(aMapData), bits);
3946   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3947     inc(aData, 1);
3948     dec(PByte(aMapData), 8);
3949   end;
3950   inc(aData, s);
3951 end;
3952
3953 destructor TbmpColorTableFormat.Destroy;
3954 begin
3955   SetLength(fColorTable, 0);
3956   inherited Destroy;
3957 end;
3958
3959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3960 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3962 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3963 var
3964   i: Integer;
3965 begin
3966   for i := 0 to 3 do begin
3967     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3968       if (aSourceFD.Range.arr[i] > 0) then
3969         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3970       else
3971         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3972     end;
3973   end;
3974 end;
3975
3976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3977 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3978 begin
3979   with aFuncRec do begin
3980     if (Source.Range.r   > 0) then
3981       Dest.Data.r := Source.Data.r;
3982     if (Source.Range.g > 0) then
3983       Dest.Data.g := Source.Data.g;
3984     if (Source.Range.b  > 0) then
3985       Dest.Data.b := Source.Data.b;
3986     if (Source.Range.a > 0) then
3987       Dest.Data.a := Source.Data.a;
3988   end;
3989 end;
3990
3991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3992 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3993 var
3994   i: Integer;
3995 begin
3996   with aFuncRec do begin
3997     for i := 0 to 3 do
3998       if (Source.Range.arr[i] > 0) then
3999         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4000   end;
4001 end;
4002
4003 type
4004   TShiftData = packed record
4005     case Integer of
4006       0: (r, g, b, a: SmallInt);
4007       1: (arr: array[0..3] of SmallInt);
4008   end;
4009   PShiftData = ^TShiftData;
4010
4011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4012 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4013 var
4014   i: Integer;
4015 begin
4016   with aFuncRec do
4017     for i := 0 to 3 do
4018       if (Source.Range.arr[i] > 0) then
4019         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4020 end;
4021
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4024 begin
4025   with aFuncRec do begin
4026     Dest.Data := Source.Data;
4027     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4028       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4029       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4030       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4031     end;
4032     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4033       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4034     end;
4035   end;
4036 end;
4037
4038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4039 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4040 var
4041   i: Integer;
4042 begin
4043   with aFuncRec do begin
4044     for i := 0 to 3 do
4045       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4046   end;
4047 end;
4048
4049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4050 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4051 var
4052   Temp: Single;
4053 begin
4054   with FuncRec do begin
4055     if (FuncRec.Args = nil) then begin //source has no alpha
4056       Temp :=
4057         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4058         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4059         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4060       Dest.Data.a := Round(Dest.Range.a * Temp);
4061     end else
4062       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4063   end;
4064 end;
4065
4066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4067 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4068 type
4069   PglBitmapPixelData = ^TglBitmapPixelData;
4070 begin
4071   with FuncRec do begin
4072     Dest.Data.r := Source.Data.r;
4073     Dest.Data.g := Source.Data.g;
4074     Dest.Data.b := Source.Data.b;
4075
4076     with PglBitmapPixelData(Args)^ do
4077       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4078           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4079           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4080         Dest.Data.a := 0
4081       else
4082         Dest.Data.a := Dest.Range.a;
4083   end;
4084 end;
4085
4086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4087 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4088 begin
4089   with FuncRec do begin
4090     Dest.Data.r := Source.Data.r;
4091     Dest.Data.g := Source.Data.g;
4092     Dest.Data.b := Source.Data.b;
4093     Dest.Data.a := PCardinal(Args)^;
4094   end;
4095 end;
4096
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4099 type
4100   PRGBPix = ^TRGBPix;
4101   TRGBPix = array [0..2] of byte;
4102 var
4103   Temp: Byte;
4104 begin
4105   while aWidth > 0 do begin
4106     Temp := PRGBPix(aData)^[0];
4107     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4108     PRGBPix(aData)^[2] := Temp;
4109
4110     if aHasAlpha then
4111       Inc(aData, 4)
4112     else
4113       Inc(aData, 3);
4114     dec(aWidth);
4115   end;
4116 end;
4117
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4121 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4122 begin
4123   result := TFormatDescriptor.Get(Format);
4124 end;
4125
4126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4127 function TglBitmap.GetWidth: Integer;
4128 begin
4129   if (ffX in fDimension.Fields) then
4130     result := fDimension.X
4131   else
4132     result := -1;
4133 end;
4134
4135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4136 function TglBitmap.GetHeight: Integer;
4137 begin
4138   if (ffY in fDimension.Fields) then
4139     result := fDimension.Y
4140   else
4141     result := -1;
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 function TglBitmap.GetFileWidth: Integer;
4146 begin
4147   result := Max(1, Width);
4148 end;
4149
4150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4151 function TglBitmap.GetFileHeight: Integer;
4152 begin
4153   result := Max(1, Height);
4154 end;
4155
4156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4157 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4158 begin
4159   if fCustomData = aValue then
4160     exit;
4161   fCustomData := aValue;
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 procedure TglBitmap.SetCustomName(const aValue: String);
4166 begin
4167   if fCustomName = aValue then
4168     exit;
4169   fCustomName := aValue;
4170 end;
4171
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4174 begin
4175   if fCustomNameW = aValue then
4176     exit;
4177   fCustomNameW := aValue;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4182 begin
4183   if fDeleteTextureOnFree = aValue then
4184     exit;
4185   fDeleteTextureOnFree := aValue;
4186 end;
4187
4188 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4189 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4190 begin
4191   if fFormat = aValue then
4192     exit;
4193   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4194     raise EglBitmapUnsupportedFormat.Create(Format);
4195   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4196 end;
4197
4198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4199 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4200 begin
4201   if fFreeDataAfterGenTexture = aValue then
4202     exit;
4203   fFreeDataAfterGenTexture := aValue;
4204 end;
4205
4206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4207 procedure TglBitmap.SetID(const aValue: Cardinal);
4208 begin
4209   if fID = aValue then
4210     exit;
4211   fID := aValue;
4212 end;
4213
4214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4215 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4216 begin
4217   if fMipMap = aValue then
4218     exit;
4219   fMipMap := aValue;
4220 end;
4221
4222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4223 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4224 begin
4225   if fTarget = aValue then
4226     exit;
4227   fTarget := aValue;
4228 end;
4229
4230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4231 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4232 var
4233   MaxAnisotropic: Integer;
4234 begin
4235   fAnisotropic := aValue;
4236   if (ID > 0) then begin
4237     if GL_EXT_texture_filter_anisotropic then begin
4238       if fAnisotropic > 0 then begin
4239         Bind(false);
4240         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4241         if aValue > MaxAnisotropic then
4242           fAnisotropic := MaxAnisotropic;
4243         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4244       end;
4245     end else begin
4246       fAnisotropic := 0;
4247     end;
4248   end;
4249 end;
4250
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.CreateID;
4253 begin
4254   if (ID <> 0) then
4255     glDeleteTextures(1, @fID);
4256   glGenTextures(1, @fID);
4257   Bind(false);
4258 end;
4259
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4262 begin
4263   // Set Up Parameters
4264   SetWrap(fWrapS, fWrapT, fWrapR);
4265   SetFilter(fFilterMin, fFilterMag);
4266   SetAnisotropic(fAnisotropic);
4267   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4268
4269   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4270     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4271
4272   // Mip Maps Generation Mode
4273   aBuildWithGlu := false;
4274   if (MipMap = mmMipmap) then begin
4275     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4276       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4277     else
4278       aBuildWithGlu := true;
4279   end else if (MipMap = mmMipmapGlu) then
4280     aBuildWithGlu := true;
4281 end;
4282
4283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4284 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4285   const aWidth: Integer; const aHeight: Integer);
4286 var
4287   s: Single;
4288 begin
4289   if (Data <> aData) then begin
4290     if (Assigned(Data)) then
4291       FreeMem(Data);
4292     fData := aData;
4293   end;
4294
4295   FillChar(fDimension, SizeOf(fDimension), 0);
4296   if not Assigned(fData) then begin
4297     fFormat    := tfEmpty;
4298     fPixelSize := 0;
4299     fRowSize   := 0;
4300   end else begin
4301     if aWidth <> -1 then begin
4302       fDimension.Fields := fDimension.Fields + [ffX];
4303       fDimension.X := aWidth;
4304     end;
4305
4306     if aHeight <> -1 then begin
4307       fDimension.Fields := fDimension.Fields + [ffY];
4308       fDimension.Y := aHeight;
4309     end;
4310
4311     s := TFormatDescriptor.Get(aFormat).PixelSize;
4312     fFormat    := aFormat;
4313     fPixelSize := Ceil(s);
4314     fRowSize   := Ceil(s * aWidth);
4315   end;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 function TglBitmap.FlipHorz: Boolean;
4320 begin
4321   result := false;
4322 end;
4323
4324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4325 function TglBitmap.FlipVert: Boolean;
4326 begin
4327   result := false;
4328 end;
4329
4330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4331 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4333 procedure TglBitmap.AfterConstruction;
4334 begin
4335   inherited AfterConstruction;
4336
4337   fID         := 0;
4338   fTarget     := 0;
4339   fIsResident := false;
4340
4341   fFormat                  := glBitmapGetDefaultFormat;
4342   fMipMap                  := glBitmapDefaultMipmap;
4343   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4344   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4345
4346   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4347   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4348   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4349 end;
4350
4351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4352 procedure TglBitmap.BeforeDestruction;
4353 var
4354   NewData: PByte;
4355 begin
4356   NewData := nil;
4357   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4358   if (fID > 0) and fDeleteTextureOnFree then
4359     glDeleteTextures(1, @fID);
4360   inherited BeforeDestruction;
4361 end;
4362
4363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4364 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4365 var
4366   TempPos: Integer;
4367 begin
4368   if not Assigned(aResType) then begin
4369     TempPos   := Pos('.', aResource);
4370     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4371     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4372   end;
4373 end;
4374
4375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4376 procedure TglBitmap.LoadFromFile(const aFilename: String);
4377 var
4378   fs: TFileStream;
4379 begin
4380   if not FileExists(aFilename) then
4381     raise EglBitmap.Create('file does not exist: ' + aFilename);
4382   fFilename := aFilename;
4383   fs := TFileStream.Create(fFilename, fmOpenRead);
4384   try
4385     fs.Position := 0;
4386     LoadFromStream(fs);
4387   finally
4388     fs.Free;
4389   end;
4390 end;
4391
4392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4393 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4394 begin
4395   {$IFDEF GLB_SUPPORT_PNG_READ}
4396   if not LoadPNG(aStream) then
4397   {$ENDIF}
4398   {$IFDEF GLB_SUPPORT_JPEG_READ}
4399   if not LoadJPEG(aStream) then
4400   {$ENDIF}
4401   if not LoadDDS(aStream) then
4402   if not LoadTGA(aStream) then
4403   if not LoadBMP(aStream) then
4404     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4405 end;
4406
4407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4408 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4409   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4410 var
4411   tmpData: PByte;
4412   size: Integer;
4413 begin
4414   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4415   GetMem(tmpData, size);
4416   try
4417     FillChar(tmpData^, size, #$FF);
4418     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4419   except
4420     if Assigned(tmpData) then
4421       FreeMem(tmpData);
4422     raise;
4423   end;
4424   AddFunc(Self, aFunc, false, Format, aArgs);
4425 end;
4426
4427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4428 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4429 var
4430   rs: TResourceStream;
4431 begin
4432   PrepareResType(aResource, aResType);
4433   rs := TResourceStream.Create(aInstance, aResource, aResType);
4434   try
4435     LoadFromStream(rs);
4436   finally
4437     rs.Free;
4438   end;
4439 end;
4440
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4443 var
4444   rs: TResourceStream;
4445 begin
4446   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4447   try
4448     LoadFromStream(rs);
4449   finally
4450     rs.Free;
4451   end;
4452 end;
4453
4454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4455 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4456 var
4457   fs: TFileStream;
4458 begin
4459   fs := TFileStream.Create(aFileName, fmCreate);
4460   try
4461     fs.Position := 0;
4462     SaveToStream(fs, aFileType);
4463   finally
4464     fs.Free;
4465   end;
4466 end;
4467
4468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4469 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4470 begin
4471   case aFileType of
4472     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4473     ftPNG:  SavePNG(aStream);
4474     {$ENDIF}
4475     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4476     ftJPEG: SaveJPEG(aStream);
4477     {$ENDIF}
4478     ftDDS:  SaveDDS(aStream);
4479     ftTGA:  SaveTGA(aStream);
4480     ftBMP:  SaveBMP(aStream);
4481   end;
4482 end;
4483
4484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4485 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4486 begin
4487   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4488 end;
4489
4490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4491 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4492   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4493 var
4494   DestData, TmpData, SourceData: pByte;
4495   TempHeight, TempWidth: Integer;
4496   SourceFD, DestFD: TFormatDescriptor;
4497   SourceMD, DestMD: Pointer;
4498
4499   FuncRec: TglBitmapFunctionRec;
4500 begin
4501   Assert(Assigned(Data));
4502   Assert(Assigned(aSource));
4503   Assert(Assigned(aSource.Data));
4504
4505   result := false;
4506   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4507     SourceFD := TFormatDescriptor.Get(aSource.Format);
4508     DestFD   := TFormatDescriptor.Get(aFormat);
4509
4510     if (SourceFD.IsCompressed) then
4511       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4512     if (DestFD.IsCompressed) then
4513       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4514
4515     // inkompatible Formats so CreateTemp
4516     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4517       aCreateTemp := true;
4518
4519     // Values
4520     TempHeight := Max(1, aSource.Height);
4521     TempWidth  := Max(1, aSource.Width);
4522
4523     FuncRec.Sender := Self;
4524     FuncRec.Args   := aArgs;
4525
4526     TmpData := nil;
4527     if aCreateTemp then begin
4528       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4529       DestData := TmpData;
4530     end else
4531       DestData := Data;
4532
4533     try
4534       SourceFD.PreparePixel(FuncRec.Source);
4535       DestFD.PreparePixel  (FuncRec.Dest);
4536
4537       SourceMD := SourceFD.CreateMappingData;
4538       DestMD   := DestFD.CreateMappingData;
4539
4540       FuncRec.Size            := aSource.Dimension;
4541       FuncRec.Position.Fields := FuncRec.Size.Fields;
4542
4543       try
4544         SourceData := aSource.Data;
4545         FuncRec.Position.Y := 0;
4546         while FuncRec.Position.Y < TempHeight do begin
4547           FuncRec.Position.X := 0;
4548           while FuncRec.Position.X < TempWidth do begin
4549             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4550             aFunc(FuncRec);
4551             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4552             inc(FuncRec.Position.X);
4553           end;
4554           inc(FuncRec.Position.Y);
4555         end;
4556
4557         // Updating Image or InternalFormat
4558         if aCreateTemp then
4559           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4560         else if (aFormat <> fFormat) then
4561           Format := aFormat;
4562
4563         result := true;
4564       finally
4565         SourceFD.FreeMappingData(SourceMD);
4566         DestFD.FreeMappingData(DestMD);
4567       end;
4568     except
4569       if aCreateTemp and Assigned(TmpData) then
4570         FreeMem(TmpData);
4571       raise;
4572     end;
4573   end;
4574 end;
4575
4576 {$IFDEF GLB_SDL}
4577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4578 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4579 var
4580   Row, RowSize: Integer;
4581   SourceData, TmpData: PByte;
4582   TempDepth: Integer;
4583   FormatDesc: TFormatDescriptor;
4584
4585   function GetRowPointer(Row: Integer): pByte;
4586   begin
4587     result := aSurface.pixels;
4588     Inc(result, Row * RowSize);
4589   end;
4590
4591 begin
4592   result := false;
4593
4594   FormatDesc := TFormatDescriptor.Get(Format);
4595   if FormatDesc.IsCompressed then
4596     raise EglBitmapUnsupportedFormat.Create(Format);
4597
4598   if Assigned(Data) then begin
4599     case Trunc(FormatDesc.PixelSize) of
4600       1: TempDepth :=  8;
4601       2: TempDepth := 16;
4602       3: TempDepth := 24;
4603       4: TempDepth := 32;
4604     else
4605       raise EglBitmapUnsupportedFormat.Create(Format);
4606     end;
4607
4608     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4609       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4610     SourceData := Data;
4611     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4612
4613     for Row := 0 to FileHeight-1 do begin
4614       TmpData := GetRowPointer(Row);
4615       if Assigned(TmpData) then begin
4616         Move(SourceData^, TmpData^, RowSize);
4617         inc(SourceData, RowSize);
4618       end;
4619     end;
4620     result := true;
4621   end;
4622 end;
4623
4624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4625 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4626 var
4627   pSource, pData, pTempData: PByte;
4628   Row, RowSize, TempWidth, TempHeight: Integer;
4629   IntFormat: TglBitmapFormat;
4630   FormatDesc: TFormatDescriptor;
4631
4632   function GetRowPointer(Row: Integer): pByte;
4633   begin
4634     result := aSurface^.pixels;
4635     Inc(result, Row * RowSize);
4636   end;
4637
4638 begin
4639   result := false;
4640   if (Assigned(aSurface)) then begin
4641     with aSurface^.format^ do begin
4642       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4643         FormatDesc := TFormatDescriptor.Get(IntFormat);
4644         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4645           break;
4646       end;
4647       if (IntFormat = tfEmpty) then
4648         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4649     end;
4650
4651     TempWidth  := aSurface^.w;
4652     TempHeight := aSurface^.h;
4653     RowSize := FormatDesc.GetSize(TempWidth, 1);
4654     GetMem(pData, TempHeight * RowSize);
4655     try
4656       pTempData := pData;
4657       for Row := 0 to TempHeight -1 do begin
4658         pSource := GetRowPointer(Row);
4659         if (Assigned(pSource)) then begin
4660           Move(pSource^, pTempData^, RowSize);
4661           Inc(pTempData, RowSize);
4662         end;
4663       end;
4664       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4665       result := true;
4666     except
4667       if Assigned(pData) then
4668         FreeMem(pData);
4669       raise;
4670     end;
4671   end;
4672 end;
4673
4674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4675 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4676 var
4677   Row, Col, AlphaInterleave: Integer;
4678   pSource, pDest: PByte;
4679
4680   function GetRowPointer(Row: Integer): pByte;
4681   begin
4682     result := aSurface.pixels;
4683     Inc(result, Row * Width);
4684   end;
4685
4686 begin
4687   result := false;
4688   if Assigned(Data) then begin
4689     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4690       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4691
4692       AlphaInterleave := 0;
4693       case Format of
4694         tfLuminance8Alpha8:
4695           AlphaInterleave := 1;
4696         tfBGRA8, tfRGBA8:
4697           AlphaInterleave := 3;
4698       end;
4699
4700       pSource := Data;
4701       for Row := 0 to Height -1 do begin
4702         pDest := GetRowPointer(Row);
4703         if Assigned(pDest) then begin
4704           for Col := 0 to Width -1 do begin
4705             Inc(pSource, AlphaInterleave);
4706             pDest^ := pSource^;
4707             Inc(pDest);
4708             Inc(pSource);
4709           end;
4710         end;
4711       end;
4712       result := true;
4713     end;
4714   end;
4715 end;
4716
4717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4718 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4719 var
4720   bmp: TglBitmap2D;
4721 begin
4722   bmp := TglBitmap2D.Create;
4723   try
4724     bmp.AssignFromSurface(aSurface);
4725     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4726   finally
4727     bmp.Free;
4728   end;
4729 end;
4730 {$ENDIF}
4731
4732 {$IFDEF GLB_DELPHI}
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 function CreateGrayPalette: HPALETTE;
4735 var
4736   Idx: Integer;
4737   Pal: PLogPalette;
4738 begin
4739   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4740
4741   Pal.palVersion := $300;
4742   Pal.palNumEntries := 256;
4743
4744   for Idx := 0 to Pal.palNumEntries - 1 do begin
4745     Pal.palPalEntry[Idx].peRed   := Idx;
4746     Pal.palPalEntry[Idx].peGreen := Idx;
4747     Pal.palPalEntry[Idx].peBlue  := Idx;
4748     Pal.palPalEntry[Idx].peFlags := 0;
4749   end;
4750   Result := CreatePalette(Pal^);
4751   FreeMem(Pal);
4752 end;
4753
4754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4755 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4756 var
4757   Row: Integer;
4758   pSource, pData: PByte;
4759 begin
4760   result := false;
4761   if Assigned(Data) then begin
4762     if Assigned(aBitmap) then begin
4763       aBitmap.Width  := Width;
4764       aBitmap.Height := Height;
4765
4766       case Format of
4767         tfAlpha8, tfLuminance8: begin
4768           aBitmap.PixelFormat := pf8bit;
4769           aBitmap.Palette     := CreateGrayPalette;
4770         end;
4771         tfRGB5A1:
4772           aBitmap.PixelFormat := pf15bit;
4773         tfR5G6B5:
4774           aBitmap.PixelFormat := pf16bit;
4775         tfRGB8, tfBGR8:
4776           aBitmap.PixelFormat := pf24bit;
4777         tfRGBA8, tfBGRA8:
4778           aBitmap.PixelFormat := pf32bit;
4779       else
4780         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4781       end;
4782
4783       pSource := Data;
4784       for Row := 0 to FileHeight -1 do begin
4785         pData := aBitmap.Scanline[Row];
4786         Move(pSource^, pData^, fRowSize);
4787         Inc(pSource, fRowSize);
4788         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4789           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4790       end;
4791       result := true;
4792     end;
4793   end;
4794 end;
4795
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4798 var
4799   pSource, pData, pTempData: PByte;
4800   Row, RowSize, TempWidth, TempHeight: Integer;
4801   IntFormat: TglBitmapFormat;
4802 begin
4803   result := false;
4804
4805   if (Assigned(aBitmap)) then begin
4806     case aBitmap.PixelFormat of
4807       pf8bit:
4808         IntFormat := tfLuminance8;
4809       pf15bit:
4810         IntFormat := tfRGB5A1;
4811       pf16bit:
4812         IntFormat := tfR5G6B5;
4813       pf24bit:
4814         IntFormat := tfBGR8;
4815       pf32bit:
4816         IntFormat := tfBGRA8;
4817     else
4818       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4819     end;
4820
4821     TempWidth  := aBitmap.Width;
4822     TempHeight := aBitmap.Height;
4823     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4824     GetMem(pData, TempHeight * RowSize);
4825     try
4826       pTempData := pData;
4827       for Row := 0 to TempHeight -1 do begin
4828         pSource := aBitmap.Scanline[Row];
4829         if (Assigned(pSource)) then begin
4830           Move(pSource^, pTempData^, RowSize);
4831           Inc(pTempData, RowSize);
4832         end;
4833       end;
4834       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4835       result := true;
4836     except
4837       if Assigned(pData) then
4838         FreeMem(pData);
4839       raise;
4840     end;
4841   end;
4842 end;
4843
4844 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4845 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4846 var
4847   Row, Col, AlphaInterleave: Integer;
4848   pSource, pDest: PByte;
4849 begin
4850   result := false;
4851
4852   if Assigned(Data) then begin
4853     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4854       if Assigned(aBitmap) then begin
4855         aBitmap.PixelFormat := pf8bit;
4856         aBitmap.Palette     := CreateGrayPalette;
4857         aBitmap.Width       := Width;
4858         aBitmap.Height      := Height;
4859
4860         case Format of
4861           tfLuminance8Alpha8:
4862             AlphaInterleave := 1;
4863           tfRGBA8, tfBGRA8:
4864             AlphaInterleave := 3;
4865           else
4866             AlphaInterleave := 0;
4867         end;
4868
4869         // Copy Data
4870         pSource := Data;
4871
4872         for Row := 0 to Height -1 do begin
4873           pDest := aBitmap.Scanline[Row];
4874           if Assigned(pDest) then begin
4875             for Col := 0 to Width -1 do begin
4876               Inc(pSource, AlphaInterleave);
4877               pDest^ := pSource^;
4878               Inc(pDest);
4879               Inc(pSource);
4880             end;
4881           end;
4882         end;
4883         result := true;
4884       end;
4885     end;
4886   end;
4887 end;
4888
4889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4890 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4891 var
4892   tex: TglBitmap2D;
4893 begin
4894   tex := TglBitmap2D.Create;
4895   try
4896     tex.AssignFromBitmap(ABitmap);
4897     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4898   finally
4899     tex.Free;
4900   end;
4901 end;
4902 {$ENDIF}
4903
4904 {$IFDEF GLB_LAZARUS}
4905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4906 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4907 var
4908   rid: TRawImageDescription;
4909   FormatDesc: TFormatDescriptor;
4910 begin
4911   result := false;
4912   if not Assigned(aImage) or (Format = tfEmpty) then
4913     exit;
4914   FormatDesc := TFormatDescriptor.Get(Format);
4915   if FormatDesc.IsCompressed then
4916     exit;
4917
4918   FillChar(rid{%H-}, SizeOf(rid), 0);
4919   if (Format in [
4920        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4921        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4922        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4923     rid.Format := ricfGray
4924   else
4925     rid.Format := ricfRGBA;
4926
4927   rid.Width        := Width;
4928   rid.Height       := Height;
4929   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4930   rid.BitOrder     := riboBitsInOrder;
4931   rid.ByteOrder    := riboLSBFirst;
4932   rid.LineOrder    := riloTopToBottom;
4933   rid.LineEnd      := rileTight;
4934   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4935   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4936   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4937   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4938   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4939   rid.RedShift     := FormatDesc.Shift.r;
4940   rid.GreenShift   := FormatDesc.Shift.g;
4941   rid.BlueShift    := FormatDesc.Shift.b;
4942   rid.AlphaShift   := FormatDesc.Shift.a;
4943
4944   rid.MaskBitsPerPixel  := 0;
4945   rid.PaletteColorCount := 0;
4946
4947   aImage.DataDescription := rid;
4948   aImage.CreateData;
4949
4950   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4951
4952   result := true;
4953 end;
4954
4955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4956 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4957 var
4958   f: TglBitmapFormat;
4959   FormatDesc: TFormatDescriptor;
4960   ImageData: PByte;
4961   ImageSize: Integer;
4962 begin
4963   result := false;
4964   if not Assigned(aImage) then
4965     exit;
4966   for f := High(f) downto Low(f) do begin
4967     FormatDesc := TFormatDescriptor.Get(f);
4968     with aImage.DataDescription do
4969       if FormatDesc.MaskMatch(
4970         (QWord(1 shl RedPrec  )-1) shl RedShift,
4971         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4972         (QWord(1 shl BluePrec )-1) shl BlueShift,
4973         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4974         break;
4975   end;
4976
4977   if (f = tfEmpty) then
4978     exit;
4979
4980   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4981   ImageData := GetMem(ImageSize);
4982   try
4983     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4984     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4985   except
4986     if Assigned(ImageData) then
4987       FreeMem(ImageData);
4988     raise;
4989   end;
4990
4991   result := true;
4992 end;
4993
4994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4995 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4996 var
4997   rid: TRawImageDescription;
4998   FormatDesc: TFormatDescriptor;
4999   Pixel: TglBitmapPixelData;
5000   x, y: Integer;
5001   srcMD: Pointer;
5002   src, dst: PByte;
5003 begin
5004   result := false;
5005   if not Assigned(aImage) or (Format = tfEmpty) then
5006     exit;
5007   FormatDesc := TFormatDescriptor.Get(Format);
5008   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5009     exit;
5010
5011   FillChar(rid{%H-}, SizeOf(rid), 0);
5012   rid.Format       := ricfGray;
5013   rid.Width        := Width;
5014   rid.Height       := Height;
5015   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5016   rid.BitOrder     := riboBitsInOrder;
5017   rid.ByteOrder    := riboLSBFirst;
5018   rid.LineOrder    := riloTopToBottom;
5019   rid.LineEnd      := rileTight;
5020   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5021   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5022   rid.GreenPrec    := 0;
5023   rid.BluePrec     := 0;
5024   rid.AlphaPrec    := 0;
5025   rid.RedShift     := 0;
5026   rid.GreenShift   := 0;
5027   rid.BlueShift    := 0;
5028   rid.AlphaShift   := 0;
5029
5030   rid.MaskBitsPerPixel  := 0;
5031   rid.PaletteColorCount := 0;
5032
5033   aImage.DataDescription := rid;
5034   aImage.CreateData;
5035
5036   srcMD := FormatDesc.CreateMappingData;
5037   try
5038     FormatDesc.PreparePixel(Pixel);
5039     src := Data;
5040     dst := aImage.PixelData;
5041     for y := 0 to Height-1 do
5042       for x := 0 to Width-1 do begin
5043         FormatDesc.Unmap(src, Pixel, srcMD);
5044         case rid.BitsPerPixel of
5045            8: begin
5046             dst^ := Pixel.Data.a;
5047             inc(dst);
5048           end;
5049           16: begin
5050             PWord(dst)^ := Pixel.Data.a;
5051             inc(dst, 2);
5052           end;
5053           24: begin
5054             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5055             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5056             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5057             inc(dst, 3);
5058           end;
5059           32: begin
5060             PCardinal(dst)^ := Pixel.Data.a;
5061             inc(dst, 4);
5062           end;
5063         else
5064           raise EglBitmapUnsupportedFormat.Create(Format);
5065         end;
5066       end;
5067   finally
5068     FormatDesc.FreeMappingData(srcMD);
5069   end;
5070   result := true;
5071 end;
5072
5073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5074 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5075 var
5076   tex: TglBitmap2D;
5077 begin
5078   tex := TglBitmap2D.Create;
5079   try
5080     tex.AssignFromLazIntfImage(aImage);
5081     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5082   finally
5083     tex.Free;
5084   end;
5085 end;
5086 {$ENDIF}
5087
5088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5089 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5090   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5091 var
5092   rs: TResourceStream;
5093 begin
5094   PrepareResType(aResource, aResType);
5095   rs := TResourceStream.Create(aInstance, aResource, aResType);
5096   try
5097     result := AddAlphaFromStream(rs, aFunc, aArgs);
5098   finally
5099     rs.Free;
5100   end;
5101 end;
5102
5103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5104 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5105   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5106 var
5107   rs: TResourceStream;
5108 begin
5109   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5110   try
5111     result := AddAlphaFromStream(rs, aFunc, aArgs);
5112   finally
5113     rs.Free;
5114   end;
5115 end;
5116
5117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5118 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5119 begin
5120   if TFormatDescriptor.Get(Format).IsCompressed then
5121     raise EglBitmapUnsupportedFormat.Create(Format);
5122   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5123 end;
5124
5125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5126 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5127 var
5128   FS: TFileStream;
5129 begin
5130   FS := TFileStream.Create(aFileName, fmOpenRead);
5131   try
5132     result := AddAlphaFromStream(FS, aFunc, aArgs);
5133   finally
5134     FS.Free;
5135   end;
5136 end;
5137
5138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5139 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5140 var
5141   tex: TglBitmap2D;
5142 begin
5143   tex := TglBitmap2D.Create(aStream);
5144   try
5145     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5146   finally
5147     tex.Free;
5148   end;
5149 end;
5150
5151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5152 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5153 var
5154   DestData, DestData2, SourceData: pByte;
5155   TempHeight, TempWidth: Integer;
5156   SourceFD, DestFD: TFormatDescriptor;
5157   SourceMD, DestMD, DestMD2: Pointer;
5158
5159   FuncRec: TglBitmapFunctionRec;
5160 begin
5161   result := false;
5162
5163   Assert(Assigned(Data));
5164   Assert(Assigned(aBitmap));
5165   Assert(Assigned(aBitmap.Data));
5166
5167   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5168     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5169
5170     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5171     DestFD   := TFormatDescriptor.Get(Format);
5172
5173     if not Assigned(aFunc) then begin
5174       aFunc        := glBitmapAlphaFunc;
5175       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5176     end else
5177       FuncRec.Args := aArgs;
5178
5179     // Values
5180     TempHeight := aBitmap.FileHeight;
5181     TempWidth  := aBitmap.FileWidth;
5182
5183     FuncRec.Sender          := Self;
5184     FuncRec.Size            := Dimension;
5185     FuncRec.Position.Fields := FuncRec.Size.Fields;
5186
5187     DestData   := Data;
5188     DestData2  := Data;
5189     SourceData := aBitmap.Data;
5190
5191     // Mapping
5192     SourceFD.PreparePixel(FuncRec.Source);
5193     DestFD.PreparePixel  (FuncRec.Dest);
5194
5195     SourceMD := SourceFD.CreateMappingData;
5196     DestMD   := DestFD.CreateMappingData;
5197     DestMD2  := DestFD.CreateMappingData;
5198     try
5199       FuncRec.Position.Y := 0;
5200       while FuncRec.Position.Y < TempHeight do begin
5201         FuncRec.Position.X := 0;
5202         while FuncRec.Position.X < TempWidth do begin
5203           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5204           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5205           aFunc(FuncRec);
5206           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5207           inc(FuncRec.Position.X);
5208         end;
5209         inc(FuncRec.Position.Y);
5210       end;
5211     finally
5212       SourceFD.FreeMappingData(SourceMD);
5213       DestFD.FreeMappingData(DestMD);
5214       DestFD.FreeMappingData(DestMD2);
5215     end;
5216   end;
5217 end;
5218
5219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5220 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5221 begin
5222   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5223 end;
5224
5225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5226 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5227 var
5228   PixelData: TglBitmapPixelData;
5229 begin
5230   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5231   result := AddAlphaFromColorKeyFloat(
5232     aRed   / PixelData.Range.r,
5233     aGreen / PixelData.Range.g,
5234     aBlue  / PixelData.Range.b,
5235     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5236 end;
5237
5238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5239 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5240 var
5241   values: array[0..2] of Single;
5242   tmp: Cardinal;
5243   i: Integer;
5244   PixelData: TglBitmapPixelData;
5245 begin
5246   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5247   with PixelData do begin
5248     values[0] := aRed;
5249     values[1] := aGreen;
5250     values[2] := aBlue;
5251
5252     for i := 0 to 2 do begin
5253       tmp          := Trunc(Range.arr[i] * aDeviation);
5254       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5255       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5256     end;
5257     Data.a  := 0;
5258     Range.a := 0;
5259   end;
5260   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5265 begin
5266   result := AddAlphaFromValueFloat(aAlpha / $FF);
5267 end;
5268
5269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5270 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5271 var
5272   PixelData: TglBitmapPixelData;
5273 begin
5274   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5275   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5276 end;
5277
5278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5279 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5280 var
5281   PixelData: TglBitmapPixelData;
5282 begin
5283   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5284   with PixelData do
5285     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5286   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5287 end;
5288
5289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5290 function TglBitmap.RemoveAlpha: Boolean;
5291 var
5292   FormatDesc: TFormatDescriptor;
5293 begin
5294   result := false;
5295   FormatDesc := TFormatDescriptor.Get(Format);
5296   if Assigned(Data) then begin
5297     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5298       raise EglBitmapUnsupportedFormat.Create(Format);
5299     result := ConvertTo(FormatDesc.WithoutAlpha);
5300   end;
5301 end;
5302
5303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5304 function TglBitmap.Clone: TglBitmap;
5305 var
5306   Temp: TglBitmap;
5307   TempPtr: PByte;
5308   Size: Integer;
5309 begin
5310   result := nil;
5311   Temp := (ClassType.Create as TglBitmap);
5312   try
5313     // copy texture data if assigned
5314     if Assigned(Data) then begin
5315       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5316       GetMem(TempPtr, Size);
5317       try
5318         Move(Data^, TempPtr^, Size);
5319         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5320       except
5321         if Assigned(TempPtr) then
5322           FreeMem(TempPtr);
5323         raise;
5324       end;
5325     end else begin
5326       TempPtr := nil;
5327       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5328     end;
5329
5330         // copy properties
5331     Temp.fID                      := ID;
5332     Temp.fTarget                  := Target;
5333     Temp.fFormat                  := Format;
5334     Temp.fMipMap                  := MipMap;
5335     Temp.fAnisotropic             := Anisotropic;
5336     Temp.fBorderColor             := fBorderColor;
5337     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5338     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5339     Temp.fFilterMin               := fFilterMin;
5340     Temp.fFilterMag               := fFilterMag;
5341     Temp.fWrapS                   := fWrapS;
5342     Temp.fWrapT                   := fWrapT;
5343     Temp.fWrapR                   := fWrapR;
5344     Temp.fFilename                := fFilename;
5345     Temp.fCustomName              := fCustomName;
5346     Temp.fCustomNameW             := fCustomNameW;
5347     Temp.fCustomData              := fCustomData;
5348
5349     result := Temp;
5350   except
5351     FreeAndNil(Temp);
5352     raise;
5353   end;
5354 end;
5355
5356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5357 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5358 var
5359   SourceFD, DestFD: TFormatDescriptor;
5360   SourcePD, DestPD: TglBitmapPixelData;
5361   ShiftData: TShiftData;
5362
5363   function CanCopyDirect: Boolean;
5364   begin
5365     result :=
5366       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5367       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5368       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5369       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5370   end;
5371
5372   function CanShift: Boolean;
5373   begin
5374     result :=
5375       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5376       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5377       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5378       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5379   end;
5380
5381   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5382   begin
5383     result := 0;
5384     while (aSource > aDest) and (aSource > 0) do begin
5385       inc(result);
5386       aSource := aSource shr 1;
5387     end;
5388   end;
5389
5390 begin
5391   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5392     SourceFD := TFormatDescriptor.Get(Format);
5393     DestFD   := TFormatDescriptor.Get(aFormat);
5394
5395     SourceFD.PreparePixel(SourcePD);
5396     DestFD.PreparePixel  (DestPD);
5397
5398     if CanCopyDirect then
5399       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5400     else if CanShift then begin
5401       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5402       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5403       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5404       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5405       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5406     end else
5407       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5408   end else
5409     result := true;
5410 end;
5411
5412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5413 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5414 begin
5415   if aUseRGB or aUseAlpha then
5416     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5417       ((PtrInt(aUseAlpha) and 1) shl 1) or
5418        (PtrInt(aUseRGB)   and 1)      ));
5419 end;
5420
5421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5422 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5423 begin
5424   fBorderColor[0] := aRed;
5425   fBorderColor[1] := aGreen;
5426   fBorderColor[2] := aBlue;
5427   fBorderColor[3] := aAlpha;
5428   if (ID > 0) then begin
5429     Bind(false);
5430     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5431   end;
5432 end;
5433
5434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5435 procedure TglBitmap.FreeData;
5436 var
5437   TempPtr: PByte;
5438 begin
5439   TempPtr := nil;
5440   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5441 end;
5442
5443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5444 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5445   const aAlpha: Byte);
5446 begin
5447   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5448 end;
5449
5450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5451 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5452 var
5453   PixelData: TglBitmapPixelData;
5454 begin
5455   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5456   FillWithColorFloat(
5457     aRed   / PixelData.Range.r,
5458     aGreen / PixelData.Range.g,
5459     aBlue  / PixelData.Range.b,
5460     aAlpha / PixelData.Range.a);
5461 end;
5462
5463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5464 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5465 var
5466   PixelData: TglBitmapPixelData;
5467 begin
5468   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5469   with PixelData do begin
5470     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5471     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5472     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5473     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5474   end;
5475   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5476 end;
5477
5478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5479 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5480 begin
5481   //check MIN filter
5482   case aMin of
5483     GL_NEAREST:
5484       fFilterMin := GL_NEAREST;
5485     GL_LINEAR:
5486       fFilterMin := GL_LINEAR;
5487     GL_NEAREST_MIPMAP_NEAREST:
5488       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5489     GL_LINEAR_MIPMAP_NEAREST:
5490       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5491     GL_NEAREST_MIPMAP_LINEAR:
5492       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5493     GL_LINEAR_MIPMAP_LINEAR:
5494       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5495     else
5496       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5497   end;
5498
5499   //check MAG filter
5500   case aMag of
5501     GL_NEAREST:
5502       fFilterMag := GL_NEAREST;
5503     GL_LINEAR:
5504       fFilterMag := GL_LINEAR;
5505     else
5506       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5507   end;
5508
5509   //apply filter
5510   if (ID > 0) then begin
5511     Bind(false);
5512     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5513
5514     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5515       case fFilterMin of
5516         GL_NEAREST, GL_LINEAR:
5517           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5518         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5519           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5520         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5521           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5522       end;
5523     end else
5524       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5525   end;
5526 end;
5527
5528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5529 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5530
5531   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5532   begin
5533     case aValue of
5534       GL_CLAMP:
5535         aTarget := GL_CLAMP;
5536
5537       GL_REPEAT:
5538         aTarget := GL_REPEAT;
5539
5540       GL_CLAMP_TO_EDGE: begin
5541         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5542           aTarget := GL_CLAMP_TO_EDGE
5543         else
5544           aTarget := GL_CLAMP;
5545       end;
5546
5547       GL_CLAMP_TO_BORDER: begin
5548         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5549           aTarget := GL_CLAMP_TO_BORDER
5550         else
5551           aTarget := GL_CLAMP;
5552       end;
5553
5554       GL_MIRRORED_REPEAT: begin
5555         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5556           aTarget := GL_MIRRORED_REPEAT
5557         else
5558           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5559       end;
5560     else
5561       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5562     end;
5563   end;
5564
5565 begin
5566   CheckAndSetWrap(S, fWrapS);
5567   CheckAndSetWrap(T, fWrapT);
5568   CheckAndSetWrap(R, fWrapR);
5569
5570   if (ID > 0) then begin
5571     Bind(false);
5572     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5573     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5574     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5575   end;
5576 end;
5577
5578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5579 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5580
5581   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5582   begin
5583     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5584        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5585       fSwizzle[aIndex] := aValue
5586     else
5587       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5588   end;
5589
5590 begin
5591   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5592     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5593   CheckAndSetValue(r, 0);
5594   CheckAndSetValue(g, 1);
5595   CheckAndSetValue(b, 2);
5596   CheckAndSetValue(a, 3);
5597
5598   if (ID > 0) then begin
5599     Bind(false);
5600     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5601   end;
5602 end;
5603
5604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5605 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5606 begin
5607   if aEnableTextureUnit then
5608     glEnable(Target);
5609   if (ID > 0) then
5610     glBindTexture(Target, ID);
5611 end;
5612
5613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5614 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5615 begin
5616   if aDisableTextureUnit then
5617     glDisable(Target);
5618   glBindTexture(Target, 0);
5619 end;
5620
5621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5622 constructor TglBitmap.Create;
5623 begin
5624   if (ClassType = TglBitmap) then
5625     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5626 {$IFDEF GLB_NATIVE_OGL}
5627   glbReadOpenGLExtensions;
5628 {$ENDIF}
5629   inherited Create;
5630 end;
5631
5632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5633 constructor TglBitmap.Create(const aFileName: String);
5634 begin
5635   Create;
5636   LoadFromFile(aFileName);
5637 end;
5638
5639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5640 constructor TglBitmap.Create(const aStream: TStream);
5641 begin
5642   Create;
5643   LoadFromStream(aStream);
5644 end;
5645
5646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5647 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5648 var
5649   Image: PByte;
5650   ImageSize: Integer;
5651 begin
5652   Create;
5653   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5654   GetMem(Image, ImageSize);
5655   try
5656     FillChar(Image^, ImageSize, #$FF);
5657     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5658   except
5659     if Assigned(Image) then
5660       FreeMem(Image);
5661     raise;
5662   end;
5663 end;
5664
5665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5666 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5667   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5668 begin
5669   Create;
5670   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5671 end;
5672
5673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5674 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5675 begin
5676   Create;
5677   LoadFromResource(aInstance, aResource, aResType);
5678 end;
5679
5680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5681 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5682 begin
5683   Create;
5684   LoadFromResourceID(aInstance, aResourceID, aResType);
5685 end;
5686
5687 {$IFDEF GLB_SUPPORT_PNG_READ}
5688 {$IF DEFINED(GLB_LAZ_PNG)}
5689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5690 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5692 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5693 var
5694   png: TPortableNetworkGraphic;
5695   intf: TLazIntfImage;
5696   StreamPos: Int64;
5697 begin
5698   result := true;
5699   StreamPos := aStream.Position;
5700   png := TPortableNetworkGraphic.Create;
5701   try try
5702     png.LoadFromStream(aStream);
5703     intf := png.CreateIntfImage;
5704     try try
5705       AssignFromLazIntfImage(intf);
5706     except
5707       result := false;
5708       aStream.Position := StreamPos;
5709       exit;
5710     end;
5711     finally
5712       intf.Free;
5713     end;
5714   except
5715     result := false;
5716     aStream.Position := StreamPos;
5717     exit;
5718   end;
5719   finally
5720     png.Free;
5721   end;
5722 end;
5723
5724 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5726 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5727 var
5728   Surface: PSDL_Surface;
5729   RWops: PSDL_RWops;
5730 begin
5731   result := false;
5732   RWops := glBitmapCreateRWops(aStream);
5733   try
5734     if IMG_isPNG(RWops) > 0 then begin
5735       Surface := IMG_LoadPNG_RW(RWops);
5736       try
5737         AssignFromSurface(Surface);
5738         result := true;
5739       finally
5740         SDL_FreeSurface(Surface);
5741       end;
5742     end;
5743   finally
5744     SDL_FreeRW(RWops);
5745   end;
5746 end;
5747
5748 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5750 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5751 begin
5752   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5753 end;
5754
5755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5756 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5757 var
5758   StreamPos: Int64;
5759   signature: array [0..7] of byte;
5760   png: png_structp;
5761   png_info: png_infop;
5762
5763   TempHeight, TempWidth: Integer;
5764   Format: TglBitmapFormat;
5765
5766   png_data: pByte;
5767   png_rows: array of pByte;
5768   Row, LineSize: Integer;
5769 begin
5770   result := false;
5771
5772   if not init_libPNG then
5773     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5774
5775   try
5776     // signature
5777     StreamPos := aStream.Position;
5778     aStream.Read(signature{%H-}, 8);
5779     aStream.Position := StreamPos;
5780
5781     if png_check_sig(@signature, 8) <> 0 then begin
5782       // png read struct
5783       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5784       if png = nil then
5785         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5786
5787       // png info
5788       png_info := png_create_info_struct(png);
5789       if png_info = nil then begin
5790         png_destroy_read_struct(@png, nil, nil);
5791         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5792       end;
5793
5794       // set read callback
5795       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5796
5797       // read informations
5798       png_read_info(png, png_info);
5799
5800       // size
5801       TempHeight := png_get_image_height(png, png_info);
5802       TempWidth := png_get_image_width(png, png_info);
5803
5804       // format
5805       case png_get_color_type(png, png_info) of
5806         PNG_COLOR_TYPE_GRAY:
5807           Format := tfLuminance8;
5808         PNG_COLOR_TYPE_GRAY_ALPHA:
5809           Format := tfLuminance8Alpha8;
5810         PNG_COLOR_TYPE_RGB:
5811           Format := tfRGB8;
5812         PNG_COLOR_TYPE_RGB_ALPHA:
5813           Format := tfRGBA8;
5814         else
5815           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5816       end;
5817
5818       // cut upper 8 bit from 16 bit formats
5819       if png_get_bit_depth(png, png_info) > 8 then
5820         png_set_strip_16(png);
5821
5822       // expand bitdepth smaller than 8
5823       if png_get_bit_depth(png, png_info) < 8 then
5824         png_set_expand(png);
5825
5826       // allocating mem for scanlines
5827       LineSize := png_get_rowbytes(png, png_info);
5828       GetMem(png_data, TempHeight * LineSize);
5829       try
5830         SetLength(png_rows, TempHeight);
5831         for Row := Low(png_rows) to High(png_rows) do begin
5832           png_rows[Row] := png_data;
5833           Inc(png_rows[Row], Row * LineSize);
5834         end;
5835
5836         // read complete image into scanlines
5837         png_read_image(png, @png_rows[0]);
5838
5839         // read end
5840         png_read_end(png, png_info);
5841
5842         // destroy read struct
5843         png_destroy_read_struct(@png, @png_info, nil);
5844
5845         SetLength(png_rows, 0);
5846
5847         // set new data
5848         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5849
5850         result := true;
5851       except
5852         if Assigned(png_data) then
5853           FreeMem(png_data);
5854         raise;
5855       end;
5856     end;
5857   finally
5858     quit_libPNG;
5859   end;
5860 end;
5861
5862 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5863 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5864 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5865 var
5866   StreamPos: Int64;
5867   Png: TPNGObject;
5868   Header: String[8];
5869   Row, Col, PixSize, LineSize: Integer;
5870   NewImage, pSource, pDest, pAlpha: pByte;
5871   PngFormat: TglBitmapFormat;
5872   FormatDesc: TFormatDescriptor;
5873
5874 const
5875   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5876
5877 begin
5878   result := false;
5879
5880   StreamPos := aStream.Position;
5881   aStream.Read(Header[0], SizeOf(Header));
5882   aStream.Position := StreamPos;
5883
5884   {Test if the header matches}
5885   if Header = PngHeader then begin
5886     Png := TPNGObject.Create;
5887     try
5888       Png.LoadFromStream(aStream);
5889
5890       case Png.Header.ColorType of
5891         COLOR_GRAYSCALE:
5892           PngFormat := tfLuminance8;
5893         COLOR_GRAYSCALEALPHA:
5894           PngFormat := tfLuminance8Alpha8;
5895         COLOR_RGB:
5896           PngFormat := tfBGR8;
5897         COLOR_RGBALPHA:
5898           PngFormat := tfBGRA8;
5899         else
5900           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5901       end;
5902
5903       FormatDesc := TFormatDescriptor.Get(PngFormat);
5904       PixSize    := Round(FormatDesc.PixelSize);
5905       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5906
5907       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5908       try
5909         pDest := NewImage;
5910
5911         case Png.Header.ColorType of
5912           COLOR_RGB, COLOR_GRAYSCALE:
5913             begin
5914               for Row := 0 to Png.Height -1 do begin
5915                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5916                 Inc(pDest, LineSize);
5917               end;
5918             end;
5919           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5920             begin
5921               PixSize := PixSize -1;
5922
5923               for Row := 0 to Png.Height -1 do begin
5924                 pSource := Png.Scanline[Row];
5925                 pAlpha := pByte(Png.AlphaScanline[Row]);
5926
5927                 for Col := 0 to Png.Width -1 do begin
5928                   Move (pSource^, pDest^, PixSize);
5929                   Inc(pSource, PixSize);
5930                   Inc(pDest, PixSize);
5931
5932                   pDest^ := pAlpha^;
5933                   inc(pAlpha);
5934                   Inc(pDest);
5935                 end;
5936               end;
5937             end;
5938           else
5939             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5940         end;
5941
5942         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5943
5944         result := true;
5945       except
5946         if Assigned(NewImage) then
5947           FreeMem(NewImage);
5948         raise;
5949       end;
5950     finally
5951       Png.Free;
5952     end;
5953   end;
5954 end;
5955 {$IFEND}
5956 {$ENDIF}
5957
5958 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5959 {$IFDEF GLB_LIB_PNG}
5960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5961 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5962 begin
5963   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5964 end;
5965 {$ENDIF}
5966
5967 {$IF DEFINED(GLB_LAZ_PNG)}
5968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5969 procedure TglBitmap.SavePNG(const aStream: TStream);
5970 var
5971   png: TPortableNetworkGraphic;
5972   intf: TLazIntfImage;
5973 begin
5974   png  := TPortableNetworkGraphic.Create;
5975   intf := TLazIntfImage.Create(0, 0);
5976   try
5977     if not AssignToLazIntfImage(intf) then
5978       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5979     png.LoadFromIntfImage(intf);
5980     png.SaveToStream(aStream);
5981   finally
5982     png.Free;
5983     intf.Free;
5984   end;
5985 end;
5986
5987 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5989 procedure TglBitmap.SavePNG(const aStream: TStream);
5990 var
5991   png: png_structp;
5992   png_info: png_infop;
5993   png_rows: array of pByte;
5994   LineSize: Integer;
5995   ColorType: Integer;
5996   Row: Integer;
5997   FormatDesc: TFormatDescriptor;
5998 begin
5999   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6000     raise EglBitmapUnsupportedFormat.Create(Format);
6001
6002   if not init_libPNG then
6003     raise Exception.Create('unable to initialize libPNG.');
6004
6005   try
6006     case Format of
6007       tfAlpha8, tfLuminance8:
6008         ColorType := PNG_COLOR_TYPE_GRAY;
6009       tfLuminance8Alpha8:
6010         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6011       tfBGR8, tfRGB8:
6012         ColorType := PNG_COLOR_TYPE_RGB;
6013       tfBGRA8, tfRGBA8:
6014         ColorType := PNG_COLOR_TYPE_RGBA;
6015       else
6016         raise EglBitmapUnsupportedFormat.Create(Format);
6017     end;
6018
6019     FormatDesc := TFormatDescriptor.Get(Format);
6020     LineSize := FormatDesc.GetSize(Width, 1);
6021
6022     // creating array for scanline
6023     SetLength(png_rows, Height);
6024     try
6025       for Row := 0 to Height - 1 do begin
6026         png_rows[Row] := Data;
6027         Inc(png_rows[Row], Row * LineSize)
6028       end;
6029
6030       // write struct
6031       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6032       if png = nil then
6033         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6034
6035       // create png info
6036       png_info := png_create_info_struct(png);
6037       if png_info = nil then begin
6038         png_destroy_write_struct(@png, nil);
6039         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6040       end;
6041
6042       // set read callback
6043       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6044
6045       // set compression
6046       png_set_compression_level(png, 6);
6047
6048       if Format in [tfBGR8, tfBGRA8] then
6049         png_set_bgr(png);
6050
6051       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6052       png_write_info(png, png_info);
6053       png_write_image(png, @png_rows[0]);
6054       png_write_end(png, png_info);
6055       png_destroy_write_struct(@png, @png_info);
6056     finally
6057       SetLength(png_rows, 0);
6058     end;
6059   finally
6060     quit_libPNG;
6061   end;
6062 end;
6063
6064 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6066 procedure TglBitmap.SavePNG(const aStream: TStream);
6067 var
6068   Png: TPNGObject;
6069
6070   pSource, pDest: pByte;
6071   X, Y, PixSize: Integer;
6072   ColorType: Cardinal;
6073   Alpha: Boolean;
6074
6075   pTemp: pByte;
6076   Temp: Byte;
6077 begin
6078   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6079     raise EglBitmapUnsupportedFormat.Create(Format);
6080
6081   case Format of
6082     tfAlpha8, tfLuminance8: begin
6083       ColorType := COLOR_GRAYSCALE;
6084       PixSize   := 1;
6085       Alpha     := false;
6086     end;
6087     tfLuminance8Alpha8: begin
6088       ColorType := COLOR_GRAYSCALEALPHA;
6089       PixSize   := 1;
6090       Alpha     := true;
6091     end;
6092     tfBGR8, tfRGB8: begin
6093       ColorType := COLOR_RGB;
6094       PixSize   := 3;
6095       Alpha     := false;
6096     end;
6097     tfBGRA8, tfRGBA8: begin
6098       ColorType := COLOR_RGBALPHA;
6099       PixSize   := 3;
6100       Alpha     := true
6101     end;
6102   else
6103     raise EglBitmapUnsupportedFormat.Create(Format);
6104   end;
6105
6106   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6107   try
6108     // Copy ImageData
6109     pSource := Data;
6110     for Y := 0 to Height -1 do begin
6111       pDest := png.ScanLine[Y];
6112       for X := 0 to Width -1 do begin
6113         Move(pSource^, pDest^, PixSize);
6114         Inc(pDest, PixSize);
6115         Inc(pSource, PixSize);
6116         if Alpha then begin
6117           png.AlphaScanline[Y]^[X] := pSource^;
6118           Inc(pSource);
6119         end;
6120       end;
6121
6122       // convert RGB line to BGR
6123       if Format in [tfRGB8, tfRGBA8] then begin
6124         pTemp := png.ScanLine[Y];
6125         for X := 0 to Width -1 do begin
6126           Temp := pByteArray(pTemp)^[0];
6127           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6128           pByteArray(pTemp)^[2] := Temp;
6129           Inc(pTemp, 3);
6130         end;
6131       end;
6132     end;
6133
6134     // Save to Stream
6135     Png.CompressionLevel := 6;
6136     Png.SaveToStream(aStream);
6137   finally
6138     FreeAndNil(Png);
6139   end;
6140 end;
6141 {$IFEND}
6142 {$ENDIF}
6143
6144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6145 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6147 {$IFDEF GLB_LIB_JPEG}
6148 type
6149   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6150   glBitmap_libJPEG_source_mgr = record
6151     pub: jpeg_source_mgr;
6152
6153     SrcStream: TStream;
6154     SrcBuffer: array [1..4096] of byte;
6155   end;
6156
6157   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6158   glBitmap_libJPEG_dest_mgr = record
6159     pub: jpeg_destination_mgr;
6160
6161     DestStream: TStream;
6162     DestBuffer: array [1..4096] of byte;
6163   end;
6164
6165 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6166 begin
6167   //DUMMY
6168 end;
6169
6170
6171 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6172 begin
6173   //DUMMY
6174 end;
6175
6176
6177 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6178 begin
6179   //DUMMY
6180 end;
6181
6182 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6183 begin
6184   //DUMMY
6185 end;
6186
6187
6188 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6189 begin
6190   //DUMMY
6191 end;
6192
6193
6194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6195 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6196 var
6197   src: glBitmap_libJPEG_source_mgr_ptr;
6198   bytes: integer;
6199 begin
6200   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6201
6202   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6203         if (bytes <= 0) then begin
6204                 src^.SrcBuffer[1] := $FF;
6205                 src^.SrcBuffer[2] := JPEG_EOI;
6206                 bytes := 2;
6207         end;
6208
6209         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6210         src^.pub.bytes_in_buffer := bytes;
6211
6212   result := true;
6213 end;
6214
6215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6216 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6217 var
6218   src: glBitmap_libJPEG_source_mgr_ptr;
6219 begin
6220   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6221
6222   if num_bytes > 0 then begin
6223     // wanted byte isn't in buffer so set stream position and read buffer
6224     if num_bytes > src^.pub.bytes_in_buffer then begin
6225       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6226       src^.pub.fill_input_buffer(cinfo);
6227     end else begin
6228       // wanted byte is in buffer so only skip
6229                 inc(src^.pub.next_input_byte, num_bytes);
6230                 dec(src^.pub.bytes_in_buffer, num_bytes);
6231     end;
6232   end;
6233 end;
6234
6235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6236 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6237 var
6238   dest: glBitmap_libJPEG_dest_mgr_ptr;
6239 begin
6240   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6241
6242   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6243     // write complete buffer
6244     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6245
6246     // reset buffer
6247     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6248     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6249   end;
6250
6251   result := true;
6252 end;
6253
6254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6255 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6256 var
6257   Idx: Integer;
6258   dest: glBitmap_libJPEG_dest_mgr_ptr;
6259 begin
6260   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6261
6262   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6263     // check for endblock
6264     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6265       // write endblock
6266       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6267
6268       // leave
6269       break;
6270     end else
6271       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6272   end;
6273 end;
6274 {$ENDIF}
6275
6276 {$IFDEF GLB_SUPPORT_JPEG_READ}
6277 {$IF DEFINED(GLB_LAZ_JPEG)}
6278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6279 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6280 var
6281   jpeg: TJPEGImage;
6282   intf: TLazIntfImage;
6283   StreamPos: Int64;
6284 begin
6285   result := true;
6286   StreamPos := aStream.Position;
6287   jpeg := TJPEGImage.Create;
6288   try try
6289     jpeg.LoadFromStream(aStream);
6290     intf := TLazIntfImage.Create(0, 0);
6291     try try
6292       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6293       AssignFromLazIntfImage(intf);
6294     except
6295       result := false;
6296       aStream.Position := StreamPos;
6297       exit;
6298     end;
6299     finally
6300       intf.Free;
6301     end;
6302   except
6303     result := false;
6304     aStream.Position := StreamPos;
6305     exit;
6306   end;
6307   finally
6308     jpeg.Free;
6309   end;
6310 end;
6311
6312 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6314 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6315 var
6316   Surface: PSDL_Surface;
6317   RWops: PSDL_RWops;
6318 begin
6319   result := false;
6320
6321   RWops := glBitmapCreateRWops(aStream);
6322   try
6323     if IMG_isJPG(RWops) > 0 then begin
6324       Surface := IMG_LoadJPG_RW(RWops);
6325       try
6326         AssignFromSurface(Surface);
6327         result := true;
6328       finally
6329         SDL_FreeSurface(Surface);
6330       end;
6331     end;
6332   finally
6333     SDL_FreeRW(RWops);
6334   end;
6335 end;
6336
6337 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6339 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6340 var
6341   StreamPos: Int64;
6342   Temp: array[0..1]of Byte;
6343
6344   jpeg: jpeg_decompress_struct;
6345   jpeg_err: jpeg_error_mgr;
6346
6347   IntFormat: TglBitmapFormat;
6348   pImage: pByte;
6349   TempHeight, TempWidth: Integer;
6350
6351   pTemp: pByte;
6352   Row: Integer;
6353
6354   FormatDesc: TFormatDescriptor;
6355 begin
6356   result := false;
6357
6358   if not init_libJPEG then
6359     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6360
6361   try
6362     // reading first two bytes to test file and set cursor back to begin
6363     StreamPos := aStream.Position;
6364     aStream.Read({%H-}Temp[0], 2);
6365     aStream.Position := StreamPos;
6366
6367     // if Bitmap then read file.
6368     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6369       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6370       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6371
6372       // error managment
6373       jpeg.err := jpeg_std_error(@jpeg_err);
6374       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6375       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6376
6377       // decompression struct
6378       jpeg_create_decompress(@jpeg);
6379
6380       // allocation space for streaming methods
6381       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6382
6383       // seeting up custom functions
6384       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6385         pub.init_source       := glBitmap_libJPEG_init_source;
6386         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6387         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6388         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6389         pub.term_source       := glBitmap_libJPEG_term_source;
6390
6391         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6392         pub.next_input_byte := nil;   // until buffer loaded
6393
6394         SrcStream := aStream;
6395       end;
6396
6397       // set global decoding state
6398       jpeg.global_state := DSTATE_START;
6399
6400       // read header of jpeg
6401       jpeg_read_header(@jpeg, false);
6402
6403       // setting output parameter
6404       case jpeg.jpeg_color_space of
6405         JCS_GRAYSCALE:
6406           begin
6407             jpeg.out_color_space := JCS_GRAYSCALE;
6408             IntFormat := tfLuminance8;
6409           end;
6410         else
6411           jpeg.out_color_space := JCS_RGB;
6412           IntFormat := tfRGB8;
6413       end;
6414
6415       // reading image
6416       jpeg_start_decompress(@jpeg);
6417
6418       TempHeight := jpeg.output_height;
6419       TempWidth := jpeg.output_width;
6420
6421       FormatDesc := TFormatDescriptor.Get(IntFormat);
6422
6423       // creating new image
6424       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6425       try
6426         pTemp := pImage;
6427
6428         for Row := 0 to TempHeight -1 do begin
6429           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6430           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6431         end;
6432
6433         // finish decompression
6434         jpeg_finish_decompress(@jpeg);
6435
6436         // destroy decompression
6437         jpeg_destroy_decompress(@jpeg);
6438
6439         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6440
6441         result := true;
6442       except
6443         if Assigned(pImage) then
6444           FreeMem(pImage);
6445         raise;
6446       end;
6447     end;
6448   finally
6449     quit_libJPEG;
6450   end;
6451 end;
6452
6453 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6455 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6456 var
6457   bmp: TBitmap;
6458   jpg: TJPEGImage;
6459   StreamPos: Int64;
6460   Temp: array[0..1]of Byte;
6461 begin
6462   result := false;
6463
6464   // reading first two bytes to test file and set cursor back to begin
6465   StreamPos := aStream.Position;
6466   aStream.Read(Temp[0], 2);
6467   aStream.Position := StreamPos;
6468
6469   // if Bitmap then read file.
6470   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6471     bmp := TBitmap.Create;
6472     try
6473       jpg := TJPEGImage.Create;
6474       try
6475         jpg.LoadFromStream(aStream);
6476         bmp.Assign(jpg);
6477         result := AssignFromBitmap(bmp);
6478       finally
6479         jpg.Free;
6480       end;
6481     finally
6482       bmp.Free;
6483     end;
6484   end;
6485 end;
6486 {$IFEND}
6487 {$ENDIF}
6488
6489 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6490 {$IF DEFINED(GLB_LAZ_JPEG)}
6491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6492 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6493 var
6494   jpeg: TJPEGImage;
6495   intf: TLazIntfImage;
6496 begin
6497   jpeg := TJPEGImage.Create;
6498   intf := TLazIntfImage.Create(0, 0);
6499   try
6500     if not AssignToLazIntfImage(intf) then
6501       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6502     jpeg.LoadFromIntfImage(intf);
6503     jpeg.SaveToStream(aStream);
6504   finally
6505     intf.Free;
6506     jpeg.Free;
6507   end;
6508 end;
6509
6510 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6512 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6513 var
6514   jpeg: jpeg_compress_struct;
6515   jpeg_err: jpeg_error_mgr;
6516   Row: Integer;
6517   pTemp, pTemp2: pByte;
6518
6519   procedure CopyRow(pDest, pSource: pByte);
6520   var
6521     X: Integer;
6522   begin
6523     for X := 0 to Width - 1 do begin
6524       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6525       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6526       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6527       Inc(pDest, 3);
6528       Inc(pSource, 3);
6529     end;
6530   end;
6531
6532 begin
6533   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6534     raise EglBitmapUnsupportedFormat.Create(Format);
6535
6536   if not init_libJPEG then
6537     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6538
6539   try
6540     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6541     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6542
6543     // error managment
6544     jpeg.err := jpeg_std_error(@jpeg_err);
6545     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6546     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6547
6548     // compression struct
6549     jpeg_create_compress(@jpeg);
6550
6551     // allocation space for streaming methods
6552     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6553
6554     // seeting up custom functions
6555     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6556       pub.init_destination    := glBitmap_libJPEG_init_destination;
6557       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6558       pub.term_destination    := glBitmap_libJPEG_term_destination;
6559
6560       pub.next_output_byte  := @DestBuffer[1];
6561       pub.free_in_buffer    := Length(DestBuffer);
6562
6563       DestStream := aStream;
6564     end;
6565
6566     // very important state
6567     jpeg.global_state := CSTATE_START;
6568     jpeg.image_width  := Width;
6569     jpeg.image_height := Height;
6570     case Format of
6571       tfAlpha8, tfLuminance8: begin
6572         jpeg.input_components := 1;
6573         jpeg.in_color_space   := JCS_GRAYSCALE;
6574       end;
6575       tfRGB8, tfBGR8: begin
6576         jpeg.input_components := 3;
6577         jpeg.in_color_space   := JCS_RGB;
6578       end;
6579     end;
6580
6581     jpeg_set_defaults(@jpeg);
6582     jpeg_set_quality(@jpeg, 95, true);
6583     jpeg_start_compress(@jpeg, true);
6584     pTemp := Data;
6585
6586     if Format = tfBGR8 then
6587       GetMem(pTemp2, fRowSize)
6588     else
6589       pTemp2 := pTemp;
6590
6591     try
6592       for Row := 0 to jpeg.image_height -1 do begin
6593         // prepare row
6594         if Format = tfBGR8 then
6595           CopyRow(pTemp2, pTemp)
6596         else
6597           pTemp2 := pTemp;
6598
6599         // write row
6600         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6601         inc(pTemp, fRowSize);
6602       end;
6603     finally
6604       // free memory
6605       if Format = tfBGR8 then
6606         FreeMem(pTemp2);
6607     end;
6608     jpeg_finish_compress(@jpeg);
6609     jpeg_destroy_compress(@jpeg);
6610   finally
6611     quit_libJPEG;
6612   end;
6613 end;
6614
6615 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6617 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6618 var
6619   Bmp: TBitmap;
6620   Jpg: TJPEGImage;
6621 begin
6622   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6623     raise EglBitmapUnsupportedFormat.Create(Format);
6624
6625   Bmp := TBitmap.Create;
6626   try
6627     Jpg := TJPEGImage.Create;
6628     try
6629       AssignToBitmap(Bmp);
6630       if (Format in [tfAlpha8, tfLuminance8]) then begin
6631         Jpg.Grayscale   := true;
6632         Jpg.PixelFormat := jf8Bit;
6633       end;
6634       Jpg.Assign(Bmp);
6635       Jpg.SaveToStream(aStream);
6636     finally
6637       FreeAndNil(Jpg);
6638     end;
6639   finally
6640     FreeAndNil(Bmp);
6641   end;
6642 end;
6643 {$IFEND}
6644 {$ENDIF}
6645
6646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6647 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6649 const
6650   BMP_MAGIC          = $4D42;
6651
6652   BMP_COMP_RGB       = 0;
6653   BMP_COMP_RLE8      = 1;
6654   BMP_COMP_RLE4      = 2;
6655   BMP_COMP_BITFIELDS = 3;
6656
6657 type
6658   TBMPHeader = packed record
6659     bfType: Word;
6660     bfSize: Cardinal;
6661     bfReserved1: Word;
6662     bfReserved2: Word;
6663     bfOffBits: Cardinal;
6664   end;
6665
6666   TBMPInfo = packed record
6667     biSize: Cardinal;
6668     biWidth: Longint;
6669     biHeight: Longint;
6670     biPlanes: Word;
6671     biBitCount: Word;
6672     biCompression: Cardinal;
6673     biSizeImage: Cardinal;
6674     biXPelsPerMeter: Longint;
6675     biYPelsPerMeter: Longint;
6676     biClrUsed: Cardinal;
6677     biClrImportant: Cardinal;
6678   end;
6679
6680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6681 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6682
6683   //////////////////////////////////////////////////////////////////////////////////////////////////
6684   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6685   begin
6686     result := tfEmpty;
6687     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6688     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6689
6690     //Read Compression
6691     case aInfo.biCompression of
6692       BMP_COMP_RLE4,
6693       BMP_COMP_RLE8: begin
6694         raise EglBitmap.Create('RLE compression is not supported');
6695       end;
6696       BMP_COMP_BITFIELDS: begin
6697         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6698           aStream.Read(aMask.r, SizeOf(aMask.r));
6699           aStream.Read(aMask.g, SizeOf(aMask.g));
6700           aStream.Read(aMask.b, SizeOf(aMask.b));
6701           aStream.Read(aMask.a, SizeOf(aMask.a));
6702         end else
6703           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6704       end;
6705     end;
6706
6707     //get suitable format
6708     case aInfo.biBitCount of
6709        8: result := tfLuminance8;
6710       16: result := tfBGR5;
6711       24: result := tfBGR8;
6712       32: result := tfBGRA8;
6713     end;
6714   end;
6715
6716   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6717   var
6718     i, c: Integer;
6719     ColorTable: TbmpColorTable;
6720   begin
6721     result := nil;
6722     if (aInfo.biBitCount >= 16) then
6723       exit;
6724     aFormat := tfLuminance8;
6725     c := aInfo.biClrUsed;
6726     if (c = 0) then
6727       c := 1 shl aInfo.biBitCount;
6728     SetLength(ColorTable, c);
6729     for i := 0 to c-1 do begin
6730       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6731       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6732         aFormat := tfRGB8;
6733     end;
6734
6735     result := TbmpColorTableFormat.Create;
6736     result.PixelSize  := aInfo.biBitCount / 8;
6737     result.ColorTable := ColorTable;
6738     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6739   end;
6740
6741   //////////////////////////////////////////////////////////////////////////////////////////////////
6742   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6743     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6744   var
6745     TmpFormat: TglBitmapFormat;
6746     FormatDesc: TFormatDescriptor;
6747   begin
6748     result := nil;
6749     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6750       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6751         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6752         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6753           aFormat := FormatDesc.Format;
6754           exit;
6755         end;
6756       end;
6757
6758       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6759         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6760       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6761         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6762
6763       result := TbmpBitfieldFormat.Create;
6764       result.PixelSize := aInfo.biBitCount / 8;
6765       result.RedMask   := aMask.r;
6766       result.GreenMask := aMask.g;
6767       result.BlueMask  := aMask.b;
6768       result.AlphaMask := aMask.a;
6769     end;
6770   end;
6771
6772 var
6773   //simple types
6774   StartPos: Int64;
6775   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6776   PaddingBuff: Cardinal;
6777   LineBuf, ImageData, TmpData: PByte;
6778   SourceMD, DestMD: Pointer;
6779   BmpFormat: TglBitmapFormat;
6780
6781   //records
6782   Mask: TglBitmapColorRec;
6783   Header: TBMPHeader;
6784   Info: TBMPInfo;
6785
6786   //classes
6787   SpecialFormat: TFormatDescriptor;
6788   FormatDesc: TFormatDescriptor;
6789
6790   //////////////////////////////////////////////////////////////////////////////////////////////////
6791   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6792   var
6793     i: Integer;
6794     Pixel: TglBitmapPixelData;
6795   begin
6796     aStream.Read(aLineBuf^, rbLineSize);
6797     SpecialFormat.PreparePixel(Pixel);
6798     for i := 0 to Info.biWidth-1 do begin
6799       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6800       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6801       FormatDesc.Map(Pixel, aData, DestMD);
6802     end;
6803   end;
6804
6805 begin
6806   result        := false;
6807   BmpFormat     := tfEmpty;
6808   SpecialFormat := nil;
6809   LineBuf       := nil;
6810   SourceMD      := nil;
6811   DestMD        := nil;
6812
6813   // Header
6814   StartPos := aStream.Position;
6815   aStream.Read(Header{%H-}, SizeOf(Header));
6816
6817   if Header.bfType = BMP_MAGIC then begin
6818     try try
6819       BmpFormat        := ReadInfo(Info, Mask);
6820       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6821       if not Assigned(SpecialFormat) then
6822         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6823       aStream.Position := StartPos + Header.bfOffBits;
6824
6825       if (BmpFormat <> tfEmpty) then begin
6826         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6827         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6828         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6829         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6830
6831         //get Memory
6832         DestMD    := FormatDesc.CreateMappingData;
6833         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6834         GetMem(ImageData, ImageSize);
6835         if Assigned(SpecialFormat) then begin
6836           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6837           SourceMD := SpecialFormat.CreateMappingData;
6838         end;
6839
6840         //read Data
6841         try try
6842           FillChar(ImageData^, ImageSize, $FF);
6843           TmpData := ImageData;
6844           if (Info.biHeight > 0) then
6845             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6846           for i := 0 to Abs(Info.biHeight)-1 do begin
6847             if Assigned(SpecialFormat) then
6848               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6849             else
6850               aStream.Read(TmpData^, wbLineSize);   //else only read data
6851             if (Info.biHeight > 0) then
6852               dec(TmpData, wbLineSize)
6853             else
6854               inc(TmpData, wbLineSize);
6855             aStream.Read(PaddingBuff{%H-}, Padding);
6856           end;
6857           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6858           result := true;
6859         finally
6860           if Assigned(LineBuf) then
6861             FreeMem(LineBuf);
6862           if Assigned(SourceMD) then
6863             SpecialFormat.FreeMappingData(SourceMD);
6864           FormatDesc.FreeMappingData(DestMD);
6865         end;
6866         except
6867           if Assigned(ImageData) then
6868             FreeMem(ImageData);
6869           raise;
6870         end;
6871       end else
6872         raise EglBitmap.Create('LoadBMP - No suitable format found');
6873     except
6874       aStream.Position := StartPos;
6875       raise;
6876     end;
6877     finally
6878       FreeAndNil(SpecialFormat);
6879     end;
6880   end
6881     else aStream.Position := StartPos;
6882 end;
6883
6884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6885 procedure TglBitmap.SaveBMP(const aStream: TStream);
6886 var
6887   Header: TBMPHeader;
6888   Info: TBMPInfo;
6889   Converter: TbmpColorTableFormat;
6890   FormatDesc: TFormatDescriptor;
6891   SourceFD, DestFD: Pointer;
6892   pData, srcData, dstData, ConvertBuffer: pByte;
6893
6894   Pixel: TglBitmapPixelData;
6895   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6896   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6897
6898   PaddingBuff: Cardinal;
6899
6900   function GetLineWidth : Integer;
6901   begin
6902     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6903   end;
6904
6905 begin
6906   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6907     raise EglBitmapUnsupportedFormat.Create(Format);
6908
6909   Converter  := nil;
6910   FormatDesc := TFormatDescriptor.Get(Format);
6911   ImageSize  := FormatDesc.GetSize(Dimension);
6912
6913   FillChar(Header{%H-}, SizeOf(Header), 0);
6914   Header.bfType      := BMP_MAGIC;
6915   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6916   Header.bfReserved1 := 0;
6917   Header.bfReserved2 := 0;
6918   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6919
6920   FillChar(Info{%H-}, SizeOf(Info), 0);
6921   Info.biSize        := SizeOf(Info);
6922   Info.biWidth       := Width;
6923   Info.biHeight      := Height;
6924   Info.biPlanes      := 1;
6925   Info.biCompression := BMP_COMP_RGB;
6926   Info.biSizeImage   := ImageSize;
6927
6928   try
6929     case Format of
6930       tfLuminance4: begin
6931         Info.biBitCount  := 4;
6932         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6933         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6934         Converter           := TbmpColorTableFormat.Create;
6935         Converter.PixelSize := 0.5;
6936         Converter.Format    := Format;
6937         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6938         Converter.CreateColorTable;
6939       end;
6940
6941       tfR3G3B2, tfLuminance8: begin
6942         Info.biBitCount  :=  8;
6943         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6944         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6945         Converter           := TbmpColorTableFormat.Create;
6946         Converter.PixelSize := 1;
6947         Converter.Format    := Format;
6948         if (Format = tfR3G3B2) then begin
6949           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6950           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6951         end else
6952           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6953         Converter.CreateColorTable;
6954       end;
6955
6956       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6957       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6958         Info.biBitCount    := 16;
6959         Info.biCompression := BMP_COMP_BITFIELDS;
6960       end;
6961
6962       tfBGR8, tfRGB8: begin
6963         Info.biBitCount := 24;
6964       end;
6965
6966       tfRGB10, tfRGB10A2, tfRGBA8,
6967       tfBGR10, tfBGR10A2, tfBGRA8: begin
6968         Info.biBitCount    := 32;
6969         Info.biCompression := BMP_COMP_BITFIELDS;
6970       end;
6971     else
6972       raise EglBitmapUnsupportedFormat.Create(Format);
6973     end;
6974     Info.biXPelsPerMeter := 2835;
6975     Info.biYPelsPerMeter := 2835;
6976
6977     // prepare bitmasks
6978     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6979       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6980       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6981
6982       RedMask    := FormatDesc.RedMask;
6983       GreenMask  := FormatDesc.GreenMask;
6984       BlueMask   := FormatDesc.BlueMask;
6985       AlphaMask  := FormatDesc.AlphaMask;
6986     end;
6987
6988     // headers
6989     aStream.Write(Header, SizeOf(Header));
6990     aStream.Write(Info, SizeOf(Info));
6991
6992     // colortable
6993     if Assigned(Converter) then
6994       aStream.Write(Converter.ColorTable[0].b,
6995         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6996
6997     // bitmasks
6998     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6999       aStream.Write(RedMask,   SizeOf(Cardinal));
7000       aStream.Write(GreenMask, SizeOf(Cardinal));
7001       aStream.Write(BlueMask,  SizeOf(Cardinal));
7002       aStream.Write(AlphaMask, SizeOf(Cardinal));
7003     end;
7004
7005     // image data
7006     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7007     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7008     Padding     := GetLineWidth - wbLineSize;
7009     PaddingBuff := 0;
7010
7011     pData := Data;
7012     inc(pData, (Height-1) * rbLineSize);
7013
7014     // prepare row buffer. But only for RGB because RGBA supports color masks
7015     // so it's possible to change color within the image.
7016     if Assigned(Converter) then begin
7017       FormatDesc.PreparePixel(Pixel);
7018       GetMem(ConvertBuffer, wbLineSize);
7019       SourceFD := FormatDesc.CreateMappingData;
7020       DestFD   := Converter.CreateMappingData;
7021     end else
7022       ConvertBuffer := nil;
7023
7024     try
7025       for LineIdx := 0 to Height - 1 do begin
7026         // preparing row
7027         if Assigned(Converter) then begin
7028           srcData := pData;
7029           dstData := ConvertBuffer;
7030           for PixelIdx := 0 to Info.biWidth-1 do begin
7031             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7032             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7033             Converter.Map(Pixel, dstData, DestFD);
7034           end;
7035           aStream.Write(ConvertBuffer^, wbLineSize);
7036         end else begin
7037           aStream.Write(pData^, rbLineSize);
7038         end;
7039         dec(pData, rbLineSize);
7040         if (Padding > 0) then
7041           aStream.Write(PaddingBuff, Padding);
7042       end;
7043     finally
7044       // destroy row buffer
7045       if Assigned(ConvertBuffer) then begin
7046         FormatDesc.FreeMappingData(SourceFD);
7047         Converter.FreeMappingData(DestFD);
7048         FreeMem(ConvertBuffer);
7049       end;
7050     end;
7051   finally
7052     if Assigned(Converter) then
7053       Converter.Free;
7054   end;
7055 end;
7056
7057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7058 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7060 type
7061   TTGAHeader = packed record
7062     ImageID: Byte;
7063     ColorMapType: Byte;
7064     ImageType: Byte;
7065     //ColorMapSpec: Array[0..4] of Byte;
7066     ColorMapStart: Word;
7067     ColorMapLength: Word;
7068     ColorMapEntrySize: Byte;
7069     OrigX: Word;
7070     OrigY: Word;
7071     Width: Word;
7072     Height: Word;
7073     Bpp: Byte;
7074     ImageDesc: Byte;
7075   end;
7076
7077 const
7078   TGA_UNCOMPRESSED_RGB  =  2;
7079   TGA_UNCOMPRESSED_GRAY =  3;
7080   TGA_COMPRESSED_RGB    = 10;
7081   TGA_COMPRESSED_GRAY   = 11;
7082
7083   TGA_NONE_COLOR_TABLE  = 0;
7084
7085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7086 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7087 var
7088   Header: TTGAHeader;
7089   ImageData: System.PByte;
7090   StartPosition: Int64;
7091   PixelSize, LineSize: Integer;
7092   tgaFormat: TglBitmapFormat;
7093   FormatDesc: TFormatDescriptor;
7094   Counter: packed record
7095     X, Y: packed record
7096       low, high, dir: Integer;
7097     end;
7098   end;
7099
7100 const
7101   CACHE_SIZE = $4000;
7102
7103   ////////////////////////////////////////////////////////////////////////////////////////
7104   procedure ReadUncompressed;
7105   var
7106     i, j: Integer;
7107     buf, tmp1, tmp2: System.PByte;
7108   begin
7109     buf := nil;
7110     if (Counter.X.dir < 0) then
7111       GetMem(buf, LineSize);
7112     try
7113       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7114         tmp1 := ImageData;
7115         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7116         if (Counter.X.dir < 0) then begin               //flip X
7117           aStream.Read(buf^, LineSize);
7118           tmp2 := buf;
7119           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7120           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7121             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7122               tmp1^ := tmp2^;
7123               inc(tmp1);
7124               inc(tmp2);
7125             end;
7126             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7127           end;
7128         end else
7129           aStream.Read(tmp1^, LineSize);
7130         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7131       end;
7132     finally
7133       if Assigned(buf) then
7134         FreeMem(buf);
7135     end;
7136   end;
7137
7138   ////////////////////////////////////////////////////////////////////////////////////////
7139   procedure ReadCompressed;
7140
7141     /////////////////////////////////////////////////////////////////
7142     var
7143       TmpData: System.PByte;
7144       LinePixelsRead: Integer;
7145     procedure CheckLine;
7146     begin
7147       if (LinePixelsRead >= Header.Width) then begin
7148         LinePixelsRead := 0;
7149         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7150         TmpData := ImageData;
7151         inc(TmpData, Counter.Y.low * LineSize);           //set line
7152         if (Counter.X.dir < 0) then                       //if x flipped then
7153           inc(TmpData, LineSize - PixelSize);             //set last pixel
7154       end;
7155     end;
7156
7157     /////////////////////////////////////////////////////////////////
7158     var
7159       Cache: PByte;
7160       CacheSize, CachePos: Integer;
7161     procedure CachedRead(out Buffer; Count: Integer);
7162     var
7163       BytesRead: Integer;
7164     begin
7165       if (CachePos + Count > CacheSize) then begin
7166         //if buffer overflow save non read bytes
7167         BytesRead := 0;
7168         if (CacheSize - CachePos > 0) then begin
7169           BytesRead := CacheSize - CachePos;
7170           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7171           inc(CachePos, BytesRead);
7172         end;
7173
7174         //load cache from file
7175         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7176         aStream.Read(Cache^, CacheSize);
7177         CachePos := 0;
7178
7179         //read rest of requested bytes
7180         if (Count - BytesRead > 0) then begin
7181           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7182           inc(CachePos, Count - BytesRead);
7183         end;
7184       end else begin
7185         //if no buffer overflow just read the data
7186         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7187         inc(CachePos, Count);
7188       end;
7189     end;
7190
7191     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7192     begin
7193       case PixelSize of
7194         1: begin
7195           aBuffer^ := aData^;
7196           inc(aBuffer, Counter.X.dir);
7197         end;
7198         2: begin
7199           PWord(aBuffer)^ := PWord(aData)^;
7200           inc(aBuffer, 2 * Counter.X.dir);
7201         end;
7202         3: begin
7203           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7204           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7205           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7206           inc(aBuffer, 3 * Counter.X.dir);
7207         end;
7208         4: begin
7209           PCardinal(aBuffer)^ := PCardinal(aData)^;
7210           inc(aBuffer, 4 * Counter.X.dir);
7211         end;
7212       end;
7213     end;
7214
7215   var
7216     TotalPixelsToRead, TotalPixelsRead: Integer;
7217     Temp: Byte;
7218     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7219     PixelRepeat: Boolean;
7220     PixelsToRead, PixelCount: Integer;
7221   begin
7222     CacheSize := 0;
7223     CachePos  := 0;
7224
7225     TotalPixelsToRead := Header.Width * Header.Height;
7226     TotalPixelsRead   := 0;
7227     LinePixelsRead    := 0;
7228
7229     GetMem(Cache, CACHE_SIZE);
7230     try
7231       TmpData := ImageData;
7232       inc(TmpData, Counter.Y.low * LineSize);           //set line
7233       if (Counter.X.dir < 0) then                       //if x flipped then
7234         inc(TmpData, LineSize - PixelSize);             //set last pixel
7235
7236       repeat
7237         //read CommandByte
7238         CachedRead(Temp, 1);
7239         PixelRepeat  := (Temp and $80) > 0;
7240         PixelsToRead := (Temp and $7F) + 1;
7241         inc(TotalPixelsRead, PixelsToRead);
7242
7243         if PixelRepeat then
7244           CachedRead(buf[0], PixelSize);
7245         while (PixelsToRead > 0) do begin
7246           CheckLine;
7247           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7248           while (PixelCount > 0) do begin
7249             if not PixelRepeat then
7250               CachedRead(buf[0], PixelSize);
7251             PixelToBuffer(@buf[0], TmpData);
7252             inc(LinePixelsRead);
7253             dec(PixelsToRead);
7254             dec(PixelCount);
7255           end;
7256         end;
7257       until (TotalPixelsRead >= TotalPixelsToRead);
7258     finally
7259       FreeMem(Cache);
7260     end;
7261   end;
7262
7263   function IsGrayFormat: Boolean;
7264   begin
7265     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7266   end;
7267
7268 begin
7269   result := false;
7270
7271   // reading header to test file and set cursor back to begin
7272   StartPosition := aStream.Position;
7273   aStream.Read(Header{%H-}, SizeOf(Header));
7274
7275   // no colormapped files
7276   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7277     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7278   begin
7279     try
7280       if Header.ImageID <> 0 then       // skip image ID
7281         aStream.Position := aStream.Position + Header.ImageID;
7282
7283       tgaFormat := tfEmpty;
7284       case Header.Bpp of
7285          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7286                0: tgaFormat := tfLuminance8;
7287                8: tgaFormat := tfAlpha8;
7288             end;
7289
7290         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7291                0: tgaFormat := tfLuminance16;
7292                8: tgaFormat := tfLuminance8Alpha8;
7293             end else case (Header.ImageDesc and $F) of
7294                0: tgaFormat := tfBGR5;
7295                1: tgaFormat := tfBGR5A1;
7296                4: tgaFormat := tfBGRA4;
7297             end;
7298
7299         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7300                0: tgaFormat := tfBGR8;
7301             end;
7302
7303         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7304                2: tgaFormat := tfBGR10A2;
7305                8: tgaFormat := tfBGRA8;
7306             end;
7307       end;
7308
7309       if (tgaFormat = tfEmpty) then
7310         raise EglBitmap.Create('LoadTga - unsupported format');
7311
7312       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7313       PixelSize  := FormatDesc.GetSize(1, 1);
7314       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7315
7316       GetMem(ImageData, LineSize * Header.Height);
7317       try
7318         //column direction
7319         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7320           Counter.X.low  := Header.Height-1;;
7321           Counter.X.high := 0;
7322           Counter.X.dir  := -1;
7323         end else begin
7324           Counter.X.low  := 0;
7325           Counter.X.high := Header.Height-1;
7326           Counter.X.dir  := 1;
7327         end;
7328
7329         // Row direction
7330         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7331           Counter.Y.low  := 0;
7332           Counter.Y.high := Header.Height-1;
7333           Counter.Y.dir  := 1;
7334         end else begin
7335           Counter.Y.low  := Header.Height-1;;
7336           Counter.Y.high := 0;
7337           Counter.Y.dir  := -1;
7338         end;
7339
7340         // Read Image
7341         case Header.ImageType of
7342           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7343             ReadUncompressed;
7344           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7345             ReadCompressed;
7346         end;
7347
7348         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7349         result := true;
7350       except
7351         if Assigned(ImageData) then
7352           FreeMem(ImageData);
7353         raise;
7354       end;
7355     finally
7356       aStream.Position := StartPosition;
7357     end;
7358   end
7359     else aStream.Position := StartPosition;
7360 end;
7361
7362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7363 procedure TglBitmap.SaveTGA(const aStream: TStream);
7364 var
7365   Header: TTGAHeader;
7366   LineSize, Size, x, y: Integer;
7367   Pixel: TglBitmapPixelData;
7368   LineBuf, SourceData, DestData: PByte;
7369   SourceMD, DestMD: Pointer;
7370   FormatDesc: TFormatDescriptor;
7371   Converter: TFormatDescriptor;
7372 begin
7373   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7374     raise EglBitmapUnsupportedFormat.Create(Format);
7375
7376   //prepare header
7377   FillChar(Header{%H-}, SizeOf(Header), 0);
7378
7379   //set ImageType
7380   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7381                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7382     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7383   else
7384     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7385
7386   //set BitsPerPixel
7387   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7388     Header.Bpp := 8
7389   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7390                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7391     Header.Bpp := 16
7392   else if (Format in [tfBGR8, tfRGB8]) then
7393     Header.Bpp := 24
7394   else
7395     Header.Bpp := 32;
7396
7397   //set AlphaBitCount
7398   case Format of
7399     tfRGB5A1, tfBGR5A1:
7400       Header.ImageDesc := 1 and $F;
7401     tfRGB10A2, tfBGR10A2:
7402       Header.ImageDesc := 2 and $F;
7403     tfRGBA4, tfBGRA4:
7404       Header.ImageDesc := 4 and $F;
7405     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7406       Header.ImageDesc := 8 and $F;
7407   end;
7408
7409   Header.Width     := Width;
7410   Header.Height    := Height;
7411   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7412   aStream.Write(Header, SizeOf(Header));
7413
7414   // convert RGB(A) to BGR(A)
7415   Converter  := nil;
7416   FormatDesc := TFormatDescriptor.Get(Format);
7417   Size       := FormatDesc.GetSize(Dimension);
7418   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7419     if (FormatDesc.RGBInverted = tfEmpty) then
7420       raise EglBitmap.Create('inverted RGB format is empty');
7421     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7422     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7423        (Converter.PixelSize <> FormatDesc.PixelSize) then
7424       raise EglBitmap.Create('invalid inverted RGB format');
7425   end;
7426
7427   if Assigned(Converter) then begin
7428     LineSize := FormatDesc.GetSize(Width, 1);
7429     GetMem(LineBuf, LineSize);
7430     SourceMD := FormatDesc.CreateMappingData;
7431     DestMD   := Converter.CreateMappingData;
7432     try
7433       SourceData := Data;
7434       for y := 0 to Height-1 do begin
7435         DestData := LineBuf;
7436         for x := 0 to Width-1 do begin
7437           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7438           Converter.Map(Pixel, DestData, DestMD);
7439         end;
7440         aStream.Write(LineBuf^, LineSize);
7441       end;
7442     finally
7443       FreeMem(LineBuf);
7444       FormatDesc.FreeMappingData(SourceMD);
7445       FormatDesc.FreeMappingData(DestMD);
7446     end;
7447   end else
7448     aStream.Write(Data^, Size);
7449 end;
7450
7451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7452 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7454 const
7455   DDS_MAGIC: Cardinal         = $20534444;
7456
7457   // DDS_header.dwFlags
7458   DDSD_CAPS                   = $00000001;
7459   DDSD_HEIGHT                 = $00000002;
7460   DDSD_WIDTH                  = $00000004;
7461   DDSD_PIXELFORMAT            = $00001000;
7462
7463   // DDS_header.sPixelFormat.dwFlags
7464   DDPF_ALPHAPIXELS            = $00000001;
7465   DDPF_ALPHA                  = $00000002;
7466   DDPF_FOURCC                 = $00000004;
7467   DDPF_RGB                    = $00000040;
7468   DDPF_LUMINANCE              = $00020000;
7469
7470   // DDS_header.sCaps.dwCaps1
7471   DDSCAPS_TEXTURE             = $00001000;
7472
7473   // DDS_header.sCaps.dwCaps2
7474   DDSCAPS2_CUBEMAP            = $00000200;
7475
7476   D3DFMT_DXT1                 = $31545844;
7477   D3DFMT_DXT3                 = $33545844;
7478   D3DFMT_DXT5                 = $35545844;
7479
7480 type
7481   TDDSPixelFormat = packed record
7482     dwSize: Cardinal;
7483     dwFlags: Cardinal;
7484     dwFourCC: Cardinal;
7485     dwRGBBitCount: Cardinal;
7486     dwRBitMask: Cardinal;
7487     dwGBitMask: Cardinal;
7488     dwBBitMask: Cardinal;
7489     dwABitMask: Cardinal;
7490   end;
7491
7492   TDDSCaps = packed record
7493     dwCaps1: Cardinal;
7494     dwCaps2: Cardinal;
7495     dwDDSX: Cardinal;
7496     dwReserved: Cardinal;
7497   end;
7498
7499   TDDSHeader = packed record
7500     dwSize: Cardinal;
7501     dwFlags: Cardinal;
7502     dwHeight: Cardinal;
7503     dwWidth: Cardinal;
7504     dwPitchOrLinearSize: Cardinal;
7505     dwDepth: Cardinal;
7506     dwMipMapCount: Cardinal;
7507     dwReserved: array[0..10] of Cardinal;
7508     PixelFormat: TDDSPixelFormat;
7509     Caps: TDDSCaps;
7510     dwReserved2: Cardinal;
7511   end;
7512
7513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7514 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7515 var
7516   Header: TDDSHeader;
7517   Converter: TbmpBitfieldFormat;
7518
7519   function GetDDSFormat: TglBitmapFormat;
7520   var
7521     fd: TFormatDescriptor;
7522     i: Integer;
7523     Range: TglBitmapColorRec;
7524     match: Boolean;
7525   begin
7526     result := tfEmpty;
7527     with Header.PixelFormat do begin
7528       // Compresses
7529       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7530         case Header.PixelFormat.dwFourCC of
7531           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7532           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7533           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7534         end;
7535       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7536
7537         //find matching format
7538         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7539           fd := TFormatDescriptor.Get(result);
7540           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7541              (8 * fd.PixelSize = dwRGBBitCount) then
7542             exit;
7543         end;
7544
7545         //find format with same Range
7546         Range.r := dwRBitMask;
7547         Range.g := dwGBitMask;
7548         Range.b := dwBBitMask;
7549         Range.a := dwABitMask;
7550         for i := 0 to 3 do begin
7551           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7552             Range.arr[i] := Range.arr[i] shr 1;
7553         end;
7554         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7555           fd := TFormatDescriptor.Get(result);
7556           match := true;
7557           for i := 0 to 3 do
7558             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7559               match := false;
7560               break;
7561             end;
7562           if match then
7563             break;
7564         end;
7565
7566         //no format with same range found -> use default
7567         if (result = tfEmpty) then begin
7568           if (dwABitMask > 0) then
7569             result := tfBGRA8
7570           else
7571             result := tfBGR8;
7572         end;
7573
7574         Converter := TbmpBitfieldFormat.Create;
7575         Converter.RedMask   := dwRBitMask;
7576         Converter.GreenMask := dwGBitMask;
7577         Converter.BlueMask  := dwBBitMask;
7578         Converter.AlphaMask := dwABitMask;
7579         Converter.PixelSize := dwRGBBitCount / 8;
7580       end;
7581     end;
7582   end;
7583
7584 var
7585   StreamPos: Int64;
7586   x, y, LineSize, RowSize, Magic: Cardinal;
7587   NewImage, TmpData, RowData, SrcData: System.PByte;
7588   SourceMD, DestMD: Pointer;
7589   Pixel: TglBitmapPixelData;
7590   ddsFormat: TglBitmapFormat;
7591   FormatDesc: TFormatDescriptor;
7592
7593 begin
7594   result    := false;
7595   Converter := nil;
7596   StreamPos := aStream.Position;
7597
7598   // Magic
7599   aStream.Read(Magic{%H-}, sizeof(Magic));
7600   if (Magic <> DDS_MAGIC) then begin
7601     aStream.Position := StreamPos;
7602     exit;
7603   end;
7604
7605   //Header
7606   aStream.Read(Header{%H-}, sizeof(Header));
7607   if (Header.dwSize <> SizeOf(Header)) or
7608      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7609         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7610   begin
7611     aStream.Position := StreamPos;
7612     exit;
7613   end;
7614
7615   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7616     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7617
7618   ddsFormat := GetDDSFormat;
7619   try
7620     if (ddsFormat = tfEmpty) then
7621       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7622
7623     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7624     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7625     GetMem(NewImage, Header.dwHeight * LineSize);
7626     try
7627       TmpData := NewImage;
7628
7629       //Converter needed
7630       if Assigned(Converter) then begin
7631         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7632         GetMem(RowData, RowSize);
7633         SourceMD := Converter.CreateMappingData;
7634         DestMD   := FormatDesc.CreateMappingData;
7635         try
7636           for y := 0 to Header.dwHeight-1 do begin
7637             TmpData := NewImage;
7638             inc(TmpData, y * LineSize);
7639             SrcData := RowData;
7640             aStream.Read(SrcData^, RowSize);
7641             for x := 0 to Header.dwWidth-1 do begin
7642               Converter.Unmap(SrcData, Pixel, SourceMD);
7643               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7644               FormatDesc.Map(Pixel, TmpData, DestMD);
7645             end;
7646           end;
7647         finally
7648           Converter.FreeMappingData(SourceMD);
7649           FormatDesc.FreeMappingData(DestMD);
7650           FreeMem(RowData);
7651         end;
7652       end else
7653
7654       // Compressed
7655       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7656         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7657         for Y := 0 to Header.dwHeight-1 do begin
7658           aStream.Read(TmpData^, RowSize);
7659           Inc(TmpData, LineSize);
7660         end;
7661       end else
7662
7663       // Uncompressed
7664       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7665         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7666         for Y := 0 to Header.dwHeight-1 do begin
7667           aStream.Read(TmpData^, RowSize);
7668           Inc(TmpData, LineSize);
7669         end;
7670       end else
7671         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7672
7673       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7674       result := true;
7675     except
7676       if Assigned(NewImage) then
7677         FreeMem(NewImage);
7678       raise;
7679     end;
7680   finally
7681     FreeAndNil(Converter);
7682   end;
7683 end;
7684
7685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7686 procedure TglBitmap.SaveDDS(const aStream: TStream);
7687 var
7688   Header: TDDSHeader;
7689   FormatDesc: TFormatDescriptor;
7690 begin
7691   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7692     raise EglBitmapUnsupportedFormat.Create(Format);
7693
7694   FormatDesc := TFormatDescriptor.Get(Format);
7695
7696   // Generell
7697   FillChar(Header{%H-}, SizeOf(Header), 0);
7698   Header.dwSize  := SizeOf(Header);
7699   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7700
7701   Header.dwWidth  := Max(1, Width);
7702   Header.dwHeight := Max(1, Height);
7703
7704   // Caps
7705   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7706
7707   // Pixelformat
7708   Header.PixelFormat.dwSize := sizeof(Header);
7709   if (FormatDesc.IsCompressed) then begin
7710     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7711     case Format of
7712       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7713       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7714       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7715     end;
7716   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7717     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7718     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7719     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7720   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7721     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7722     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7723     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7724     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7725   end else begin
7726     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7727     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7728     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7729     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7730     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7731     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7732   end;
7733
7734   if (FormatDesc.HasAlpha) then
7735     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7736
7737   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7738   aStream.Write(Header, SizeOf(Header));
7739   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7740 end;
7741
7742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7743 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7745 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7746   const aWidth: Integer; const aHeight: Integer);
7747 var
7748   pTemp: pByte;
7749   Size: Integer;
7750 begin
7751   if (aHeight > 1) then begin
7752     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7753     GetMem(pTemp, Size);
7754     try
7755       Move(aData^, pTemp^, Size);
7756       FreeMem(aData);
7757       aData := nil;
7758     except
7759       FreeMem(pTemp);
7760       raise;
7761     end;
7762   end else
7763     pTemp := aData;
7764   inherited SetDataPointer(pTemp, aFormat, aWidth);
7765 end;
7766
7767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7768 function TglBitmap1D.FlipHorz: Boolean;
7769 var
7770   Col: Integer;
7771   pTempDest, pDest, pSource: PByte;
7772 begin
7773   result := inherited FlipHorz;
7774   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7775     pSource := Data;
7776     GetMem(pDest, fRowSize);
7777     try
7778       pTempDest := pDest;
7779       Inc(pTempDest, fRowSize);
7780       for Col := 0 to Width-1 do begin
7781         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7782         Move(pSource^, pTempDest^, fPixelSize);
7783         Inc(pSource, fPixelSize);
7784       end;
7785       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7786       result := true;
7787     except
7788       if Assigned(pDest) then
7789         FreeMem(pDest);
7790       raise;
7791     end;
7792   end;
7793 end;
7794
7795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7796 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7797 var
7798   FormatDesc: TFormatDescriptor;
7799 begin
7800   // Upload data
7801   FormatDesc := TFormatDescriptor.Get(Format);
7802   if FormatDesc.IsCompressed then
7803     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7804   else if aBuildWithGlu then
7805     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7806   else
7807     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7808
7809   // Free Data
7810   if (FreeDataAfterGenTexture) then
7811     FreeData;
7812 end;
7813
7814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7815 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7816 var
7817   BuildWithGlu, TexRec: Boolean;
7818   TexSize: Integer;
7819 begin
7820   if Assigned(Data) then begin
7821     // Check Texture Size
7822     if (aTestTextureSize) then begin
7823       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7824
7825       if (Width > TexSize) then
7826         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7827
7828       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7829                 (Target = GL_TEXTURE_RECTANGLE);
7830       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7831         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7832     end;
7833
7834     CreateId;
7835     SetupParameters(BuildWithGlu);
7836     UploadData(BuildWithGlu);
7837     glAreTexturesResident(1, @fID, @fIsResident);
7838   end;
7839 end;
7840
7841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7842 procedure TglBitmap1D.AfterConstruction;
7843 begin
7844   inherited;
7845   Target := GL_TEXTURE_1D;
7846 end;
7847
7848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7849 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7850 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7851 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7852 begin
7853   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7854     result := fLines[aIndex]
7855   else
7856     result := nil;
7857 end;
7858
7859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7860 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7861   const aWidth: Integer; const aHeight: Integer);
7862 var
7863   Idx, LineWidth: Integer;
7864 begin
7865   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7866
7867   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7868     // Assigning Data
7869     if Assigned(Data) then begin
7870       SetLength(fLines, GetHeight);
7871       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7872
7873       for Idx := 0 to GetHeight-1 do begin
7874         fLines[Idx] := Data;
7875         Inc(fLines[Idx], Idx * LineWidth);
7876       end;
7877     end
7878       else SetLength(fLines, 0);
7879   end else begin
7880     SetLength(fLines, 0);
7881   end;
7882 end;
7883
7884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7885 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7886 var
7887   FormatDesc: TFormatDescriptor;
7888 begin
7889   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7890
7891   FormatDesc := TFormatDescriptor.Get(Format);
7892   if FormatDesc.IsCompressed then begin
7893     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7894   end else if aBuildWithGlu then begin
7895     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7896       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7897   end else begin
7898     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7899       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7900   end;
7901
7902   // Freigeben
7903   if (FreeDataAfterGenTexture) then
7904     FreeData;
7905 end;
7906
7907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7908 procedure TglBitmap2D.AfterConstruction;
7909 begin
7910   inherited;
7911   Target := GL_TEXTURE_2D;
7912 end;
7913
7914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7915 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7916 var
7917   Temp: pByte;
7918   Size, w, h: Integer;
7919   FormatDesc: TFormatDescriptor;
7920 begin
7921   FormatDesc := TFormatDescriptor.Get(aFormat);
7922   if FormatDesc.IsCompressed then
7923     raise EglBitmapUnsupportedFormat.Create(aFormat);
7924
7925   w    := aRight  - aLeft;
7926   h    := aBottom - aTop;
7927   Size := FormatDesc.GetSize(w, h);
7928   GetMem(Temp, Size);
7929   try
7930     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7931     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7932     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7933     FlipVert;
7934   except
7935     if Assigned(Temp) then
7936       FreeMem(Temp);
7937     raise;
7938   end;
7939 end;
7940
7941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7942 procedure TglBitmap2D.GetDataFromTexture;
7943 var
7944   Temp: PByte;
7945   TempWidth, TempHeight: Integer;
7946   TempIntFormat: Cardinal;
7947   IntFormat, f: TglBitmapFormat;
7948   FormatDesc: TFormatDescriptor;
7949 begin
7950   Bind;
7951
7952   // Request Data
7953   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7954   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7955   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7956
7957   IntFormat := tfEmpty;
7958   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7959     FormatDesc := TFormatDescriptor.Get(f);
7960     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7961       IntFormat := FormatDesc.Format;
7962       break;
7963     end;
7964   end;
7965
7966   // Getting data from OpenGL
7967   FormatDesc := TFormatDescriptor.Get(IntFormat);
7968   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7969   try
7970     if FormatDesc.IsCompressed then
7971       glGetCompressedTexImage(Target, 0, Temp)
7972     else
7973      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7974     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7975   except
7976     if Assigned(Temp) then
7977       FreeMem(Temp);
7978     raise;
7979   end;
7980 end;
7981
7982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7983 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7984 var
7985   BuildWithGlu, PotTex, TexRec: Boolean;
7986   TexSize: Integer;
7987 begin
7988   if Assigned(Data) then begin
7989     // Check Texture Size
7990     if (aTestTextureSize) then begin
7991       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7992
7993       if ((Height > TexSize) or (Width > TexSize)) then
7994         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7995
7996       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7997       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7998       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7999         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8000     end;
8001
8002     CreateId;
8003     SetupParameters(BuildWithGlu);
8004     UploadData(Target, BuildWithGlu);
8005     glAreTexturesResident(1, @fID, @fIsResident);
8006   end;
8007 end;
8008
8009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8010 function TglBitmap2D.FlipHorz: Boolean;
8011 var
8012   Col, Row: Integer;
8013   TempDestData, DestData, SourceData: PByte;
8014   ImgSize: Integer;
8015 begin
8016   result := inherited FlipHorz;
8017   if Assigned(Data) then begin
8018     SourceData := Data;
8019     ImgSize := Height * fRowSize;
8020     GetMem(DestData, ImgSize);
8021     try
8022       TempDestData := DestData;
8023       Dec(TempDestData, fRowSize + fPixelSize);
8024       for Row := 0 to Height -1 do begin
8025         Inc(TempDestData, fRowSize * 2);
8026         for Col := 0 to Width -1 do begin
8027           Move(SourceData^, TempDestData^, fPixelSize);
8028           Inc(SourceData, fPixelSize);
8029           Dec(TempDestData, fPixelSize);
8030         end;
8031       end;
8032       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8033       result := true;
8034     except
8035       if Assigned(DestData) then
8036         FreeMem(DestData);
8037       raise;
8038     end;
8039   end;
8040 end;
8041
8042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8043 function TglBitmap2D.FlipVert: Boolean;
8044 var
8045   Row: Integer;
8046   TempDestData, DestData, SourceData: PByte;
8047 begin
8048   result := inherited FlipVert;
8049   if Assigned(Data) then begin
8050     SourceData := Data;
8051     GetMem(DestData, Height * fRowSize);
8052     try
8053       TempDestData := DestData;
8054       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8055       for Row := 0 to Height -1 do begin
8056         Move(SourceData^, TempDestData^, fRowSize);
8057         Dec(TempDestData, fRowSize);
8058         Inc(SourceData, fRowSize);
8059       end;
8060       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8061       result := true;
8062     except
8063       if Assigned(DestData) then
8064         FreeMem(DestData);
8065       raise;
8066     end;
8067   end;
8068 end;
8069
8070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8071 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 type
8074   TMatrixItem = record
8075     X, Y: Integer;
8076     W: Single;
8077   end;
8078
8079   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8080   TglBitmapToNormalMapRec = Record
8081     Scale: Single;
8082     Heights: array of Single;
8083     MatrixU : array of TMatrixItem;
8084     MatrixV : array of TMatrixItem;
8085   end;
8086
8087 const
8088   ONE_OVER_255 = 1 / 255;
8089
8090   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8091 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8092 var
8093   Val: Single;
8094 begin
8095   with FuncRec do begin
8096     Val :=
8097       Source.Data.r * LUMINANCE_WEIGHT_R +
8098       Source.Data.g * LUMINANCE_WEIGHT_G +
8099       Source.Data.b * LUMINANCE_WEIGHT_B;
8100     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8101   end;
8102 end;
8103
8104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8105 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8106 begin
8107   with FuncRec do
8108     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8109 end;
8110
8111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8112 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8113 type
8114   TVec = Array[0..2] of Single;
8115 var
8116   Idx: Integer;
8117   du, dv: Double;
8118   Len: Single;
8119   Vec: TVec;
8120
8121   function GetHeight(X, Y: Integer): Single;
8122   begin
8123     with FuncRec do begin
8124       X := Max(0, Min(Size.X -1, X));
8125       Y := Max(0, Min(Size.Y -1, Y));
8126       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8127     end;
8128   end;
8129
8130 begin
8131   with FuncRec do begin
8132     with PglBitmapToNormalMapRec(Args)^ do begin
8133       du := 0;
8134       for Idx := Low(MatrixU) to High(MatrixU) do
8135         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8136
8137       dv := 0;
8138       for Idx := Low(MatrixU) to High(MatrixU) do
8139         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8140
8141       Vec[0] := -du * Scale;
8142       Vec[1] := -dv * Scale;
8143       Vec[2] := 1;
8144     end;
8145
8146     // Normalize
8147     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8148     if Len <> 0 then begin
8149       Vec[0] := Vec[0] * Len;
8150       Vec[1] := Vec[1] * Len;
8151       Vec[2] := Vec[2] * Len;
8152     end;
8153
8154     // Farbe zuweisem
8155     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8156     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8157     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8158   end;
8159 end;
8160
8161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8162 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8163 var
8164   Rec: TglBitmapToNormalMapRec;
8165
8166   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8167   begin
8168     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8169       Matrix[Index].X := X;
8170       Matrix[Index].Y := Y;
8171       Matrix[Index].W := W;
8172     end;
8173   end;
8174
8175 begin
8176   if TFormatDescriptor.Get(Format).IsCompressed then
8177     raise EglBitmapUnsupportedFormat.Create(Format);
8178
8179   if aScale > 100 then
8180     Rec.Scale := 100
8181   else if aScale < -100 then
8182     Rec.Scale := -100
8183   else
8184     Rec.Scale := aScale;
8185
8186   SetLength(Rec.Heights, Width * Height);
8187   try
8188     case aFunc of
8189       nm4Samples: begin
8190         SetLength(Rec.MatrixU, 2);
8191         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8192         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8193
8194         SetLength(Rec.MatrixV, 2);
8195         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8196         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8197       end;
8198
8199       nmSobel: begin
8200         SetLength(Rec.MatrixU, 6);
8201         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8202         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8203         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8204         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8205         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8206         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8207
8208         SetLength(Rec.MatrixV, 6);
8209         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8210         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8211         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8212         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8213         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8214         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8215       end;
8216
8217       nm3x3: begin
8218         SetLength(Rec.MatrixU, 6);
8219         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8220         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8221         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8222         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8223         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8224         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8225
8226         SetLength(Rec.MatrixV, 6);
8227         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8228         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8229         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8230         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8231         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8232         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8233       end;
8234
8235       nm5x5: begin
8236         SetLength(Rec.MatrixU, 20);
8237         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8238         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8239         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8240         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8241         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8242         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8243         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8244         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8245         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8246         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8247         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8248         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8249         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8250         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8251         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8252         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8253         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8254         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8255         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8256         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8257
8258         SetLength(Rec.MatrixV, 20);
8259         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8260         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8261         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8262         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8263         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8264         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8265         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8266         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8267         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8268         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8269         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8270         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8271         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8272         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8273         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8274         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8275         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8276         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8277         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8278         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8279       end;
8280     end;
8281
8282     // Daten Sammeln
8283     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8284       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8285     else
8286       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8287     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8288   finally
8289     SetLength(Rec.Heights, 0);
8290   end;
8291 end;
8292
8293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8294 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8296 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8297 begin
8298   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8299 end;
8300
8301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8302 procedure TglBitmapCubeMap.AfterConstruction;
8303 begin
8304   inherited;
8305
8306   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8307     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8308
8309   SetWrap;
8310   Target   := GL_TEXTURE_CUBE_MAP;
8311   fGenMode := GL_REFLECTION_MAP;
8312 end;
8313
8314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8315 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8316 var
8317   BuildWithGlu: Boolean;
8318   TexSize: Integer;
8319 begin
8320   if (aTestTextureSize) then begin
8321     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8322
8323     if (Height > TexSize) or (Width > TexSize) then
8324       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8325
8326     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8327       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8328   end;
8329
8330   if (ID = 0) then
8331     CreateID;
8332   SetupParameters(BuildWithGlu);
8333   UploadData(aCubeTarget, BuildWithGlu);
8334 end;
8335
8336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8337 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8338 begin
8339   inherited Bind (aEnableTextureUnit);
8340   if aEnableTexCoordsGen then begin
8341     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8342     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8343     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8344     glEnable(GL_TEXTURE_GEN_S);
8345     glEnable(GL_TEXTURE_GEN_T);
8346     glEnable(GL_TEXTURE_GEN_R);
8347   end;
8348 end;
8349
8350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8351 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8352 begin
8353   inherited Unbind(aDisableTextureUnit);
8354   if aDisableTexCoordsGen then begin
8355     glDisable(GL_TEXTURE_GEN_S);
8356     glDisable(GL_TEXTURE_GEN_T);
8357     glDisable(GL_TEXTURE_GEN_R);
8358   end;
8359 end;
8360
8361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8362 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8364 type
8365   TVec = Array[0..2] of Single;
8366   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8367
8368   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8369   TglBitmapNormalMapRec = record
8370     HalfSize : Integer;
8371     Func: TglBitmapNormalMapGetVectorFunc;
8372   end;
8373
8374   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8375 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8376 begin
8377   aVec[0] := aHalfSize;
8378   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8379   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8380 end;
8381
8382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8383 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8384 begin
8385   aVec[0] := - aHalfSize;
8386   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8387   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8388 end;
8389
8390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8391 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8392 begin
8393   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8394   aVec[1] := aHalfSize;
8395   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8396 end;
8397
8398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8399 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8400 begin
8401   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8402   aVec[1] := - aHalfSize;
8403   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8404 end;
8405
8406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8407 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8408 begin
8409   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8410   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8411   aVec[2] := aHalfSize;
8412 end;
8413
8414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8415 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8416 begin
8417   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8418   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8419   aVec[2] := - aHalfSize;
8420 end;
8421
8422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8423 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8424 var
8425   i: Integer;
8426   Vec: TVec;
8427   Len: Single;
8428 begin
8429   with FuncRec do begin
8430     with PglBitmapNormalMapRec(Args)^ do begin
8431       Func(Vec, Position, HalfSize);
8432
8433       // Normalize
8434       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8435       if Len <> 0 then begin
8436         Vec[0] := Vec[0] * Len;
8437         Vec[1] := Vec[1] * Len;
8438         Vec[2] := Vec[2] * Len;
8439       end;
8440
8441       // Scale Vector and AddVectro
8442       Vec[0] := Vec[0] * 0.5 + 0.5;
8443       Vec[1] := Vec[1] * 0.5 + 0.5;
8444       Vec[2] := Vec[2] * 0.5 + 0.5;
8445     end;
8446
8447     // Set Color
8448     for i := 0 to 2 do
8449       Dest.Data.arr[i] := Round(Vec[i] * 255);
8450   end;
8451 end;
8452
8453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8454 procedure TglBitmapNormalMap.AfterConstruction;
8455 begin
8456   inherited;
8457   fGenMode := GL_NORMAL_MAP;
8458 end;
8459
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8462 var
8463   Rec: TglBitmapNormalMapRec;
8464   SizeRec: TglBitmapPixelPosition;
8465 begin
8466   Rec.HalfSize := aSize div 2;
8467   FreeDataAfterGenTexture := false;
8468
8469   SizeRec.Fields := [ffX, ffY];
8470   SizeRec.X := aSize;
8471   SizeRec.Y := aSize;
8472
8473   // Positive X
8474   Rec.Func := glBitmapNormalMapPosX;
8475   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8476   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8477
8478   // Negative X
8479   Rec.Func := glBitmapNormalMapNegX;
8480   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8481   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8482
8483   // Positive Y
8484   Rec.Func := glBitmapNormalMapPosY;
8485   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8486   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8487
8488   // Negative Y
8489   Rec.Func := glBitmapNormalMapNegY;
8490   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8491   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8492
8493   // Positive Z
8494   Rec.Func := glBitmapNormalMapPosZ;
8495   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8496   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8497
8498   // Negative Z
8499   Rec.Func := glBitmapNormalMapNegZ;
8500   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8501   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8502 end;
8503
8504
8505 initialization
8506   glBitmapSetDefaultFormat (tfEmpty);
8507   glBitmapSetDefaultMipmap (mmMipmap);
8508   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8509   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8510   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8511
8512   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8513   glBitmapSetDefaultDeleteTextureOnFree    (true);
8514
8515   TFormatDescriptor.Init;
8516
8517 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8518   OpenGLInitialized := false;
8519   InitOpenGLCS := TCriticalSection.Create;
8520 {$ENDIF}
8521
8522 finalization
8523   TFormatDescriptor.Finalize;
8524
8525 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8526   FreeAndNil(InitOpenGLCS);
8527 {$ENDIF}
8528
8529 end.
8530