glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        DEFINED(GLB_NATIVE_OGL)} windows,                            {$IFEND}
 447
 448   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 449   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 450   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,                  {$ENDIF}
 451
 452   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 453   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 454   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 455   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 456   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 457
 458   Classes, SysUtils;
 459
 460 {$IFDEF GLB_NATIVE_OGL}
 461 const
 462   GL_TRUE   = 1;
 463   GL_FALSE  = 0;
 464
 465   GL_ZERO = 0;
 466   GL_ONE  = 1;
 467
 468   GL_VERSION    = $1F02;
 469   GL_EXTENSIONS = $1F03;
 470
 471   GL_TEXTURE_1D         = $0DE0;
 472   GL_TEXTURE_2D         = $0DE1;
 473   GL_TEXTURE_RECTANGLE  = $84F5;
 474
 475   GL_NORMAL_MAP                   = $8511;
 476   GL_TEXTURE_CUBE_MAP             = $8513;
 477   GL_REFLECTION_MAP               = $8512;
 478   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 479   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 480   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 481   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 482   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 483   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 484
 485   GL_TEXTURE_WIDTH            = $1000;
 486   GL_TEXTURE_HEIGHT           = $1001;
 487   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 488   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 489
 490   GL_S = $2000;
 491   GL_T = $2001;
 492   GL_R = $2002;
 493   GL_Q = $2003;
 494
 495   GL_TEXTURE_GEN_S = $0C60;
 496   GL_TEXTURE_GEN_T = $0C61;
 497   GL_TEXTURE_GEN_R = $0C62;
 498   GL_TEXTURE_GEN_Q = $0C63;
 499
 500   GL_RED    = $1903;
 501   GL_GREEN  = $1904;
 502   GL_BLUE   = $1905;
 503
 504   GL_ALPHA    = $1906;
 505   GL_ALPHA4   = $803B;
 506   GL_ALPHA8   = $803C;
 507   GL_ALPHA12  = $803D;
 508   GL_ALPHA16  = $803E;
 509
 510   GL_LUMINANCE    = $1909;
 511   GL_LUMINANCE4   = $803F;
 512   GL_LUMINANCE8   = $8040;
 513   GL_LUMINANCE12  = $8041;
 514   GL_LUMINANCE16  = $8042;
 515
 516   GL_LUMINANCE_ALPHA      = $190A;
 517   GL_LUMINANCE4_ALPHA4    = $8043;
 518   GL_LUMINANCE6_ALPHA2    = $8044;
 519   GL_LUMINANCE8_ALPHA8    = $8045;
 520   GL_LUMINANCE12_ALPHA4   = $8046;
 521   GL_LUMINANCE12_ALPHA12  = $8047;
 522   GL_LUMINANCE16_ALPHA16  = $8048;
 523
 524   GL_RGB      = $1907;
 525   GL_BGR      = $80E0;
 526   GL_R3_G3_B2 = $2A10;
 527   GL_RGB4     = $804F;
 528   GL_RGB5     = $8050;
 529   GL_RGB565   = $8D62;
 530   GL_RGB8     = $8051;
 531   GL_RGB10    = $8052;
 532   GL_RGB12    = $8053;
 533   GL_RGB16    = $8054;
 534
 535   GL_RGBA     = $1908;
 536   GL_BGRA     = $80E1;
 537   GL_RGBA2    = $8055;
 538   GL_RGBA4    = $8056;
 539   GL_RGB5_A1  = $8057;
 540   GL_RGBA8    = $8058;
 541   GL_RGB10_A2 = $8059;
 542   GL_RGBA12   = $805A;
 543   GL_RGBA16   = $805B;
 544
 545   GL_DEPTH_COMPONENT    = $1902;
 546   GL_DEPTH_COMPONENT16  = $81A5;
 547   GL_DEPTH_COMPONENT24  = $81A6;
 548   GL_DEPTH_COMPONENT32  = $81A7;
 549
 550   GL_COMPRESSED_RGB                 = $84ED;
 551   GL_COMPRESSED_RGBA                = $84EE;
 552   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 553   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 554   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 555   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 556
 557   GL_UNSIGNED_BYTE            = $1401;
 558   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 559   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 560
 561   GL_UNSIGNED_SHORT             = $1403;
 562   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 563   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 564   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 565   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 566   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 567   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 568
 569   GL_UNSIGNED_INT                 = $1405;
 570   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 571   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 572   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 573   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 574
 575   { Texture Filter }
 576   GL_TEXTURE_MAG_FILTER     = $2800;
 577   GL_TEXTURE_MIN_FILTER     = $2801;
 578   GL_NEAREST                = $2600;
 579   GL_NEAREST_MIPMAP_NEAREST = $2700;
 580   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 581   GL_LINEAR                 = $2601;
 582   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 583   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 584
 585   { Texture Wrap }
 586   GL_TEXTURE_WRAP_S   = $2802;
 587   GL_TEXTURE_WRAP_T   = $2803;
 588   GL_TEXTURE_WRAP_R   = $8072;
 589   GL_CLAMP            = $2900;
 590   GL_REPEAT           = $2901;
 591   GL_CLAMP_TO_EDGE    = $812F;
 592   GL_CLAMP_TO_BORDER  = $812D;
 593   GL_MIRRORED_REPEAT  = $8370;
 594
 595   { Other }
 596   GL_GENERATE_MIPMAP      = $8191;
 597   GL_TEXTURE_BORDER_COLOR = $1004;
 598   GL_MAX_TEXTURE_SIZE     = $0D33;
 599   GL_PACK_ALIGNMENT       = $0D05;
 600   GL_UNPACK_ALIGNMENT     = $0CF5;
 601
 602   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 603   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 604   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 605   GL_TEXTURE_GEN_MODE               = $2500;
 606
 607 {$IF DEFINED(GLB_WIN)}
 608   libglu    = 'glu32.dll';
 609   libopengl = 'opengl32.dll';
 610 {$ELSEIF DEFINED(GLB_LINUX)}
 611   libglu    = 'libGLU.so.1';
 612   libopengl = 'libGL.so.1';
 613 {$IFEND}
 614
 615 type
 616   GLboolean = BYTEBOOL;
 617   GLint     = Integer;
 618   GLsizei   = Integer;
 619   GLuint    = Cardinal;
 620   GLfloat   = Single;
 621   GLenum    = Cardinal;
 622
 623   PGLvoid    = Pointer;
 624   PGLboolean = ^GLboolean;
 625   PGLint     = ^GLint;
 626   PGLuint    = ^GLuint;
 627   PGLfloat   = ^GLfloat;
 628
 629   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 630   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632
 633 {$IF DEFINED(GLB_WIN)}
 634   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 635 {$ELSEIF DEFINED(GLB_LINUX)}
 636   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 637   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 638 {$IFEND}
 639
 640 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 641   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 642   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643
 644   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 645   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646
 647   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 648   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654
 655   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 656   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659
 660   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 661   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663
 664   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 665   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667
 668   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 669   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670
 671 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 672   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 673   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674
 675   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 676   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677
 678   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 679   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685
 686   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 687   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690
 691   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 692   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694
 695   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 696   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698
 699   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 700   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701 {$IFEND}
 702
 703 var
 704   GL_VERSION_1_2,
 705   GL_VERSION_1_3,
 706   GL_VERSION_1_4,
 707   GL_VERSION_2_0,
 708   GL_VERSION_3_3,
 709
 710   GL_SGIS_generate_mipmap,
 711
 712   GL_ARB_texture_border_clamp,
 713   GL_ARB_texture_mirrored_repeat,
 714   GL_ARB_texture_rectangle,
 715   GL_ARB_texture_non_power_of_two,
 716   GL_ARB_texture_swizzle,
 717   GL_ARB_texture_cube_map,
 718
 719   GL_IBM_texture_mirrored_repeat,
 720
 721   GL_NV_texture_rectangle,
 722
 723   GL_EXT_texture_edge_clamp,
 724   GL_EXT_texture_rectangle,
 725   GL_EXT_texture_swizzle,
 726   GL_EXT_texture_cube_map,
 727   GL_EXT_texture_filter_anisotropic: Boolean;
 728
 729   glCompressedTexImage1D: TglCompressedTexImage1D;
 730   glCompressedTexImage2D: TglCompressedTexImage2D;
 731   glGetCompressedTexImage: TglGetCompressedTexImage;
 732
 733 {$IF DEFINED(GLB_WIN)}
 734   wglGetProcAddress: TwglGetProcAddress;
 735 {$ELSEIF DEFINED(GLB_LINUX)}
 736   glXGetProcAddress: TglXGetProcAddress;
 737   glXGetProcAddressARB: TglXGetProcAddress;
 738 {$IFEND}
 739
 740 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 741   glEnable: TglEnable;
 742   glDisable: TglDisable;
 743
 744   glGetString: TglGetString;
 745   glGetIntegerv: TglGetIntegerv;
 746
 747   glTexParameteri: TglTexParameteri;
 748   glTexParameteriv: TglTexParameteriv;
 749   glTexParameterfv: TglTexParameterfv;
 750   glGetTexParameteriv: TglGetTexParameteriv;
 751   glGetTexParameterfv: TglGetTexParameterfv;
 752   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 753   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 754
 755   glTexGeni: TglTexGeni;
 756   glGenTextures: TglGenTextures;
 757   glBindTexture: TglBindTexture;
 758   glDeleteTextures: TglDeleteTextures;
 759
 760   glAreTexturesResident: TglAreTexturesResident;
 761   glReadPixels: TglReadPixels;
 762   glPixelStorei: TglPixelStorei;
 763
 764   glTexImage1D: TglTexImage1D;
 765   glTexImage2D: TglTexImage2D;
 766   glGetTexImage: TglGetTexImage;
 767
 768   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 769   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 770 {$ENDIF}
 771 {$ENDIF}
 772
 773 type
 774 ////////////////////////////////////////////////////////////////////////////////////////////////////
 775   TglBitmapFormat = (
 776     tfEmpty = 0, //must be smallest value!
 777
 778     tfAlpha4,
 779     tfAlpha8,
 780     tfAlpha12,
 781     tfAlpha16,
 782
 783     tfLuminance4,
 784     tfLuminance8,
 785     tfLuminance12,
 786     tfLuminance16,
 787
 788     tfLuminance4Alpha4,
 789     tfLuminance6Alpha2,
 790     tfLuminance8Alpha8,
 791     tfLuminance12Alpha4,
 792     tfLuminance12Alpha12,
 793     tfLuminance16Alpha16,
 794
 795     tfR3G3B2,
 796     tfRGB4,
 797     tfR5G6B5,
 798     tfRGB5,
 799     tfRGB8,
 800     tfRGB10,
 801     tfRGB12,
 802     tfRGB16,
 803
 804     tfRGBA2,
 805     tfRGBA4,
 806     tfRGB5A1,
 807     tfRGBA8,
 808     tfRGB10A2,
 809     tfRGBA12,
 810     tfRGBA16,
 811
 812     tfBGR4,
 813     tfB5G6R5,
 814     tfBGR5,
 815     tfBGR8,
 816     tfBGR10,
 817     tfBGR12,
 818     tfBGR16,
 819
 820     tfBGRA2,
 821     tfBGRA4,
 822     tfBGR5A1,
 823     tfBGRA8,
 824     tfBGR10A2,
 825     tfBGRA12,
 826     tfBGRA16,
 827
 828     tfDepth16,
 829     tfDepth24,
 830     tfDepth32,
 831
 832     tfS3tcDtx1RGBA,
 833     tfS3tcDtx3RGBA,
 834     tfS3tcDtx5RGBA
 835   );
 836
 837   TglBitmapFileType = (
 838      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 839      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 840      ftDDS,
 841      ftTGA,
 842      ftBMP);
 843    TglBitmapFileTypes = set of TglBitmapFileType;
 844
 845    TglBitmapMipMap = (
 846      mmNone,
 847      mmMipmap,
 848      mmMipmapGlu);
 849
 850    TglBitmapNormalMapFunc = (
 851      nm4Samples,
 852      nmSobel,
 853      nm3x3,
 854      nm5x5);
 855
 856  ////////////////////////////////////////////////////////////////////////////////////////////////////
 857    EglBitmap                  = class(Exception);
 858    EglBitmapNotSupported      = class(Exception);
 859    EglBitmapSizeToLarge       = class(EglBitmap);
 860    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 861    EglBitmapUnsupportedFormat = class(EglBitmap)
 862      constructor Create(const aFormat: TglBitmapFormat); overload;
 863      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 864    end;
 865
 866 ////////////////////////////////////////////////////////////////////////////////////////////////////
 867   TglBitmapColorRec = packed record
 868   case Integer of
 869     0: (r, g, b, a: Cardinal);
 870     1: (arr: array[0..3] of Cardinal);
 871   end;
 872
 873   TglBitmapPixelData = packed record
 874     Data, Range: TglBitmapColorRec;
 875     Format: TglBitmapFormat;
 876   end;
 877   PglBitmapPixelData = ^TglBitmapPixelData;
 878
 879 ////////////////////////////////////////////////////////////////////////////////////////////////////
 880   TglBitmapPixelPositionFields = set of (ffX, ffY);
 881   TglBitmapPixelPosition = record
 882     Fields : TglBitmapPixelPositionFields;
 883     X : Word;
 884     Y : Word;
 885   end;
 886
 887   TglBitmapFormatDescriptor = class(TObject)
 888   protected
 889     function GetIsCompressed: Boolean; virtual; abstract;
 890     function GetHasAlpha:     Boolean; virtual; abstract;
 891
 892     function GetglDataFormat:     GLenum;  virtual; abstract;
 893     function GetglFormat:         GLenum;  virtual; abstract;
 894     function GetglInternalFormat: GLenum;  virtual; abstract;
 895   public
 896     property IsCompressed: Boolean read GetIsCompressed;
 897     property HasAlpha:     Boolean read GetHasAlpha;
 898
 899     property glFormat:         GLenum  read GetglFormat;
 900     property glInternalFormat: GLenum  read GetglInternalFormat;
 901     property glDataFormat:     GLenum  read GetglDataFormat;
 902   end;
 903
 904 ////////////////////////////////////////////////////////////////////////////////////////////////////
 905   TglBitmap = class;
 906   TglBitmapFunctionRec = record
 907     Sender:   TglBitmap;
 908     Size:     TglBitmapPixelPosition;
 909     Position: TglBitmapPixelPosition;
 910     Source:   TglBitmapPixelData;
 911     Dest:     TglBitmapPixelData;
 912     Args:     Pointer;
 913   end;
 914   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 915
 916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 917   TglBitmap = class
 918   private
 919     function GetFormatDesc: TglBitmapFormatDescriptor;
 920   protected
 921     fID: GLuint;
 922     fTarget: GLuint;
 923     fAnisotropic: Integer;
 924     fDeleteTextureOnFree: Boolean;
 925     fFreeDataAfterGenTexture: Boolean;
 926     fData: PByte;
 927     fIsResident: Boolean;
 928     fBorderColor: array[0..3] of Single;
 929
 930     fDimension: TglBitmapPixelPosition;
 931     fMipMap: TglBitmapMipMap;
 932     fFormat: TglBitmapFormat;
 933
 934     // Mapping
 935     fPixelSize: Integer;
 936     fRowSize: Integer;
 937
 938     // Filtering
 939     fFilterMin: GLenum;
 940     fFilterMag: GLenum;
 941
 942     // TexturWarp
 943     fWrapS: GLenum;
 944     fWrapT: GLenum;
 945     fWrapR: GLenum;
 946
 947     //Swizzle
 948     fSwizzle: array[0..3] of GLenum;
 949
 950     // CustomData
 951     fFilename: String;
 952     fCustomName: String;
 953     fCustomNameW: WideString;
 954     fCustomData: Pointer;
 955
 956     //Getter
 957     function GetWidth:  Integer; virtual;
 958     function GetHeight: Integer; virtual;
 959
 960     function GetFileWidth:  Integer; virtual;
 961     function GetFileHeight: Integer; virtual;
 962
 963     //Setter
 964     procedure SetCustomData(const aValue: Pointer);
 965     procedure SetCustomName(const aValue: String);
 966     procedure SetCustomNameW(const aValue: WideString);
 967     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 968     procedure SetFormat(const aValue: TglBitmapFormat);
 969     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 970     procedure SetID(const aValue: Cardinal);
 971     procedure SetMipMap(const aValue: TglBitmapMipMap);
 972     procedure SetTarget(const aValue: Cardinal);
 973     procedure SetAnisotropic(const aValue: Integer);
 974
 975     procedure CreateID;
 976     procedure SetupParameters(out aBuildWithGlu: Boolean);
 977     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 978       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 979     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 980
 981     function FlipHorz: Boolean; virtual;
 982     function FlipVert: Boolean; virtual;
 983
 984     property Width:  Integer read GetWidth;
 985     property Height: Integer read GetHeight;
 986
 987     property FileWidth:  Integer read GetFileWidth;
 988     property FileHeight: Integer read GetFileHeight;
 989   public
 990     //Properties
 991     property ID:           Cardinal        read fID          write SetID;
 992     property Target:       Cardinal        read fTarget      write SetTarget;
 993     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 994     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 995     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 996
 997     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
 998
 999     property Filename:    String     read fFilename;
1000     property CustomName:  String     read fCustomName  write SetCustomName;
1001     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1002     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1003
1004     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1005     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1006
1007     property Dimension:  TglBitmapPixelPosition  read fDimension;
1008     property Data:       PByte                   read fData;
1009     property IsResident: Boolean                 read fIsResident;
1010
1011     procedure AfterConstruction; override;
1012     procedure BeforeDestruction; override;
1013
1014     procedure PrepareResType(var aResource: String; var aResType: PChar);
1015
1016     //Load
1017     procedure LoadFromFile(const aFilename: String);
1018     procedure LoadFromStream(const aStream: TStream); virtual;
1019     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1020       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1021     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1022     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1023
1024     //Save
1025     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1026     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1027
1028     //Convert
1029     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1030     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1031       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1032   public
1033     //Alpha & Co
1034     {$IFDEF GLB_SDL}
1035     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1036     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1037     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1038     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1039       const aArgs: Pointer = nil): Boolean;
1040     {$ENDIF}
1041
1042     {$IFDEF GLB_DELPHI}
1043     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1044     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1045     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1046     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1047       const aArgs: Pointer = nil): Boolean;
1048     {$ENDIF}
1049
1050     {$IFDEF GLB_LAZARUS}
1051     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1052     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1053     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1054     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1055       const aArgs: Pointer = nil): Boolean;
1056     {$ENDIF}
1057
1058     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1059       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1060     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1061       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1062
1063     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1064     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1065     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1066     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067
1068     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1069     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1070     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1071
1072     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1073     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1074     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1075
1076     function RemoveAlpha: Boolean; virtual;
1077   public
1078     //Common
1079     function Clone: TglBitmap;
1080     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1081     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1082     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1083     procedure FreeData;
1084
1085     //ColorFill
1086     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1087     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1088     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1089
1090     //TexParameters
1091     procedure SetFilter(const aMin, aMag: GLenum);
1092     procedure SetWrap(
1093       const S: GLenum = GL_CLAMP_TO_EDGE;
1094       const T: GLenum = GL_CLAMP_TO_EDGE;
1095       const R: GLenum = GL_CLAMP_TO_EDGE);
1096     procedure SetSwizzle(const r, g, b, a: GLenum);
1097
1098     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1099     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1100
1101     //Constructors
1102     constructor Create; overload;
1103     constructor Create(const aFileName: String); overload;
1104     constructor Create(const aStream: TStream); overload;
1105     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1106     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1107     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1108     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1109   private
1110     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1111     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1112
1113     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1114     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1115
1116     function LoadBMP(const aStream: TStream): Boolean; virtual;
1117     procedure SaveBMP(const aStream: TStream); virtual;
1118
1119     function LoadTGA(const aStream: TStream): Boolean; virtual;
1120     procedure SaveTGA(const aStream: TStream); virtual;
1121
1122     function LoadDDS(const aStream: TStream): Boolean; virtual;
1123     procedure SaveDDS(const aStream: TStream); virtual;
1124   end;
1125
1126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1127   TglBitmap1D = class(TglBitmap)
1128   protected
1129     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1130       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1131     procedure UploadData(const aBuildWithGlu: Boolean);
1132   public
1133     property Width;
1134     procedure AfterConstruction; override;
1135     function FlipHorz: Boolean; override;
1136     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1137   end;
1138
1139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1140   TglBitmap2D = class(TglBitmap)
1141   protected
1142     fLines: array of PByte;
1143     function GetScanline(const aIndex: Integer): Pointer;
1144     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1145       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1146     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1147   public
1148     property Width;
1149     property Height;
1150     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1151
1152     procedure AfterConstruction; override;
1153
1154     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1155     procedure GetDataFromTexture;
1156     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1157
1158     function FlipHorz: Boolean; override;
1159     function FlipVert: Boolean; override;
1160
1161     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1162       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1163   end;
1164
1165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1166   TglBitmapCubeMap = class(TglBitmap2D)
1167   protected
1168     fGenMode: Integer;
1169     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1170   public
1171     procedure AfterConstruction; override;
1172     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1173     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1174     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1175   end;
1176
1177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1178   TglBitmapNormalMap = class(TglBitmapCubeMap)
1179   public
1180     procedure AfterConstruction; override;
1181     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1182   end;
1183
1184 const
1185   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1186
1187 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1188 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1189 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1190 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1191 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1192 procedure glBitmapSetDefaultWrap(
1193   const S: Cardinal = GL_CLAMP_TO_EDGE;
1194   const T: Cardinal = GL_CLAMP_TO_EDGE;
1195   const R: Cardinal = GL_CLAMP_TO_EDGE);
1196
1197 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1198 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1199 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1200 function glBitmapGetDefaultFormat: TglBitmapFormat;
1201 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1202 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1203
1204 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1205 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1206 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1207
1208 var
1209   glBitmapDefaultDeleteTextureOnFree: Boolean;
1210   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1211   glBitmapDefaultFormat: TglBitmapFormat;
1212   glBitmapDefaultMipmap: TglBitmapMipMap;
1213   glBitmapDefaultFilterMin: Cardinal;
1214   glBitmapDefaultFilterMag: Cardinal;
1215   glBitmapDefaultWrapS: Cardinal;
1216   glBitmapDefaultWrapT: Cardinal;
1217   glBitmapDefaultWrapR: Cardinal;
1218   glDefaultSwizzle: array[0..3] of GLenum;
1219
1220 {$IFDEF GLB_DELPHI}
1221 function CreateGrayPalette: HPALETTE;
1222 {$ENDIF}
1223
1224 implementation
1225
1226 uses
1227   Math, syncobjs, typinfo;
1228
1229 type
1230 {$IFNDEF fpc}
1231   QWord   = System.UInt64;
1232   PQWord  = ^QWord;
1233
1234   PtrInt  = Longint;
1235   PtrUInt = DWord;
1236 {$ENDIF}
1237
1238 ////////////////////////////////////////////////////////////////////////////////////////////////////
1239   TShiftRec = packed record
1240   case Integer of
1241     0: (r, g, b, a: Byte);
1242     1: (arr: array[0..3] of Byte);
1243   end;
1244
1245   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1246   private
1247     function GetRedMask: QWord;
1248     function GetGreenMask: QWord;
1249     function GetBlueMask: QWord;
1250     function GetAlphaMask: QWord;
1251   protected
1252     fFormat: TglBitmapFormat;
1253     fWithAlpha: TglBitmapFormat;
1254     fWithoutAlpha: TglBitmapFormat;
1255     fRGBInverted: TglBitmapFormat;
1256     fUncompressed: TglBitmapFormat;
1257     fPixelSize: Single;
1258     fIsCompressed: Boolean;
1259
1260     fRange: TglBitmapColorRec;
1261     fShift: TShiftRec;
1262
1263     fglFormat:         GLenum;
1264     fglInternalFormat: GLenum;
1265     fglDataFormat:     GLenum;
1266
1267     function GetIsCompressed: Boolean; override;
1268     function GetHasAlpha: Boolean; override;
1269
1270     function GetglFormat: GLenum; override;
1271     function GetglInternalFormat: GLenum; override;
1272     function GetglDataFormat: GLenum; override;
1273
1274     function GetComponents: Integer; virtual;
1275   public
1276     property Format:       TglBitmapFormat read fFormat;
1277     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1278     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1279     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1280     property Components:   Integer         read GetComponents;
1281     property PixelSize:    Single          read fPixelSize;
1282
1283     property Range: TglBitmapColorRec read fRange;
1284     property Shift: TShiftRec         read fShift;
1285
1286     property RedMask:   QWord read GetRedMask;
1287     property GreenMask: QWord read GetGreenMask;
1288     property BlueMask:  QWord read GetBlueMask;
1289     property AlphaMask: QWord read GetAlphaMask;
1290
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1293
1294     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1295     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1296
1297     function CreateMappingData: Pointer; virtual;
1298     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1299
1300     function IsEmpty:  Boolean; virtual;
1301     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1302
1303     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1304
1305     constructor Create; virtual;
1306   public
1307     class procedure Init;
1308     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1309     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1310     class procedure Clear;
1311     class procedure Finalize;
1312   end;
1313   TFormatDescriptorClass = class of TFormatDescriptor;
1314
1315   TfdEmpty = class(TFormatDescriptor);
1316
1317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1318   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1319     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321     constructor Create; override;
1322   end;
1323
1324   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327     constructor Create; override;
1328   end;
1329
1330   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333     constructor Create; override;
1334   end;
1335
1336   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1337     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1338     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1339     constructor Create; override;
1340   end;
1341
1342   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1343     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1344     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1345     constructor Create; override;
1346   end;
1347
1348   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1349     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1350     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1351     constructor Create; override;
1352   end;
1353
1354   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357     constructor Create; override;
1358   end;
1359
1360   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363     constructor Create; override;
1364   end;
1365
1366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1367   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370     constructor Create; override;
1371   end;
1372
1373   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376     constructor Create; override;
1377   end;
1378
1379   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382     constructor Create; override;
1383   end;
1384
1385   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388     constructor Create; override;
1389   end;
1390
1391   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394     constructor Create; override;
1395   end;
1396
1397   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400     constructor Create; override;
1401   end;
1402
1403   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1404     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1405     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1406     constructor Create; override;
1407   end;
1408
1409   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1410     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1411     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1412     constructor Create; override;
1413   end;
1414
1415   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1416     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1417     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1418     constructor Create; override;
1419   end;
1420
1421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1422   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425     constructor Create; override;
1426   end;
1427
1428   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431     constructor Create; override;
1432   end;
1433
1434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1435   TfdAlpha4 = class(TfdAlpha_UB1)
1436     constructor Create; override;
1437   end;
1438
1439   TfdAlpha8 = class(TfdAlpha_UB1)
1440     constructor Create; override;
1441   end;
1442
1443   TfdAlpha12 = class(TfdAlpha_US1)
1444     constructor Create; override;
1445   end;
1446
1447   TfdAlpha16 = class(TfdAlpha_US1)
1448     constructor Create; override;
1449   end;
1450
1451   TfdLuminance4 = class(TfdLuminance_UB1)
1452     constructor Create; override;
1453   end;
1454
1455   TfdLuminance8 = class(TfdLuminance_UB1)
1456     constructor Create; override;
1457   end;
1458
1459   TfdLuminance12 = class(TfdLuminance_US1)
1460     constructor Create; override;
1461   end;
1462
1463   TfdLuminance16 = class(TfdLuminance_US1)
1464     constructor Create; override;
1465   end;
1466
1467   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1468     constructor Create; override;
1469   end;
1470
1471   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1472     constructor Create; override;
1473   end;
1474
1475   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1476     constructor Create; override;
1477   end;
1478
1479   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1480     constructor Create; override;
1481   end;
1482
1483   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1484     constructor Create; override;
1485   end;
1486
1487   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1488     constructor Create; override;
1489   end;
1490
1491   TfdR3G3B2 = class(TfdUniversal_UB1)
1492     constructor Create; override;
1493   end;
1494
1495   TfdRGB4 = class(TfdUniversal_US1)
1496     constructor Create; override;
1497   end;
1498
1499   TfdR5G6B5 = class(TfdUniversal_US1)
1500     constructor Create; override;
1501   end;
1502
1503   TfdRGB5 = class(TfdUniversal_US1)
1504     constructor Create; override;
1505   end;
1506
1507   TfdRGB8 = class(TfdRGB_UB3)
1508     constructor Create; override;
1509   end;
1510
1511   TfdRGB10 = class(TfdUniversal_UI1)
1512     constructor Create; override;
1513   end;
1514
1515   TfdRGB12 = class(TfdRGB_US3)
1516     constructor Create; override;
1517   end;
1518
1519   TfdRGB16 = class(TfdRGB_US3)
1520     constructor Create; override;
1521   end;
1522
1523   TfdRGBA2 = class(TfdRGBA_UB4)
1524     constructor Create; override;
1525   end;
1526
1527   TfdRGBA4 = class(TfdUniversal_US1)
1528     constructor Create; override;
1529   end;
1530
1531   TfdRGB5A1 = class(TfdUniversal_US1)
1532     constructor Create; override;
1533   end;
1534
1535   TfdRGBA8 = class(TfdRGBA_UB4)
1536     constructor Create; override;
1537   end;
1538
1539   TfdRGB10A2 = class(TfdUniversal_UI1)
1540     constructor Create; override;
1541   end;
1542
1543   TfdRGBA12 = class(TfdRGBA_US4)
1544     constructor Create; override;
1545   end;
1546
1547   TfdRGBA16 = class(TfdRGBA_US4)
1548     constructor Create; override;
1549   end;
1550
1551   TfdBGR4 = class(TfdUniversal_US1)
1552     constructor Create; override;
1553   end;
1554
1555   TfdB5G6R5 = class(TfdUniversal_US1)
1556     constructor Create; override;
1557   end;
1558
1559   TfdBGR5 = class(TfdUniversal_US1)
1560     constructor Create; override;
1561   end;
1562
1563   TfdBGR8 = class(TfdBGR_UB3)
1564     constructor Create; override;
1565   end;
1566
1567   TfdBGR10 = class(TfdUniversal_UI1)
1568     constructor Create; override;
1569   end;
1570
1571   TfdBGR12 = class(TfdBGR_US3)
1572     constructor Create; override;
1573   end;
1574
1575   TfdBGR16 = class(TfdBGR_US3)
1576     constructor Create; override;
1577   end;
1578
1579   TfdBGRA2 = class(TfdBGRA_UB4)
1580     constructor Create; override;
1581   end;
1582
1583   TfdBGRA4 = class(TfdUniversal_US1)
1584     constructor Create; override;
1585   end;
1586
1587   TfdBGR5A1 = class(TfdUniversal_US1)
1588     constructor Create; override;
1589   end;
1590
1591   TfdBGRA8 = class(TfdBGRA_UB4)
1592     constructor Create; override;
1593   end;
1594
1595   TfdBGR10A2 = class(TfdUniversal_UI1)
1596     constructor Create; override;
1597   end;
1598
1599   TfdBGRA12 = class(TfdBGRA_US4)
1600     constructor Create; override;
1601   end;
1602
1603   TfdBGRA16 = class(TfdBGRA_US4)
1604     constructor Create; override;
1605   end;
1606
1607   TfdDepth16 = class(TfdDepth_US1)
1608     constructor Create; override;
1609   end;
1610
1611   TfdDepth24 = class(TfdDepth_UI1)
1612     constructor Create; override;
1613   end;
1614
1615   TfdDepth32 = class(TfdDepth_UI1)
1616     constructor Create; override;
1617   end;
1618
1619   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1620     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1621     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1622     constructor Create; override;
1623   end;
1624
1625   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1626     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1627     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1628     constructor Create; override;
1629   end;
1630
1631   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1632     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1633     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1634     constructor Create; override;
1635   end;
1636
1637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1638   TbmpBitfieldFormat = class(TFormatDescriptor)
1639   private
1640     procedure SetRedMask  (const aValue: QWord);
1641     procedure SetGreenMask(const aValue: QWord);
1642     procedure SetBlueMask (const aValue: QWord);
1643     procedure SetAlphaMask(const aValue: QWord);
1644
1645     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1646   public
1647     property RedMask:   QWord read GetRedMask   write SetRedMask;
1648     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1649     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1650     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1651
1652     property PixelSize: Single read fPixelSize write fPixelSize;
1653
1654     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1655     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1656   end;
1657
1658 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1659   TbmpColorTableEnty = packed record
1660     b, g, r, a: Byte;
1661   end;
1662   TbmpColorTable = array of TbmpColorTableEnty;
1663   TbmpColorTableFormat = class(TFormatDescriptor)
1664   private
1665     fColorTable: TbmpColorTable;
1666   public
1667     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1668     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1669     property Range:      TglBitmapColorRec read fRange      write fRange;
1670     property Shift:      TShiftRec         read fShift      write fShift;
1671     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1672
1673     procedure CreateColorTable;
1674
1675     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1676     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1677     destructor Destroy; override;
1678   end;
1679
1680 const
1681   LUMINANCE_WEIGHT_R = 0.30;
1682   LUMINANCE_WEIGHT_G = 0.59;
1683   LUMINANCE_WEIGHT_B = 0.11;
1684
1685   ALPHA_WEIGHT_R = 0.30;
1686   ALPHA_WEIGHT_G = 0.59;
1687   ALPHA_WEIGHT_B = 0.11;
1688
1689   DEPTH_WEIGHT_R = 0.333333333;
1690   DEPTH_WEIGHT_G = 0.333333333;
1691   DEPTH_WEIGHT_B = 0.333333333;
1692
1693   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1694
1695   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1696     TfdEmpty,
1697
1698     TfdAlpha4,
1699     TfdAlpha8,
1700     TfdAlpha12,
1701     TfdAlpha16,
1702
1703     TfdLuminance4,
1704     TfdLuminance8,
1705     TfdLuminance12,
1706     TfdLuminance16,
1707
1708     TfdLuminance4Alpha4,
1709     TfdLuminance6Alpha2,
1710     TfdLuminance8Alpha8,
1711     TfdLuminance12Alpha4,
1712     TfdLuminance12Alpha12,
1713     TfdLuminance16Alpha16,
1714
1715     TfdR3G3B2,
1716     TfdRGB4,
1717     TfdR5G6B5,
1718     TfdRGB5,
1719     TfdRGB8,
1720     TfdRGB10,
1721     TfdRGB12,
1722     TfdRGB16,
1723
1724     TfdRGBA2,
1725     TfdRGBA4,
1726     TfdRGB5A1,
1727     TfdRGBA8,
1728     TfdRGB10A2,
1729     TfdRGBA12,
1730     TfdRGBA16,
1731
1732     TfdBGR4,
1733     TfdB5G6R5,
1734     TfdBGR5,
1735     TfdBGR8,
1736     TfdBGR10,
1737     TfdBGR12,
1738     TfdBGR16,
1739
1740     TfdBGRA2,
1741     TfdBGRA4,
1742     TfdBGR5A1,
1743     TfdBGRA8,
1744     TfdBGR10A2,
1745     TfdBGRA12,
1746     TfdBGRA16,
1747
1748     TfdDepth16,
1749     TfdDepth24,
1750     TfdDepth32,
1751
1752     TfdS3tcDtx1RGBA,
1753     TfdS3tcDtx3RGBA,
1754     TfdS3tcDtx5RGBA
1755   );
1756
1757 var
1758   FormatDescriptorCS: TCriticalSection;
1759   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1760
1761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1762 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1763 begin
1764   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1765 end;
1766
1767 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1768 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1769 begin
1770   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1771 end;
1772
1773 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1775 begin
1776   result.Fields := [];
1777
1778   if X >= 0 then
1779     result.Fields := result.Fields + [ffX];
1780   if Y >= 0 then
1781     result.Fields := result.Fields + [ffY];
1782
1783   result.X := Max(0, X);
1784   result.Y := Max(0, Y);
1785 end;
1786
1787 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1788 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1789 begin
1790   result.r := r;
1791   result.g := g;
1792   result.b := b;
1793   result.a := a;
1794 end;
1795
1796 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1797 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1798 var
1799   i: Integer;
1800 begin
1801   result := false;
1802   for i := 0 to high(r1.arr) do
1803     if (r1.arr[i] <> r2.arr[i]) then
1804       exit;
1805   result := true;
1806 end;
1807
1808 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1809 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1810 begin
1811   result.r := r;
1812   result.g := g;
1813   result.b := b;
1814   result.a := a;
1815 end;
1816
1817 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1818 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1819 begin
1820   result := [];
1821
1822   if (aFormat in [
1823         //4 bbp
1824         tfLuminance4,
1825
1826         //8bpp
1827         tfR3G3B2, tfLuminance8,
1828
1829         //16bpp
1830         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1831         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1832
1833         //24bpp
1834         tfBGR8, tfRGB8,
1835
1836         //32bpp
1837         tfRGB10, tfRGB10A2, tfRGBA8,
1838         tfBGR10, tfBGR10A2, tfBGRA8]) then
1839     result := result + [ftBMP];
1840
1841   if (aFormat in [
1842         //8 bpp
1843         tfLuminance8, tfAlpha8,
1844
1845         //16 bpp
1846         tfLuminance16, tfLuminance8Alpha8,
1847         tfRGB5, tfRGB5A1, tfRGBA4,
1848         tfBGR5, tfBGR5A1, tfBGRA4,
1849
1850         //24 bpp
1851         tfRGB8, tfBGR8,
1852
1853         //32 bpp
1854         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1855     result := result + [ftTGA];
1856
1857   if (aFormat in [
1858         //8 bpp
1859         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1860         tfR3G3B2, tfRGBA2, tfBGRA2,
1861
1862         //16 bpp
1863         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1864         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1865         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1866
1867         //24 bpp
1868         tfRGB8, tfBGR8,
1869
1870         //32 bbp
1871         tfLuminance16Alpha16,
1872         tfRGBA8, tfRGB10A2,
1873         tfBGRA8, tfBGR10A2,
1874
1875         //compressed
1876         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1877     result := result + [ftDDS];
1878
1879   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1880   if aFormat in [
1881       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1882       tfRGB8, tfRGBA8,
1883       tfBGR8, tfBGRA8] then
1884     result := result + [ftPNG];
1885   {$ENDIF}
1886
1887   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1888   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1889     result := result + [ftJPEG];
1890   {$ENDIF}
1891 end;
1892
1893 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1894 function IsPowerOfTwo(aNumber: Integer): Boolean;
1895 begin
1896   while (aNumber and 1) = 0 do
1897     aNumber := aNumber shr 1;
1898   result := aNumber = 1;
1899 end;
1900
1901 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1902 function GetTopMostBit(aBitSet: QWord): Integer;
1903 begin
1904   result := 0;
1905   while aBitSet > 0 do begin
1906     inc(result);
1907     aBitSet := aBitSet shr 1;
1908   end;
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function CountSetBits(aBitSet: QWord): Integer;
1913 begin
1914   result := 0;
1915   while aBitSet > 0 do begin
1916     if (aBitSet and 1) = 1 then
1917       inc(result);
1918     aBitSet := aBitSet shr 1;
1919   end;
1920 end;
1921
1922 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1923 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1924 begin
1925   result := Trunc(
1926     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1927     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1928     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1929 end;
1930
1931 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1932 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1933 begin
1934   result := Trunc(
1935     DEPTH_WEIGHT_R * aPixel.Data.r +
1936     DEPTH_WEIGHT_G * aPixel.Data.g +
1937     DEPTH_WEIGHT_B * aPixel.Data.b);
1938 end;
1939
1940 {$IFDEF GLB_NATIVE_OGL}
1941 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1942 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1943 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1944 var
1945   GL_LibHandle: Pointer = nil;
1946
1947 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1948 begin
1949   if not Assigned(aLibHandle) then
1950     aLibHandle := GL_LibHandle;
1951
1952 {$IF DEFINED(GLB_WIN)}
1953   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1954   if Assigned(result) then
1955     exit;
1956
1957   if Assigned(wglGetProcAddress) then
1958     result := wglGetProcAddress(aProcName);
1959 {$ELSEIF DEFINED(GLB_LINUX)}
1960   if Assigned(glXGetProcAddress) then begin
1961     result := glXGetProcAddress(aProcName);
1962     if Assigned(result) then
1963       exit;
1964   end;
1965
1966   if Assigned(glXGetProcAddressARB) then begin
1967     result := glXGetProcAddressARB(aProcName);
1968     if Assigned(result) then
1969       exit;
1970   end;
1971
1972   result := dlsym(aLibHandle, aProcName);
1973 {$IFEND}
1974   if not Assigned(result) and aRaiseOnErr then
1975     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1976 end;
1977
1978 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1979 var
1980   GLU_LibHandle: Pointer = nil;
1981   OpenGLInitialized: Boolean;
1982   InitOpenGLCS: TCriticalSection;
1983
1984 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1985 procedure glbInitOpenGL;
1986
1987   ////////////////////////////////////////////////////////////////////////////////
1988   function glbLoadLibrary(const aName: PChar): Pointer;
1989   begin
1990     {$IF DEFINED(GLB_WIN)}
1991     result := {%H-}Pointer(LoadLibrary(aName));
1992     {$ELSEIF DEFINED(GLB_LINUX)}
1993     result := dlopen(Name, RTLD_LAZY);
1994     {$ELSE}
1995     result := nil;
1996     {$IFEND}
1997   end;
1998
1999   ////////////////////////////////////////////////////////////////////////////////
2000   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2001   begin
2002     result := false;
2003     if not Assigned(aLibHandle) then
2004       exit;
2005
2006     {$IF DEFINED(GLB_WIN)}
2007     Result := FreeLibrary({%H-}HINST(aLibHandle));
2008     {$ELSEIF DEFINED(GLB_LINUX)}
2009     Result := dlclose(aLibHandle) = 0;
2010     {$IFEND}
2011   end;
2012
2013 begin
2014   if Assigned(GL_LibHandle) then
2015     glbFreeLibrary(GL_LibHandle);
2016
2017   if Assigned(GLU_LibHandle) then
2018     glbFreeLibrary(GLU_LibHandle);
2019
2020   GL_LibHandle := glbLoadLibrary(libopengl);
2021   if not Assigned(GL_LibHandle) then
2022     raise EglBitmap.Create('unable to load library: ' + libopengl);
2023
2024   GLU_LibHandle := glbLoadLibrary(libglu);
2025   if not Assigned(GLU_LibHandle) then
2026     raise EglBitmap.Create('unable to load library: ' + libglu);
2027
2028 {$IF DEFINED(GLB_WIN)}
2029   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2030 {$ELSEIF DEFINED(GLB_LINUX)}
2031   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2032   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2033 {$IFEND}
2034
2035   glEnable := glbGetProcAddress('glEnable');
2036   glDisable := glbGetProcAddress('glDisable');
2037   glGetString := glbGetProcAddress('glGetString');
2038   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2039   glTexParameteri := glbGetProcAddress('glTexParameteri');
2040   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2041   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2042   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2043   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2044   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2045   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2046   glTexGeni := glbGetProcAddress('glTexGeni');
2047   glGenTextures := glbGetProcAddress('glGenTextures');
2048   glBindTexture := glbGetProcAddress('glBindTexture');
2049   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2050   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2051   glReadPixels := glbGetProcAddress('glReadPixels');
2052   glPixelStorei := glbGetProcAddress('glPixelStorei');
2053   glTexImage1D := glbGetProcAddress('glTexImage1D');
2054   glTexImage2D := glbGetProcAddress('glTexImage2D');
2055   glGetTexImage := glbGetProcAddress('glGetTexImage');
2056
2057   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2058   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2059 end;
2060 {$ENDIF}
2061
2062 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2063 procedure glbReadOpenGLExtensions;
2064 var
2065   Buffer: AnsiString;
2066   MajorVersion, MinorVersion: Integer;
2067
2068   ///////////////////////////////////////////////////////////////////////////////////////////
2069   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2070   var
2071     Separator: Integer;
2072   begin
2073     aMinor := 0;
2074     aMajor := 0;
2075
2076     Separator := Pos(AnsiString('.'), aBuffer);
2077     if (Separator > 1) and (Separator < Length(aBuffer)) and
2078        (aBuffer[Separator - 1] in ['0'..'9']) and
2079        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2080
2081       Dec(Separator);
2082       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2083         Dec(Separator);
2084
2085       Delete(aBuffer, 1, Separator);
2086       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2087
2088       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2089         Inc(Separator);
2090
2091       Delete(aBuffer, Separator, 255);
2092       Separator := Pos(AnsiString('.'), aBuffer);
2093
2094       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2095       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2096     end;
2097   end;
2098
2099   ///////////////////////////////////////////////////////////////////////////////////////////
2100   function CheckExtension(const Extension: AnsiString): Boolean;
2101   var
2102     ExtPos: Integer;
2103   begin
2104     ExtPos := Pos(Extension, Buffer);
2105     result := ExtPos > 0;
2106     if result then
2107       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2108   end;
2109
2110   ///////////////////////////////////////////////////////////////////////////////////////////
2111   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2112   begin
2113     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2114   end;
2115
2116 begin
2117 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2118   InitOpenGLCS.Enter;
2119   try
2120     if not OpenGLInitialized then begin
2121       glbInitOpenGL;
2122       OpenGLInitialized := true;
2123     end;
2124   finally
2125     InitOpenGLCS.Leave;
2126   end;
2127 {$ENDIF}
2128
2129   // Version
2130   Buffer := glGetString(GL_VERSION);
2131   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2132
2133   GL_VERSION_1_2 := CheckVersion(1, 2);
2134   GL_VERSION_1_3 := CheckVersion(1, 3);
2135   GL_VERSION_1_4 := CheckVersion(1, 4);
2136   GL_VERSION_2_0 := CheckVersion(2, 0);
2137   GL_VERSION_3_3 := CheckVersion(3, 3);
2138
2139   // Extensions
2140   Buffer := glGetString(GL_EXTENSIONS);
2141   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2142   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2143   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2144   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2145   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2146   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2147   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2148   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2149   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2150   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2151   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2152   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2153   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2154   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2155
2156   if GL_VERSION_1_3 then begin
2157     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2158     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2159     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2160   end else begin
2161     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2162     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2163     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2164   end;
2165 end;
2166 {$ENDIF}
2167
2168 {$IFDEF GLB_SDL_IMAGE}
2169 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2171 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2173 begin
2174   result := TStream(context^.unknown.data1).Seek(offset, whence);
2175 end;
2176
2177 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2178 begin
2179   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2180 end;
2181
2182 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2183 begin
2184   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2185 end;
2186
2187 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2188 begin
2189   result := 0;
2190 end;
2191
2192 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2193 begin
2194   result := SDL_AllocRW;
2195
2196   if result = nil then
2197     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2198
2199   result^.seek := glBitmapRWseek;
2200   result^.read := glBitmapRWread;
2201   result^.write := glBitmapRWwrite;
2202   result^.close := glBitmapRWclose;
2203   result^.unknown.data1 := Stream;
2204 end;
2205 {$ENDIF}
2206
2207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2209 begin
2210   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2211 end;
2212
2213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2214 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2215 begin
2216   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2217 end;
2218
2219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2221 begin
2222   glBitmapDefaultMipmap := aValue;
2223 end;
2224
2225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2226 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2227 begin
2228   glBitmapDefaultFormat := aFormat;
2229 end;
2230
2231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2232 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2233 begin
2234   glBitmapDefaultFilterMin := aMin;
2235   glBitmapDefaultFilterMag := aMag;
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2240 begin
2241   glBitmapDefaultWrapS := S;
2242   glBitmapDefaultWrapT := T;
2243   glBitmapDefaultWrapR := R;
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2248 begin
2249   glDefaultSwizzle[0] := r;
2250   glDefaultSwizzle[1] := g;
2251   glDefaultSwizzle[2] := b;
2252   glDefaultSwizzle[3] := a;
2253 end;
2254
2255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2257 begin
2258   result := glBitmapDefaultDeleteTextureOnFree;
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2263 begin
2264   result := glBitmapDefaultFreeDataAfterGenTextures;
2265 end;
2266
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2269 begin
2270   result := glBitmapDefaultMipmap;
2271 end;
2272
2273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2274 function glBitmapGetDefaultFormat: TglBitmapFormat;
2275 begin
2276   result := glBitmapDefaultFormat;
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2281 begin
2282   aMin := glBitmapDefaultFilterMin;
2283   aMag := glBitmapDefaultFilterMag;
2284 end;
2285
2286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2287 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2288 begin
2289   S := glBitmapDefaultWrapS;
2290   T := glBitmapDefaultWrapT;
2291   R := glBitmapDefaultWrapR;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2296 begin
2297   r := glDefaultSwizzle[0];
2298   g := glDefaultSwizzle[1];
2299   b := glDefaultSwizzle[2];
2300   a := glDefaultSwizzle[3];
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 function TFormatDescriptor.GetRedMask: QWord;
2307 begin
2308   result := fRange.r shl fShift.r;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 function TFormatDescriptor.GetGreenMask: QWord;
2313 begin
2314   result := fRange.g shl fShift.g;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function TFormatDescriptor.GetBlueMask: QWord;
2319 begin
2320   result := fRange.b shl fShift.b;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function TFormatDescriptor.GetAlphaMask: QWord;
2325 begin
2326   result := fRange.a shl fShift.a;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function TFormatDescriptor.GetIsCompressed: Boolean;
2331 begin
2332   result := fIsCompressed;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function TFormatDescriptor.GetHasAlpha: Boolean;
2337 begin
2338   result := (fRange.a > 0);
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 function TFormatDescriptor.GetglFormat: GLenum;
2343 begin
2344   result := fglFormat;
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 function TFormatDescriptor.GetglInternalFormat: GLenum;
2349 begin
2350   result := fglInternalFormat;
2351 end;
2352
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 function TFormatDescriptor.GetglDataFormat: GLenum;
2355 begin
2356   result := fglDataFormat;
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 function TFormatDescriptor.GetComponents: Integer;
2361 var
2362   i: Integer;
2363 begin
2364   result := 0;
2365   for i := 0 to 3 do
2366     if (fRange.arr[i] > 0) then
2367       inc(result);
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2372 var
2373   w, h: Integer;
2374 begin
2375   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2376     w := Max(1, aSize.X);
2377     h := Max(1, aSize.Y);
2378     result := GetSize(w, h);
2379   end else
2380     result := 0;
2381 end;
2382
2383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2384 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2385 begin
2386   result := 0;
2387   if (aWidth <= 0) or (aHeight <= 0) then
2388     exit;
2389   result := Ceil(aWidth * aHeight * fPixelSize);
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 function TFormatDescriptor.CreateMappingData: Pointer;
2394 begin
2395   result := nil;
2396 end;
2397
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2400 begin
2401   //DUMMY
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 function TFormatDescriptor.IsEmpty: Boolean;
2406 begin
2407   result := (fFormat = tfEmpty);
2408 end;
2409
2410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2411 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2412 begin
2413   result := false;
2414   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2415     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2416   if (aRedMask   <> RedMask) then
2417     exit;
2418   if (aGreenMask <> GreenMask) then
2419     exit;
2420   if (aBlueMask  <> BlueMask) then
2421     exit;
2422   if (aAlphaMask <> AlphaMask) then
2423     exit;
2424   result := true;
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2429 begin
2430   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2431   aPixel.Data   := fRange;
2432   aPixel.Range  := fRange;
2433   aPixel.Format := fFormat;
2434 end;
2435
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 constructor TFormatDescriptor.Create;
2438 begin
2439   inherited Create;
2440
2441   fFormat       := tfEmpty;
2442   fWithAlpha    := tfEmpty;
2443   fWithoutAlpha := tfEmpty;
2444   fRGBInverted  := tfEmpty;
2445   fUncompressed := tfEmpty;
2446   fPixelSize    := 0.0;
2447   fIsCompressed := false;
2448
2449   fglFormat         := 0;
2450   fglInternalFormat := 0;
2451   fglDataFormat     := 0;
2452
2453   FillChar(fRange, 0, SizeOf(fRange));
2454   FillChar(fShift, 0, SizeOf(fShift));
2455 end;
2456
2457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2458 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2461 begin
2462   aData^ := aPixel.Data.a;
2463   inc(aData);
2464 end;
2465
2466 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2467 begin
2468   aPixel.Data.r := 0;
2469   aPixel.Data.g := 0;
2470   aPixel.Data.b := 0;
2471   aPixel.Data.a := aData^;
2472   inc(aData);
2473 end;
2474
2475 constructor TfdAlpha_UB1.Create;
2476 begin
2477   inherited Create;
2478   fPixelSize        := 1.0;
2479   fRange.a          := $FF;
2480   fglFormat         := GL_ALPHA;
2481   fglDataFormat     := GL_UNSIGNED_BYTE;
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2487 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2488 begin
2489   aData^ := LuminanceWeight(aPixel);
2490   inc(aData);
2491 end;
2492
2493 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2494 begin
2495   aPixel.Data.r := aData^;
2496   aPixel.Data.g := aData^;
2497   aPixel.Data.b := aData^;
2498   aPixel.Data.a := 0;
2499   inc(aData);
2500 end;
2501
2502 constructor TfdLuminance_UB1.Create;
2503 begin
2504   inherited Create;
2505   fPixelSize        := 1.0;
2506   fRange.r          := $FF;
2507   fRange.g          := $FF;
2508   fRange.b          := $FF;
2509   fglFormat         := GL_LUMINANCE;
2510   fglDataFormat     := GL_UNSIGNED_BYTE;
2511 end;
2512
2513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2514 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2517 var
2518   i: Integer;
2519 begin
2520   aData^ := 0;
2521   for i := 0 to 3 do
2522     if (fRange.arr[i] > 0) then
2523       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2524   inc(aData);
2525 end;
2526
2527 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2528 var
2529   i: Integer;
2530 begin
2531   for i := 0 to 3 do
2532     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2533   inc(aData);
2534 end;
2535
2536 constructor TfdUniversal_UB1.Create;
2537 begin
2538   inherited Create;
2539   fPixelSize := 1.0;
2540 end;
2541
2542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2546 begin
2547   inherited Map(aPixel, aData, aMapData);
2548   aData^ := aPixel.Data.a;
2549   inc(aData);
2550 end;
2551
2552 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2553 begin
2554   inherited Unmap(aData, aPixel, aMapData);
2555   aPixel.Data.a := aData^;
2556   inc(aData);
2557 end;
2558
2559 constructor TfdLuminanceAlpha_UB2.Create;
2560 begin
2561   inherited Create;
2562   fPixelSize        := 2.0;
2563   fRange.a          := $FF;
2564   fShift.a          :=   8;
2565   fglFormat         := GL_LUMINANCE_ALPHA;
2566   fglDataFormat     := GL_UNSIGNED_BYTE;
2567 end;
2568
2569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2573 begin
2574   aData^ := aPixel.Data.r;
2575   inc(aData);
2576   aData^ := aPixel.Data.g;
2577   inc(aData);
2578   aData^ := aPixel.Data.b;
2579   inc(aData);
2580 end;
2581
2582 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2583 begin
2584   aPixel.Data.r := aData^;
2585   inc(aData);
2586   aPixel.Data.g := aData^;
2587   inc(aData);
2588   aPixel.Data.b := aData^;
2589   inc(aData);
2590   aPixel.Data.a := 0;
2591 end;
2592
2593 constructor TfdRGB_UB3.Create;
2594 begin
2595   inherited Create;
2596   fPixelSize        := 3.0;
2597   fRange.r          := $FF;
2598   fRange.g          := $FF;
2599   fRange.b          := $FF;
2600   fShift.r          :=   0;
2601   fShift.g          :=   8;
2602   fShift.b          :=  16;
2603   fglFormat         := GL_RGB;
2604   fglDataFormat     := GL_UNSIGNED_BYTE;
2605 end;
2606
2607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2608 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2611 begin
2612   aData^ := aPixel.Data.b;
2613   inc(aData);
2614   aData^ := aPixel.Data.g;
2615   inc(aData);
2616   aData^ := aPixel.Data.r;
2617   inc(aData);
2618 end;
2619
2620 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2621 begin
2622   aPixel.Data.b := aData^;
2623   inc(aData);
2624   aPixel.Data.g := aData^;
2625   inc(aData);
2626   aPixel.Data.r := aData^;
2627   inc(aData);
2628   aPixel.Data.a := 0;
2629 end;
2630
2631 constructor TfdBGR_UB3.Create;
2632 begin
2633   fPixelSize        := 3.0;
2634   fRange.r          := $FF;
2635   fRange.g          := $FF;
2636   fRange.b          := $FF;
2637   fShift.r          :=  16;
2638   fShift.g          :=   8;
2639   fShift.b          :=   0;
2640   fglFormat         := GL_BGR;
2641   fglDataFormat     := GL_UNSIGNED_BYTE;
2642 end;
2643
2644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2648 begin
2649   inherited Map(aPixel, aData, aMapData);
2650   aData^ := aPixel.Data.a;
2651   inc(aData);
2652 end;
2653
2654 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2655 begin
2656   inherited Unmap(aData, aPixel, aMapData);
2657   aPixel.Data.a := aData^;
2658   inc(aData);
2659 end;
2660
2661 constructor TfdRGBA_UB4.Create;
2662 begin
2663   inherited Create;
2664   fPixelSize        := 4.0;
2665   fRange.a          := $FF;
2666   fShift.a          :=  24;
2667   fglFormat         := GL_RGBA;
2668   fglDataFormat     := GL_UNSIGNED_BYTE;
2669 end;
2670
2671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2675 begin
2676   inherited Map(aPixel, aData, aMapData);
2677   aData^ := aPixel.Data.a;
2678   inc(aData);
2679 end;
2680
2681 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2682 begin
2683   inherited Unmap(aData, aPixel, aMapData);
2684   aPixel.Data.a := aData^;
2685   inc(aData);
2686 end;
2687
2688 constructor TfdBGRA_UB4.Create;
2689 begin
2690   inherited Create;
2691   fPixelSize        := 4.0;
2692   fRange.a          := $FF;
2693   fShift.a          :=  24;
2694   fglFormat         := GL_BGRA;
2695   fglDataFormat     := GL_UNSIGNED_BYTE;
2696 end;
2697
2698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2701 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2702 begin
2703   PWord(aData)^ := aPixel.Data.a;
2704   inc(aData, 2);
2705 end;
2706
2707 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2708 begin
2709   aPixel.Data.r := 0;
2710   aPixel.Data.g := 0;
2711   aPixel.Data.b := 0;
2712   aPixel.Data.a := PWord(aData)^;
2713   inc(aData, 2);
2714 end;
2715
2716 constructor TfdAlpha_US1.Create;
2717 begin
2718   inherited Create;
2719   fPixelSize        := 2.0;
2720   fRange.a          := $FFFF;
2721   fglFormat         := GL_ALPHA;
2722   fglDataFormat     := GL_UNSIGNED_SHORT;
2723 end;
2724
2725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2728 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2729 begin
2730   PWord(aData)^ := LuminanceWeight(aPixel);
2731   inc(aData, 2);
2732 end;
2733
2734 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2735 begin
2736   aPixel.Data.r := PWord(aData)^;
2737   aPixel.Data.g := PWord(aData)^;
2738   aPixel.Data.b := PWord(aData)^;
2739   aPixel.Data.a := 0;
2740   inc(aData, 2);
2741 end;
2742
2743 constructor TfdLuminance_US1.Create;
2744 begin
2745   inherited Create;
2746   fPixelSize        := 2.0;
2747   fRange.r          := $FFFF;
2748   fRange.g          := $FFFF;
2749   fRange.b          := $FFFF;
2750   fglFormat         := GL_LUMINANCE;
2751   fglDataFormat     := GL_UNSIGNED_SHORT;
2752 end;
2753
2754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2755 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2758 var
2759   i: Integer;
2760 begin
2761   PWord(aData)^ := 0;
2762   for i := 0 to 3 do
2763     if (fRange.arr[i] > 0) then
2764       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2765   inc(aData, 2);
2766 end;
2767
2768 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2769 var
2770   i: Integer;
2771 begin
2772   for i := 0 to 3 do
2773     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2774   inc(aData, 2);
2775 end;
2776
2777 constructor TfdUniversal_US1.Create;
2778 begin
2779   inherited Create;
2780   fPixelSize := 2.0;
2781 end;
2782
2783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2784 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2787 begin
2788   PWord(aData)^ := DepthWeight(aPixel);
2789   inc(aData, 2);
2790 end;
2791
2792 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2793 begin
2794   aPixel.Data.r := PWord(aData)^;
2795   aPixel.Data.g := PWord(aData)^;
2796   aPixel.Data.b := PWord(aData)^;
2797   aPixel.Data.a := 0;
2798   inc(aData, 2);
2799 end;
2800
2801 constructor TfdDepth_US1.Create;
2802 begin
2803   inherited Create;
2804   fPixelSize        := 2.0;
2805   fRange.r          := $FFFF;
2806   fRange.g          := $FFFF;
2807   fRange.b          := $FFFF;
2808   fglFormat         := GL_DEPTH_COMPONENT;
2809   fglDataFormat     := GL_UNSIGNED_SHORT;
2810 end;
2811
2812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2813 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2816 begin
2817   inherited Map(aPixel, aData, aMapData);
2818   PWord(aData)^ := aPixel.Data.a;
2819   inc(aData, 2);
2820 end;
2821
2822 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2823 begin
2824   inherited Unmap(aData, aPixel, aMapData);
2825   aPixel.Data.a := PWord(aData)^;
2826   inc(aData, 2);
2827 end;
2828
2829 constructor TfdLuminanceAlpha_US2.Create;
2830 begin
2831   inherited Create;
2832   fPixelSize        :=   4.0;
2833   fRange.a          := $FFFF;
2834   fShift.a          :=    16;
2835   fglFormat         := GL_LUMINANCE_ALPHA;
2836   fglDataFormat     := GL_UNSIGNED_SHORT;
2837 end;
2838
2839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2840 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2843 begin
2844   PWord(aData)^ := aPixel.Data.r;
2845   inc(aData, 2);
2846   PWord(aData)^ := aPixel.Data.g;
2847   inc(aData, 2);
2848   PWord(aData)^ := aPixel.Data.b;
2849   inc(aData, 2);
2850 end;
2851
2852 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2853 begin
2854   aPixel.Data.r := PWord(aData)^;
2855   inc(aData, 2);
2856   aPixel.Data.g := PWord(aData)^;
2857   inc(aData, 2);
2858   aPixel.Data.b := PWord(aData)^;
2859   inc(aData, 2);
2860   aPixel.Data.a := 0;
2861 end;
2862
2863 constructor TfdRGB_US3.Create;
2864 begin
2865   inherited Create;
2866   fPixelSize        :=   6.0;
2867   fRange.r          := $FFFF;
2868   fRange.g          := $FFFF;
2869   fRange.b          := $FFFF;
2870   fShift.r          :=     0;
2871   fShift.g          :=    16;
2872   fShift.b          :=    32;
2873   fglFormat         := GL_RGB;
2874   fglDataFormat     := GL_UNSIGNED_SHORT;
2875 end;
2876
2877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2878 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2881 begin
2882   PWord(aData)^ := aPixel.Data.b;
2883   inc(aData, 2);
2884   PWord(aData)^ := aPixel.Data.g;
2885   inc(aData, 2);
2886   PWord(aData)^ := aPixel.Data.r;
2887   inc(aData, 2);
2888 end;
2889
2890 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2891 begin
2892   aPixel.Data.b := PWord(aData)^;
2893   inc(aData, 2);
2894   aPixel.Data.g := PWord(aData)^;
2895   inc(aData, 2);
2896   aPixel.Data.r := PWord(aData)^;
2897   inc(aData, 2);
2898   aPixel.Data.a := 0;
2899 end;
2900
2901 constructor TfdBGR_US3.Create;
2902 begin
2903   inherited Create;
2904   fPixelSize        :=   6.0;
2905   fRange.r          := $FFFF;
2906   fRange.g          := $FFFF;
2907   fRange.b          := $FFFF;
2908   fShift.r          :=    32;
2909   fShift.g          :=    16;
2910   fShift.b          :=     0;
2911   fglFormat         := GL_BGR;
2912   fglDataFormat     := GL_UNSIGNED_SHORT;
2913 end;
2914
2915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2916 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2919 begin
2920   inherited Map(aPixel, aData, aMapData);
2921   PWord(aData)^ := aPixel.Data.a;
2922   inc(aData, 2);
2923 end;
2924
2925 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2926 begin
2927   inherited Unmap(aData, aPixel, aMapData);
2928   aPixel.Data.a := PWord(aData)^;
2929   inc(aData, 2);
2930 end;
2931
2932 constructor TfdRGBA_US4.Create;
2933 begin
2934   inherited Create;
2935   fPixelSize        :=   8.0;
2936   fRange.a          := $FFFF;
2937   fShift.a          :=    48;
2938   fglFormat         := GL_RGBA;
2939   fglDataFormat     := GL_UNSIGNED_SHORT;
2940 end;
2941
2942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2943 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2945 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2946 begin
2947   inherited Map(aPixel, aData, aMapData);
2948   PWord(aData)^ := aPixel.Data.a;
2949   inc(aData, 2);
2950 end;
2951
2952 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2953 begin
2954   inherited Unmap(aData, aPixel, aMapData);
2955   aPixel.Data.a := PWord(aData)^;
2956   inc(aData, 2);
2957 end;
2958
2959 constructor TfdBGRA_US4.Create;
2960 begin
2961   inherited Create;
2962   fPixelSize        :=   8.0;
2963   fRange.a          := $FFFF;
2964   fShift.a          :=    48;
2965   fglFormat         := GL_BGRA;
2966   fglDataFormat     := GL_UNSIGNED_SHORT;
2967 end;
2968
2969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2970 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2972 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2973 var
2974   i: Integer;
2975 begin
2976   PCardinal(aData)^ := 0;
2977   for i := 0 to 3 do
2978     if (fRange.arr[i] > 0) then
2979       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2980   inc(aData, 4);
2981 end;
2982
2983 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2984 var
2985   i: Integer;
2986 begin
2987   for i := 0 to 3 do
2988     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2989   inc(aData, 2);
2990 end;
2991
2992 constructor TfdUniversal_UI1.Create;
2993 begin
2994   inherited Create;
2995   fPixelSize := 4.0;
2996 end;
2997
2998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2999 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3002 begin
3003   PCardinal(aData)^ := DepthWeight(aPixel);
3004   inc(aData, 4);
3005 end;
3006
3007 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3008 begin
3009   aPixel.Data.r := PCardinal(aData)^;
3010   aPixel.Data.g := PCardinal(aData)^;
3011   aPixel.Data.b := PCardinal(aData)^;
3012   aPixel.Data.a := 0;
3013   inc(aData, 4);
3014 end;
3015
3016 constructor TfdDepth_UI1.Create;
3017 begin
3018   inherited Create;
3019   fPixelSize        := 4.0;
3020   fRange.r          := $FFFFFFFF;
3021   fRange.g          := $FFFFFFFF;
3022   fRange.b          := $FFFFFFFF;
3023   fglFormat         := GL_DEPTH_COMPONENT;
3024   fglDataFormat     := GL_UNSIGNED_INT;
3025 end;
3026
3027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3030 constructor TfdAlpha4.Create;
3031 begin
3032   inherited Create;
3033   fFormat           := tfAlpha4;
3034   fWithAlpha        := tfAlpha4;
3035   fglInternalFormat := GL_ALPHA4;
3036 end;
3037
3038 constructor TfdAlpha8.Create;
3039 begin
3040   inherited Create;
3041   fFormat           := tfAlpha8;
3042   fWithAlpha        := tfAlpha8;
3043   fglInternalFormat := GL_ALPHA8;
3044 end;
3045
3046 constructor TfdAlpha12.Create;
3047 begin
3048   inherited Create;
3049   fFormat           := tfAlpha12;
3050   fWithAlpha        := tfAlpha12;
3051   fglInternalFormat := GL_ALPHA12;
3052 end;
3053
3054 constructor TfdAlpha16.Create;
3055 begin
3056   inherited Create;
3057   fFormat           := tfAlpha16;
3058   fWithAlpha        := tfAlpha16;
3059   fglInternalFormat := GL_ALPHA16;
3060 end;
3061
3062 constructor TfdLuminance4.Create;
3063 begin
3064   inherited Create;
3065   fFormat           := tfLuminance4;
3066   fWithAlpha        := tfLuminance4Alpha4;
3067   fWithoutAlpha     := tfLuminance4;
3068   fglInternalFormat := GL_LUMINANCE4;
3069 end;
3070
3071 constructor TfdLuminance8.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfLuminance8;
3075   fWithAlpha        := tfLuminance8Alpha8;
3076   fWithoutAlpha     := tfLuminance8;
3077   fglInternalFormat := GL_LUMINANCE8;
3078 end;
3079
3080 constructor TfdLuminance12.Create;
3081 begin
3082   inherited Create;
3083   fFormat           := tfLuminance12;
3084   fWithAlpha        := tfLuminance12Alpha12;
3085   fWithoutAlpha     := tfLuminance12;
3086   fglInternalFormat := GL_LUMINANCE12;
3087 end;
3088
3089 constructor TfdLuminance16.Create;
3090 begin
3091   inherited Create;
3092   fFormat           := tfLuminance16;
3093   fWithAlpha        := tfLuminance16Alpha16;
3094   fWithoutAlpha     := tfLuminance16;
3095   fglInternalFormat := GL_LUMINANCE16;
3096 end;
3097
3098 constructor TfdLuminance4Alpha4.Create;
3099 begin
3100   inherited Create;
3101   fFormat           := tfLuminance4Alpha4;
3102   fWithAlpha        := tfLuminance4Alpha4;
3103   fWithoutAlpha     := tfLuminance4;
3104   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3105 end;
3106
3107 constructor TfdLuminance6Alpha2.Create;
3108 begin
3109   inherited Create;
3110   fFormat           := tfLuminance6Alpha2;
3111   fWithAlpha        := tfLuminance6Alpha2;
3112   fWithoutAlpha     := tfLuminance8;
3113   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3114 end;
3115
3116 constructor TfdLuminance8Alpha8.Create;
3117 begin
3118   inherited Create;
3119   fFormat           := tfLuminance8Alpha8;
3120   fWithAlpha        := tfLuminance8Alpha8;
3121   fWithoutAlpha     := tfLuminance8;
3122   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3123 end;
3124
3125 constructor TfdLuminance12Alpha4.Create;
3126 begin
3127   inherited Create;
3128   fFormat           := tfLuminance12Alpha4;
3129   fWithAlpha        := tfLuminance12Alpha4;
3130   fWithoutAlpha     := tfLuminance12;
3131   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3132 end;
3133
3134 constructor TfdLuminance12Alpha12.Create;
3135 begin
3136   inherited Create;
3137   fFormat           := tfLuminance12Alpha12;
3138   fWithAlpha        := tfLuminance12Alpha12;
3139   fWithoutAlpha     := tfLuminance12;
3140   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3141 end;
3142
3143 constructor TfdLuminance16Alpha16.Create;
3144 begin
3145   inherited Create;
3146   fFormat           := tfLuminance16Alpha16;
3147   fWithAlpha        := tfLuminance16Alpha16;
3148   fWithoutAlpha     := tfLuminance16;
3149   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3150 end;
3151
3152 constructor TfdR3G3B2.Create;
3153 begin
3154   inherited Create;
3155   fFormat           := tfR3G3B2;
3156   fWithAlpha        := tfRGBA2;
3157   fWithoutAlpha     := tfR3G3B2;
3158   fRange.r          := $7;
3159   fRange.g          := $7;
3160   fRange.b          := $3;
3161   fShift.r          :=  0;
3162   fShift.g          :=  3;
3163   fShift.b          :=  6;
3164   fglFormat         := GL_RGB;
3165   fglInternalFormat := GL_R3_G3_B2;
3166   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3167 end;
3168
3169 constructor TfdRGB4.Create;
3170 begin
3171   inherited Create;
3172   fFormat           := tfRGB4;
3173   fWithAlpha        := tfRGBA4;
3174   fWithoutAlpha     := tfRGB4;
3175   fRGBInverted      := tfBGR4;
3176   fRange.r          := $F;
3177   fRange.g          := $F;
3178   fRange.b          := $F;
3179   fShift.r          :=  0;
3180   fShift.g          :=  4;
3181   fShift.b          :=  8;
3182   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3183   fglInternalFormat := GL_RGB4;
3184   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3185 end;
3186
3187 constructor TfdR5G6B5.Create;
3188 begin
3189   inherited Create;
3190   fFormat           := tfR5G6B5;
3191   fWithAlpha        := tfRGBA4;
3192   fWithoutAlpha     := tfR5G6B5;
3193   fRGBInverted      := tfB5G6R5;
3194   fRange.r          := $1F;
3195   fRange.g          := $3F;
3196   fRange.b          := $1F;
3197   fShift.r          :=   0;
3198   fShift.g          :=   5;
3199   fShift.b          :=  11;
3200   fglFormat         := GL_RGB;
3201   fglInternalFormat := GL_RGB565;
3202   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3203 end;
3204
3205 constructor TfdRGB5.Create;
3206 begin
3207   inherited Create;
3208   fFormat           := tfRGB5;
3209   fWithAlpha        := tfRGB5A1;
3210   fWithoutAlpha     := tfRGB5;
3211   fRGBInverted      := tfBGR5;
3212   fRange.r          := $1F;
3213   fRange.g          := $1F;
3214   fRange.b          := $1F;
3215   fShift.r          :=   0;
3216   fShift.g          :=   5;
3217   fShift.b          :=  10;
3218   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3219   fglInternalFormat := GL_RGB5;
3220   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3221 end;
3222
3223 constructor TfdRGB8.Create;
3224 begin
3225   inherited Create;
3226   fFormat           := tfRGB8;
3227   fWithAlpha        := tfRGBA8;
3228   fWithoutAlpha     := tfRGB8;
3229   fRGBInverted      := tfBGR8;
3230   fglInternalFormat := GL_RGB8;
3231 end;
3232
3233 constructor TfdRGB10.Create;
3234 begin
3235   inherited Create;
3236   fFormat           := tfRGB10;
3237   fWithAlpha        := tfRGB10A2;
3238   fWithoutAlpha     := tfRGB10;
3239   fRGBInverted      := tfBGR10;
3240   fRange.r          := $3FF;
3241   fRange.g          := $3FF;
3242   fRange.b          := $3FF;
3243   fShift.r          :=    0;
3244   fShift.g          :=   10;
3245   fShift.b          :=   20;
3246   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3247   fglInternalFormat := GL_RGB10;
3248   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3249 end;
3250
3251 constructor TfdRGB12.Create;
3252 begin
3253   inherited Create;
3254   fFormat           := tfRGB12;
3255   fWithAlpha        := tfRGBA12;
3256   fWithoutAlpha     := tfRGB12;
3257   fRGBInverted      := tfBGR12;
3258   fglInternalFormat := GL_RGB12;
3259 end;
3260
3261 constructor TfdRGB16.Create;
3262 begin
3263   inherited Create;
3264   fFormat           := tfRGB16;
3265   fWithAlpha        := tfRGBA16;
3266   fWithoutAlpha     := tfRGB16;
3267   fRGBInverted      := tfBGR16;
3268   fglInternalFormat := GL_RGB16;
3269 end;
3270
3271 constructor TfdRGBA2.Create;
3272 begin
3273   inherited Create;
3274   fFormat           := tfRGBA2;
3275   fWithAlpha        := tfRGBA2;
3276   fWithoutAlpha     := tfR3G3B2;
3277   fRGBInverted      := tfBGRA2;
3278   fglInternalFormat := GL_RGBA2;
3279 end;
3280
3281 constructor TfdRGBA4.Create;
3282 begin
3283   inherited Create;
3284   fFormat           := tfRGBA4;
3285   fWithAlpha        := tfRGBA4;
3286   fWithoutAlpha     := tfRGB4;
3287   fRGBInverted      := tfBGRA4;
3288   fRange.r          := $F;
3289   fRange.g          := $F;
3290   fRange.b          := $F;
3291   fRange.a          := $F;
3292   fShift.r          :=  0;
3293   fShift.g          :=  4;
3294   fShift.b          :=  8;
3295   fShift.a          := 12;
3296   fglFormat         := GL_RGBA;
3297   fglInternalFormat := GL_RGBA4;
3298   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3299 end;
3300
3301 constructor TfdRGB5A1.Create;
3302 begin
3303   inherited Create;
3304   fFormat           := tfRGB5A1;
3305   fWithAlpha        := tfRGB5A1;
3306   fWithoutAlpha     := tfRGB5;
3307   fRGBInverted      := tfBGR5A1;
3308   fRange.r          := $1F;
3309   fRange.g          := $1F;
3310   fRange.b          := $1F;
3311   fRange.a          := $01;
3312   fShift.r          :=   0;
3313   fShift.g          :=   5;
3314   fShift.b          :=  10;
3315   fShift.a          :=  15;
3316   fglFormat         := GL_RGBA;
3317   fglInternalFormat := GL_RGB5_A1;
3318   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3319 end;
3320
3321 constructor TfdRGBA8.Create;
3322 begin
3323   inherited Create;
3324   fFormat           := tfRGBA8;
3325   fWithAlpha        := tfRGBA8;
3326   fWithoutAlpha     := tfRGB8;
3327   fRGBInverted      := tfBGRA8;
3328   fglInternalFormat := GL_RGBA8;
3329 end;
3330
3331 constructor TfdRGB10A2.Create;
3332 begin
3333   inherited Create;
3334   fFormat           := tfRGB10A2;
3335   fWithAlpha        := tfRGB10A2;
3336   fWithoutAlpha     := tfRGB10;
3337   fRGBInverted      := tfBGR10A2;
3338   fRange.r          := $3FF;
3339   fRange.g          := $3FF;
3340   fRange.b          := $3FF;
3341   fRange.a          := $003;
3342   fShift.r          :=    0;
3343   fShift.g          :=   10;
3344   fShift.b          :=   20;
3345   fShift.a          :=   30;
3346   fglFormat         := GL_RGBA;
3347   fglInternalFormat := GL_RGB10_A2;
3348   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3349 end;
3350
3351 constructor TfdRGBA12.Create;
3352 begin
3353   inherited Create;
3354   fFormat           := tfRGBA12;
3355   fWithAlpha        := tfRGBA12;
3356   fWithoutAlpha     := tfRGB12;
3357   fRGBInverted      := tfBGRA12;
3358   fglInternalFormat := GL_RGBA12;
3359 end;
3360
3361 constructor TfdRGBA16.Create;
3362 begin
3363   inherited Create;
3364   fFormat           := tfRGBA16;
3365   fWithAlpha        := tfRGBA16;
3366   fWithoutAlpha     := tfRGB16;
3367   fRGBInverted      := tfBGRA16;
3368   fglInternalFormat := GL_RGBA16;
3369 end;
3370
3371 constructor TfdBGR4.Create;
3372 begin
3373   inherited Create;
3374   fPixelSize        := 2.0;
3375   fFormat           := tfBGR4;
3376   fWithAlpha        := tfBGRA4;
3377   fWithoutAlpha     := tfBGR4;
3378   fRGBInverted      := tfRGB4;
3379   fRange.r          := $F;
3380   fRange.g          := $F;
3381   fRange.b          := $F;
3382   fRange.a          := $0;
3383   fShift.r          :=  8;
3384   fShift.g          :=  4;
3385   fShift.b          :=  0;
3386   fShift.a          :=  0;
3387   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3388   fglInternalFormat := GL_RGB4;
3389   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3390 end;
3391
3392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3395 constructor TfdB5G6R5.Create;
3396 begin
3397   inherited Create;
3398   fFormat           := tfB5G6R5;
3399   fWithAlpha        := tfBGRA4;
3400   fWithoutAlpha     := tfB5G6R5;
3401   fRGBInverted      := tfR5G6B5;
3402   fRange.r          := $1F;
3403   fRange.g          := $3F;
3404   fRange.b          := $1F;
3405   fShift.r          :=  11;
3406   fShift.g          :=   5;
3407   fShift.b          :=   0;
3408   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3409   fglInternalFormat := GL_RGB8;
3410   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3411 end;
3412
3413 constructor TfdBGR5.Create;
3414 begin
3415   inherited Create;
3416   fPixelSize        := 2.0;
3417   fFormat           := tfBGR5;
3418   fWithAlpha        := tfBGR5A1;
3419   fWithoutAlpha     := tfBGR5;
3420   fRGBInverted      := tfRGB5;
3421   fRange.r          := $1F;
3422   fRange.g          := $1F;
3423   fRange.b          := $1F;
3424   fRange.a          := $00;
3425   fShift.r          :=  10;
3426   fShift.g          :=   5;
3427   fShift.b          :=   0;
3428   fShift.a          :=   0;
3429   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3430   fglInternalFormat := GL_RGB5;
3431   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3432 end;
3433
3434 constructor TfdBGR8.Create;
3435 begin
3436   inherited Create;
3437   fFormat           := tfBGR8;
3438   fWithAlpha        := tfBGRA8;
3439   fWithoutAlpha     := tfBGR8;
3440   fRGBInverted      := tfRGB8;
3441   fglInternalFormat := GL_RGB8;
3442 end;
3443
3444 constructor TfdBGR10.Create;
3445 begin
3446   inherited Create;
3447   fFormat           := tfBGR10;
3448   fWithAlpha        := tfBGR10A2;
3449   fWithoutAlpha     := tfBGR10;
3450   fRGBInverted      := tfRGB10;
3451   fRange.r          := $3FF;
3452   fRange.g          := $3FF;
3453   fRange.b          := $3FF;
3454   fRange.a          := $000;
3455   fShift.r          :=   20;
3456   fShift.g          :=   10;
3457   fShift.b          :=    0;
3458   fShift.a          :=    0;
3459   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3460   fglInternalFormat := GL_RGB10;
3461   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3462 end;
3463
3464 constructor TfdBGR12.Create;
3465 begin
3466   inherited Create;
3467   fFormat           := tfBGR12;
3468   fWithAlpha        := tfBGRA12;
3469   fWithoutAlpha     := tfBGR12;
3470   fRGBInverted      := tfRGB12;
3471   fglInternalFormat := GL_RGB12;
3472 end;
3473
3474 constructor TfdBGR16.Create;
3475 begin
3476   inherited Create;
3477   fFormat           := tfBGR16;
3478   fWithAlpha        := tfBGRA16;
3479   fWithoutAlpha     := tfBGR16;
3480   fRGBInverted      := tfRGB16;
3481   fglInternalFormat := GL_RGB16;
3482 end;
3483
3484 constructor TfdBGRA2.Create;
3485 begin
3486   inherited Create;
3487   fFormat           := tfBGRA2;
3488   fWithAlpha        := tfBGRA4;
3489   fWithoutAlpha     := tfBGR4;
3490   fRGBInverted      := tfRGBA2;
3491   fglInternalFormat := GL_RGBA2;
3492 end;
3493
3494 constructor TfdBGRA4.Create;
3495 begin
3496   inherited Create;
3497   fFormat           := tfBGRA4;
3498   fWithAlpha        := tfBGRA4;
3499   fWithoutAlpha     := tfBGR4;
3500   fRGBInverted      := tfRGBA4;
3501   fRange.r          := $F;
3502   fRange.g          := $F;
3503   fRange.b          := $F;
3504   fRange.a          := $F;
3505   fShift.r          :=  8;
3506   fShift.g          :=  4;
3507   fShift.b          :=  0;
3508   fShift.a          := 12;
3509   fglFormat         := GL_BGRA;
3510   fglInternalFormat := GL_RGBA4;
3511   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3512 end;
3513
3514 constructor TfdBGR5A1.Create;
3515 begin
3516   inherited Create;
3517   fFormat           := tfBGR5A1;
3518   fWithAlpha        := tfBGR5A1;
3519   fWithoutAlpha     := tfBGR5;
3520   fRGBInverted      := tfRGB5A1;
3521   fRange.r          := $1F;
3522   fRange.g          := $1F;
3523   fRange.b          := $1F;
3524   fRange.a          := $01;
3525   fShift.r          :=  10;
3526   fShift.g          :=   5;
3527   fShift.b          :=   0;
3528   fShift.a          :=  15;
3529   fglFormat         := GL_BGRA;
3530   fglInternalFormat := GL_RGB5_A1;
3531   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3532 end;
3533
3534 constructor TfdBGRA8.Create;
3535 begin
3536   inherited Create;
3537   fFormat           := tfBGRA8;
3538   fWithAlpha        := tfBGRA8;
3539   fWithoutAlpha     := tfBGR8;
3540   fRGBInverted      := tfRGBA8;
3541   fglInternalFormat := GL_RGBA8;
3542 end;
3543
3544 constructor TfdBGR10A2.Create;
3545 begin
3546   inherited Create;
3547   fFormat           := tfBGR10A2;
3548   fWithAlpha        := tfBGR10A2;
3549   fWithoutAlpha     := tfBGR10;
3550   fRGBInverted      := tfRGB10A2;
3551   fRange.r          := $3FF;
3552   fRange.g          := $3FF;
3553   fRange.b          := $3FF;
3554   fRange.a          := $003;
3555   fShift.r          :=   20;
3556   fShift.g          :=   10;
3557   fShift.b          :=    0;
3558   fShift.a          :=   30;
3559   fglFormat         := GL_BGRA;
3560   fglInternalFormat := GL_RGB10_A2;
3561   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3562 end;
3563
3564 constructor TfdBGRA12.Create;
3565 begin
3566   inherited Create;
3567   fFormat           := tfBGRA12;
3568   fWithAlpha        := tfBGRA12;
3569   fWithoutAlpha     := tfBGR12;
3570   fRGBInverted      := tfRGBA12;
3571   fglInternalFormat := GL_RGBA12;
3572 end;
3573
3574 constructor TfdBGRA16.Create;
3575 begin
3576   inherited Create;
3577   fFormat           := tfBGRA16;
3578   fWithAlpha        := tfBGRA16;
3579   fWithoutAlpha     := tfBGR16;
3580   fRGBInverted      := tfRGBA16;
3581   fglInternalFormat := GL_RGBA16;
3582 end;
3583
3584 constructor TfdDepth16.Create;
3585 begin
3586   inherited Create;
3587   fFormat           := tfDepth16;
3588   fWithAlpha        := tfEmpty;
3589   fWithoutAlpha     := tfDepth16;
3590   fglInternalFormat := GL_DEPTH_COMPONENT16;
3591 end;
3592
3593 constructor TfdDepth24.Create;
3594 begin
3595   inherited Create;
3596   fFormat           := tfDepth24;
3597   fWithAlpha        := tfEmpty;
3598   fWithoutAlpha     := tfDepth24;
3599   fglInternalFormat := GL_DEPTH_COMPONENT24;
3600 end;
3601
3602 constructor TfdDepth32.Create;
3603 begin
3604   inherited Create;
3605   fFormat           := tfDepth32;
3606   fWithAlpha        := tfEmpty;
3607   fWithoutAlpha     := tfDepth32;
3608   fglInternalFormat := GL_DEPTH_COMPONENT32;
3609 end;
3610
3611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3612 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3614 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3615 begin
3616   raise EglBitmap.Create('mapping for compressed formats is not supported');
3617 end;
3618
3619 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3620 begin
3621   raise EglBitmap.Create('mapping for compressed formats is not supported');
3622 end;
3623
3624 constructor TfdS3tcDtx1RGBA.Create;
3625 begin
3626   inherited Create;
3627   fFormat           := tfS3tcDtx1RGBA;
3628   fWithAlpha        := tfS3tcDtx1RGBA;
3629   fUncompressed     := tfRGB5A1;
3630   fPixelSize        := 0.5;
3631   fIsCompressed     := true;
3632   fglFormat         := GL_COMPRESSED_RGBA;
3633   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3634   fglDataFormat     := GL_UNSIGNED_BYTE;
3635 end;
3636
3637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3638 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3640 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3641 begin
3642   raise EglBitmap.Create('mapping for compressed formats is not supported');
3643 end;
3644
3645 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3646 begin
3647   raise EglBitmap.Create('mapping for compressed formats is not supported');
3648 end;
3649
3650 constructor TfdS3tcDtx3RGBA.Create;
3651 begin
3652   inherited Create;
3653   fFormat           := tfS3tcDtx3RGBA;
3654   fWithAlpha        := tfS3tcDtx3RGBA;
3655   fUncompressed     := tfRGBA8;
3656   fPixelSize        := 1.0;
3657   fIsCompressed     := true;
3658   fglFormat         := GL_COMPRESSED_RGBA;
3659   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3660   fglDataFormat     := GL_UNSIGNED_BYTE;
3661 end;
3662
3663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3664 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3667 begin
3668   raise EglBitmap.Create('mapping for compressed formats is not supported');
3669 end;
3670
3671 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3672 begin
3673   raise EglBitmap.Create('mapping for compressed formats is not supported');
3674 end;
3675
3676 constructor TfdS3tcDtx5RGBA.Create;
3677 begin
3678   inherited Create;
3679   fFormat           := tfS3tcDtx3RGBA;
3680   fWithAlpha        := tfS3tcDtx3RGBA;
3681   fUncompressed     := tfRGBA8;
3682   fPixelSize        := 1.0;
3683   fIsCompressed     := true;
3684   fglFormat         := GL_COMPRESSED_RGBA;
3685   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3686   fglDataFormat     := GL_UNSIGNED_BYTE;
3687 end;
3688
3689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3690 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3692 class procedure TFormatDescriptor.Init;
3693 begin
3694   if not Assigned(FormatDescriptorCS) then
3695     FormatDescriptorCS := TCriticalSection.Create;
3696 end;
3697
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3700 begin
3701   FormatDescriptorCS.Enter;
3702   try
3703     result := FormatDescriptors[aFormat];
3704     if not Assigned(result) then begin
3705       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3706       FormatDescriptors[aFormat] := result;
3707     end;
3708   finally
3709     FormatDescriptorCS.Leave;
3710   end;
3711 end;
3712
3713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3714 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3715 begin
3716   result := Get(Get(aFormat).WithAlpha);
3717 end;
3718
3719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 class procedure TFormatDescriptor.Clear;
3721 var
3722   f: TglBitmapFormat;
3723 begin
3724   FormatDescriptorCS.Enter;
3725   try
3726     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3727       FreeAndNil(FormatDescriptors[f]);
3728   finally
3729     FormatDescriptorCS.Leave;
3730   end;
3731 end;
3732
3733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3734 class procedure TFormatDescriptor.Finalize;
3735 begin
3736   Clear;
3737   FreeAndNil(FormatDescriptorCS);
3738 end;
3739
3740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3744 begin
3745   Update(aValue, fRange.r, fShift.r);
3746 end;
3747
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3750 begin
3751   Update(aValue, fRange.g, fShift.g);
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3756 begin
3757   Update(aValue, fRange.b, fShift.b);
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3762 begin
3763   Update(aValue, fRange.a, fShift.a);
3764 end;
3765
3766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3767 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3768   aShift: Byte);
3769 begin
3770   aShift := 0;
3771   aRange := 0;
3772   if (aMask = 0) then
3773     exit;
3774   while (aMask > 0) and ((aMask and 1) = 0) do begin
3775     inc(aShift);
3776     aMask := aMask shr 1;
3777   end;
3778   aRange := 1;
3779   while (aMask > 0) do begin
3780     aRange := aRange shl 1;
3781     aMask  := aMask  shr 1;
3782   end;
3783   dec(aRange);
3784
3785   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3786 end;
3787
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3790 var
3791   data: QWord;
3792   s: Integer;
3793 begin
3794   data :=
3795     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3796     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3797     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3798     ((aPixel.Data.a and fRange.a) shl fShift.a);
3799   s := Round(fPixelSize);
3800   case s of
3801     1:           aData^  := data;
3802     2:     PWord(aData)^ := data;
3803     4: PCardinal(aData)^ := data;
3804     8:    PQWord(aData)^ := data;
3805   else
3806     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3807   end;
3808   inc(aData, s);
3809 end;
3810
3811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3812 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3813 var
3814   data: QWord;
3815   s, i: Integer;
3816 begin
3817   s := Round(fPixelSize);
3818   case s of
3819     1: data :=           aData^;
3820     2: data :=     PWord(aData)^;
3821     4: data := PCardinal(aData)^;
3822     8: data :=    PQWord(aData)^;
3823   else
3824     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3825   end;
3826   for i := 0 to 3 do
3827     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3828   inc(aData, s);
3829 end;
3830
3831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3832 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3834 procedure TbmpColorTableFormat.CreateColorTable;
3835 var
3836   i: Integer;
3837 begin
3838   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3839     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3840
3841   if (Format = tfLuminance4) then
3842     SetLength(fColorTable, 16)
3843   else
3844     SetLength(fColorTable, 256);
3845
3846   case Format of
3847     tfLuminance4: begin
3848       for i := 0 to High(fColorTable) do begin
3849         fColorTable[i].r := 16 * i;
3850         fColorTable[i].g := 16 * i;
3851         fColorTable[i].b := 16 * i;
3852         fColorTable[i].a := 0;
3853       end;
3854     end;
3855
3856     tfLuminance8: begin
3857       for i := 0 to High(fColorTable) do begin
3858         fColorTable[i].r := i;
3859         fColorTable[i].g := i;
3860         fColorTable[i].b := i;
3861         fColorTable[i].a := 0;
3862       end;
3863     end;
3864
3865     tfR3G3B2: begin
3866       for i := 0 to High(fColorTable) do begin
3867         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3868         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3869         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3870         fColorTable[i].a := 0;
3871       end;
3872     end;
3873   end;
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3878 var
3879   d: Byte;
3880 begin
3881   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3882     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3883
3884   case Format of
3885     tfLuminance4: begin
3886       if (aMapData = nil) then
3887         aData^ := 0;
3888       d := LuminanceWeight(aPixel) and Range.r;
3889       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3890       inc(PByte(aMapData), 4);
3891       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3892         inc(aData);
3893         aMapData := nil;
3894       end;
3895     end;
3896
3897     tfLuminance8: begin
3898       aData^ := LuminanceWeight(aPixel) and Range.r;
3899       inc(aData);
3900     end;
3901
3902     tfR3G3B2: begin
3903       aData^ := Round(
3904         ((aPixel.Data.r and Range.r) shl Shift.r) or
3905         ((aPixel.Data.g and Range.g) shl Shift.g) or
3906         ((aPixel.Data.b and Range.b) shl Shift.b));
3907       inc(aData);
3908     end;
3909   end;
3910 end;
3911
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3914 var
3915   idx: QWord;
3916   s: Integer;
3917   bits: Byte;
3918   f: Single;
3919 begin
3920   s    := Trunc(fPixelSize);
3921   f    := fPixelSize - s;
3922   bits := Round(8 * f);
3923   case s of
3924     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3925     1: idx :=           aData^;
3926     2: idx :=     PWord(aData)^;
3927     4: idx := PCardinal(aData)^;
3928     8: idx :=    PQWord(aData)^;
3929   else
3930     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3931   end;
3932   if (idx >= Length(fColorTable)) then
3933     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3934   with fColorTable[idx] do begin
3935     aPixel.Data.r := r;
3936     aPixel.Data.g := g;
3937     aPixel.Data.b := b;
3938     aPixel.Data.a := a;
3939   end;
3940   inc(PByte(aMapData), bits);
3941   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3942     inc(aData, 1);
3943     dec(PByte(aMapData), 8);
3944   end;
3945   inc(aData, s);
3946 end;
3947
3948 destructor TbmpColorTableFormat.Destroy;
3949 begin
3950   SetLength(fColorTable, 0);
3951   inherited Destroy;
3952 end;
3953
3954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3955 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3957 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3958 var
3959   i: Integer;
3960 begin
3961   for i := 0 to 3 do begin
3962     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3963       if (aSourceFD.Range.arr[i] > 0) then
3964         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3965       else
3966         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3967     end;
3968   end;
3969 end;
3970
3971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3972 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3973 begin
3974   with aFuncRec do begin
3975     if (Source.Range.r   > 0) then
3976       Dest.Data.r := Source.Data.r;
3977     if (Source.Range.g > 0) then
3978       Dest.Data.g := Source.Data.g;
3979     if (Source.Range.b  > 0) then
3980       Dest.Data.b := Source.Data.b;
3981     if (Source.Range.a > 0) then
3982       Dest.Data.a := Source.Data.a;
3983   end;
3984 end;
3985
3986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3987 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3988 var
3989   i: Integer;
3990 begin
3991   with aFuncRec do begin
3992     for i := 0 to 3 do
3993       if (Source.Range.arr[i] > 0) then
3994         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3995   end;
3996 end;
3997
3998 type
3999   TShiftData = packed record
4000     case Integer of
4001       0: (r, g, b, a: SmallInt);
4002       1: (arr: array[0..3] of SmallInt);
4003   end;
4004   PShiftData = ^TShiftData;
4005
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4008 var
4009   i: Integer;
4010 begin
4011   with aFuncRec do
4012     for i := 0 to 3 do
4013       if (Source.Range.arr[i] > 0) then
4014         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4015 end;
4016
4017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4018 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4019 begin
4020   with aFuncRec do begin
4021     Dest.Data := Source.Data;
4022     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4023       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4024       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4025       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4026     end;
4027     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4028       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4029     end;
4030   end;
4031 end;
4032
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4035 var
4036   i: Integer;
4037 begin
4038   with aFuncRec do begin
4039     for i := 0 to 3 do
4040       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4041   end;
4042 end;
4043
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4046 var
4047   Temp: Single;
4048 begin
4049   with FuncRec do begin
4050     if (FuncRec.Args = nil) then begin //source has no alpha
4051       Temp :=
4052         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4053         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4054         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4055       Dest.Data.a := Round(Dest.Range.a * Temp);
4056     end else
4057       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4058   end;
4059 end;
4060
4061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4062 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4063 type
4064   PglBitmapPixelData = ^TglBitmapPixelData;
4065 begin
4066   with FuncRec do begin
4067     Dest.Data.r := Source.Data.r;
4068     Dest.Data.g := Source.Data.g;
4069     Dest.Data.b := Source.Data.b;
4070
4071     with PglBitmapPixelData(Args)^ do
4072       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4073           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4074           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4075         Dest.Data.a := 0
4076       else
4077         Dest.Data.a := Dest.Range.a;
4078   end;
4079 end;
4080
4081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4082 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4083 begin
4084   with FuncRec do begin
4085     Dest.Data.r := Source.Data.r;
4086     Dest.Data.g := Source.Data.g;
4087     Dest.Data.b := Source.Data.b;
4088     Dest.Data.a := PCardinal(Args)^;
4089   end;
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4094 type
4095   PRGBPix = ^TRGBPix;
4096   TRGBPix = array [0..2] of byte;
4097 var
4098   Temp: Byte;
4099 begin
4100   while aWidth > 0 do begin
4101     Temp := PRGBPix(aData)^[0];
4102     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4103     PRGBPix(aData)^[2] := Temp;
4104
4105     if aHasAlpha then
4106       Inc(aData, 4)
4107     else
4108       Inc(aData, 3);
4109     dec(aWidth);
4110   end;
4111 end;
4112
4113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4114 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4117 begin
4118   result := TFormatDescriptor.Get(Format);
4119 end;
4120
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 function TglBitmap.GetWidth: Integer;
4123 begin
4124   if (ffX in fDimension.Fields) then
4125     result := fDimension.X
4126   else
4127     result := -1;
4128 end;
4129
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 function TglBitmap.GetHeight: Integer;
4132 begin
4133   if (ffY in fDimension.Fields) then
4134     result := fDimension.Y
4135   else
4136     result := -1;
4137 end;
4138
4139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4140 function TglBitmap.GetFileWidth: Integer;
4141 begin
4142   result := Max(1, Width);
4143 end;
4144
4145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 function TglBitmap.GetFileHeight: Integer;
4147 begin
4148   result := Max(1, Height);
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4153 begin
4154   if fCustomData = aValue then
4155     exit;
4156   fCustomData := aValue;
4157 end;
4158
4159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4160 procedure TglBitmap.SetCustomName(const aValue: String);
4161 begin
4162   if fCustomName = aValue then
4163     exit;
4164   fCustomName := aValue;
4165 end;
4166
4167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4168 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4169 begin
4170   if fCustomNameW = aValue then
4171     exit;
4172   fCustomNameW := aValue;
4173 end;
4174
4175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4176 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4177 begin
4178   if fDeleteTextureOnFree = aValue then
4179     exit;
4180   fDeleteTextureOnFree := aValue;
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4185 begin
4186   if fFormat = aValue then
4187     exit;
4188   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4189     raise EglBitmapUnsupportedFormat.Create(Format);
4190   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4191 end;
4192
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4195 begin
4196   if fFreeDataAfterGenTexture = aValue then
4197     exit;
4198   fFreeDataAfterGenTexture := aValue;
4199 end;
4200
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetID(const aValue: Cardinal);
4203 begin
4204   if fID = aValue then
4205     exit;
4206   fID := aValue;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4211 begin
4212   if fMipMap = aValue then
4213     exit;
4214   fMipMap := aValue;
4215 end;
4216
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4219 begin
4220   if fTarget = aValue then
4221     exit;
4222   fTarget := aValue;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4227 var
4228   MaxAnisotropic: Integer;
4229 begin
4230   fAnisotropic := aValue;
4231   if (ID > 0) then begin
4232     if GL_EXT_texture_filter_anisotropic then begin
4233       if fAnisotropic > 0 then begin
4234         Bind(false);
4235         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4236         if aValue > MaxAnisotropic then
4237           fAnisotropic := MaxAnisotropic;
4238         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4239       end;
4240     end else begin
4241       fAnisotropic := 0;
4242     end;
4243   end;
4244 end;
4245
4246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4247 procedure TglBitmap.CreateID;
4248 begin
4249   if (ID <> 0) then
4250     glDeleteTextures(1, @fID);
4251   glGenTextures(1, @fID);
4252   Bind(false);
4253 end;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4257 begin
4258   // Set Up Parameters
4259   SetWrap(fWrapS, fWrapT, fWrapR);
4260   SetFilter(fFilterMin, fFilterMag);
4261   SetAnisotropic(fAnisotropic);
4262   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4263
4264   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4265     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4266
4267   // Mip Maps Generation Mode
4268   aBuildWithGlu := false;
4269   if (MipMap = mmMipmap) then begin
4270     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4271       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4272     else
4273       aBuildWithGlu := true;
4274   end else if (MipMap = mmMipmapGlu) then
4275     aBuildWithGlu := true;
4276 end;
4277
4278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4279 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4280   const aWidth: Integer; const aHeight: Integer);
4281 var
4282   s: Single;
4283 begin
4284   if (Data <> aData) then begin
4285     if (Assigned(Data)) then
4286       FreeMem(Data);
4287     fData := aData;
4288   end;
4289
4290   if not Assigned(fData) then begin
4291     fPixelSize := 0;
4292     fRowSize   := 0;
4293   end else begin
4294     FillChar(fDimension, SizeOf(fDimension), 0);
4295     if aWidth <> -1 then begin
4296       fDimension.Fields := fDimension.Fields + [ffX];
4297       fDimension.X := aWidth;
4298     end;
4299
4300     if aHeight <> -1 then begin
4301       fDimension.Fields := fDimension.Fields + [ffY];
4302       fDimension.Y := aHeight;
4303     end;
4304
4305     s := TFormatDescriptor.Get(aFormat).PixelSize;
4306     fFormat    := aFormat;
4307     fPixelSize := Ceil(s);
4308     fRowSize   := Ceil(s * aWidth);
4309   end;
4310 end;
4311
4312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 function TglBitmap.FlipHorz: Boolean;
4314 begin
4315   result := false;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 function TglBitmap.FlipVert: Boolean;
4320 begin
4321   result := false;
4322 end;
4323
4324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4325 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 procedure TglBitmap.AfterConstruction;
4328 begin
4329   inherited AfterConstruction;
4330
4331   fID         := 0;
4332   fTarget     := 0;
4333   fIsResident := false;
4334
4335   fFormat                  := glBitmapGetDefaultFormat;
4336   fMipMap                  := glBitmapDefaultMipmap;
4337   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4338   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4339
4340   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4341   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4342   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4343 end;
4344
4345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4346 procedure TglBitmap.BeforeDestruction;
4347 var
4348   NewData: PByte;
4349 begin
4350   NewData := nil;
4351   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4352   if (fID > 0) and fDeleteTextureOnFree then
4353     glDeleteTextures(1, @fID);
4354   inherited BeforeDestruction;
4355 end;
4356
4357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4358 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4359 var
4360   TempPos: Integer;
4361 begin
4362   if not Assigned(aResType) then begin
4363     TempPos   := Pos('.', aResource);
4364     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4365     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4366   end;
4367 end;
4368
4369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4370 procedure TglBitmap.LoadFromFile(const aFilename: String);
4371 var
4372   fs: TFileStream;
4373 begin
4374   if not FileExists(aFilename) then
4375     raise EglBitmap.Create('file does not exist: ' + aFilename);
4376   fFilename := aFilename;
4377   fs := TFileStream.Create(fFilename, fmOpenRead);
4378   try
4379     fs.Position := 0;
4380     LoadFromStream(fs);
4381   finally
4382     fs.Free;
4383   end;
4384 end;
4385
4386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4387 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4388 begin
4389   {$IFDEF GLB_SUPPORT_PNG_READ}
4390   if not LoadPNG(aStream) then
4391   {$ENDIF}
4392   {$IFDEF GLB_SUPPORT_JPEG_READ}
4393   if not LoadJPEG(aStream) then
4394   {$ENDIF}
4395   if not LoadDDS(aStream) then
4396   if not LoadTGA(aStream) then
4397   if not LoadBMP(aStream) then
4398     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4399 end;
4400
4401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4402 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4403   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4404 var
4405   tmpData: PByte;
4406   size: Integer;
4407 begin
4408   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4409   GetMem(tmpData, size);
4410   try
4411     FillChar(tmpData^, size, #$FF);
4412     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4413   except
4414     if Assigned(tmpData) then
4415       FreeMem(tmpData);
4416     raise;
4417   end;
4418   AddFunc(Self, aFunc, false, Format, aArgs);
4419 end;
4420
4421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4422 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4423 var
4424   rs: TResourceStream;
4425 begin
4426   PrepareResType(aResource, aResType);
4427   rs := TResourceStream.Create(aInstance, aResource, aResType);
4428   try
4429     LoadFromStream(rs);
4430   finally
4431     rs.Free;
4432   end;
4433 end;
4434
4435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4436 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4437 var
4438   rs: TResourceStream;
4439 begin
4440   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4441   try
4442     LoadFromStream(rs);
4443   finally
4444     rs.Free;
4445   end;
4446 end;
4447
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4450 var
4451   fs: TFileStream;
4452 begin
4453   fs := TFileStream.Create(aFileName, fmCreate);
4454   try
4455     fs.Position := 0;
4456     SaveToStream(fs, aFileType);
4457   finally
4458     fs.Free;
4459   end;
4460 end;
4461
4462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4463 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4464 begin
4465   case aFileType of
4466     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4467     ftPNG:  SavePNG(aStream);
4468     {$ENDIF}
4469     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4470     ftJPEG: SaveJPEG(aStream);
4471     {$ENDIF}
4472     ftDDS:  SaveDDS(aStream);
4473     ftTGA:  SaveTGA(aStream);
4474     ftBMP:  SaveBMP(aStream);
4475   end;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4480 begin
4481   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4482 end;
4483
4484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4485 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4486   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4487 var
4488   DestData, TmpData, SourceData: pByte;
4489   TempHeight, TempWidth: Integer;
4490   SourceFD, DestFD: TFormatDescriptor;
4491   SourceMD, DestMD: Pointer;
4492
4493   FuncRec: TglBitmapFunctionRec;
4494 begin
4495   Assert(Assigned(Data));
4496   Assert(Assigned(aSource));
4497   Assert(Assigned(aSource.Data));
4498
4499   result := false;
4500   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4501     SourceFD := TFormatDescriptor.Get(aSource.Format);
4502     DestFD   := TFormatDescriptor.Get(aFormat);
4503
4504     if (SourceFD.IsCompressed) then
4505       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4506     if (DestFD.IsCompressed) then
4507       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4508
4509     // inkompatible Formats so CreateTemp
4510     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4511       aCreateTemp := true;
4512
4513     // Values
4514     TempHeight := Max(1, aSource.Height);
4515     TempWidth  := Max(1, aSource.Width);
4516
4517     FuncRec.Sender := Self;
4518     FuncRec.Args   := aArgs;
4519
4520     TmpData := nil;
4521     if aCreateTemp then begin
4522       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4523       DestData := TmpData;
4524     end else
4525       DestData := Data;
4526
4527     try
4528       SourceFD.PreparePixel(FuncRec.Source);
4529       DestFD.PreparePixel  (FuncRec.Dest);
4530
4531       SourceMD := SourceFD.CreateMappingData;
4532       DestMD   := DestFD.CreateMappingData;
4533
4534       FuncRec.Size            := aSource.Dimension;
4535       FuncRec.Position.Fields := FuncRec.Size.Fields;
4536
4537       try
4538         SourceData := aSource.Data;
4539         FuncRec.Position.Y := 0;
4540         while FuncRec.Position.Y < TempHeight do begin
4541           FuncRec.Position.X := 0;
4542           while FuncRec.Position.X < TempWidth do begin
4543             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4544             aFunc(FuncRec);
4545             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4546             inc(FuncRec.Position.X);
4547           end;
4548           inc(FuncRec.Position.Y);
4549         end;
4550
4551         // Updating Image or InternalFormat
4552         if aCreateTemp then
4553           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4554         else if (aFormat <> fFormat) then
4555           Format := aFormat;
4556
4557         result := true;
4558       finally
4559         SourceFD.FreeMappingData(SourceMD);
4560         DestFD.FreeMappingData(DestMD);
4561       end;
4562     except
4563       if aCreateTemp and Assigned(TmpData) then
4564         FreeMem(TmpData);
4565       raise;
4566     end;
4567   end;
4568 end;
4569
4570 {$IFDEF GLB_SDL}
4571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4572 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4573 var
4574   Row, RowSize: Integer;
4575   SourceData, TmpData: PByte;
4576   TempDepth: Integer;
4577   FormatDesc: TFormatDescriptor;
4578
4579   function GetRowPointer(Row: Integer): pByte;
4580   begin
4581     result := aSurface.pixels;
4582     Inc(result, Row * RowSize);
4583   end;
4584
4585 begin
4586   result := false;
4587
4588   FormatDesc := TFormatDescriptor.Get(Format);
4589   if FormatDesc.IsCompressed then
4590     raise EglBitmapUnsupportedFormat.Create(Format);
4591
4592   if Assigned(Data) then begin
4593     case Trunc(FormatDesc.PixelSize) of
4594       1: TempDepth :=  8;
4595       2: TempDepth := 16;
4596       3: TempDepth := 24;
4597       4: TempDepth := 32;
4598     else
4599       raise EglBitmapUnsupportedFormat.Create(Format);
4600     end;
4601
4602     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4603       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4604     SourceData := Data;
4605     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4606
4607     for Row := 0 to FileHeight-1 do begin
4608       TmpData := GetRowPointer(Row);
4609       if Assigned(TmpData) then begin
4610         Move(SourceData^, TmpData^, RowSize);
4611         inc(SourceData, RowSize);
4612       end;
4613     end;
4614     result := true;
4615   end;
4616 end;
4617
4618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4619 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4620 var
4621   pSource, pData, pTempData: PByte;
4622   Row, RowSize, TempWidth, TempHeight: Integer;
4623   IntFormat: TglBitmapFormat;
4624   FormatDesc: TFormatDescriptor;
4625
4626   function GetRowPointer(Row: Integer): pByte;
4627   begin
4628     result := aSurface^.pixels;
4629     Inc(result, Row * RowSize);
4630   end;
4631
4632 begin
4633   result := false;
4634   if (Assigned(aSurface)) then begin
4635     with aSurface^.format^ do begin
4636       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4637         FormatDesc := TFormatDescriptor.Get(IntFormat);
4638         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4639           break;
4640       end;
4641       if (IntFormat = tfEmpty) then
4642         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4643     end;
4644
4645     TempWidth  := aSurface^.w;
4646     TempHeight := aSurface^.h;
4647     RowSize := FormatDesc.GetSize(TempWidth, 1);
4648     GetMem(pData, TempHeight * RowSize);
4649     try
4650       pTempData := pData;
4651       for Row := 0 to TempHeight -1 do begin
4652         pSource := GetRowPointer(Row);
4653         if (Assigned(pSource)) then begin
4654           Move(pSource^, pTempData^, RowSize);
4655           Inc(pTempData, RowSize);
4656         end;
4657       end;
4658       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4659       result := true;
4660     except
4661       if Assigned(pData) then
4662         FreeMem(pData);
4663       raise;
4664     end;
4665   end;
4666 end;
4667
4668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4669 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4670 var
4671   Row, Col, AlphaInterleave: Integer;
4672   pSource, pDest: PByte;
4673
4674   function GetRowPointer(Row: Integer): pByte;
4675   begin
4676     result := aSurface.pixels;
4677     Inc(result, Row * Width);
4678   end;
4679
4680 begin
4681   result := false;
4682   if Assigned(Data) then begin
4683     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4684       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4685
4686       AlphaInterleave := 0;
4687       case Format of
4688         tfLuminance8Alpha8:
4689           AlphaInterleave := 1;
4690         tfBGRA8, tfRGBA8:
4691           AlphaInterleave := 3;
4692       end;
4693
4694       pSource := Data;
4695       for Row := 0 to Height -1 do begin
4696         pDest := GetRowPointer(Row);
4697         if Assigned(pDest) then begin
4698           for Col := 0 to Width -1 do begin
4699             Inc(pSource, AlphaInterleave);
4700             pDest^ := pSource^;
4701             Inc(pDest);
4702             Inc(pSource);
4703           end;
4704         end;
4705       end;
4706       result := true;
4707     end;
4708   end;
4709 end;
4710
4711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4712 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4713 var
4714   bmp: TglBitmap2D;
4715 begin
4716   bmp := TglBitmap2D.Create;
4717   try
4718     bmp.AssignFromSurface(aSurface);
4719     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4720   finally
4721     bmp.Free;
4722   end;
4723 end;
4724 {$ENDIF}
4725
4726 {$IFDEF GLB_DELPHI}
4727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4728 function CreateGrayPalette: HPALETTE;
4729 var
4730   Idx: Integer;
4731   Pal: PLogPalette;
4732 begin
4733   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4734
4735   Pal.palVersion := $300;
4736   Pal.palNumEntries := 256;
4737
4738   for Idx := 0 to Pal.palNumEntries - 1 do begin
4739     Pal.palPalEntry[Idx].peRed   := Idx;
4740     Pal.palPalEntry[Idx].peGreen := Idx;
4741     Pal.palPalEntry[Idx].peBlue  := Idx;
4742     Pal.palPalEntry[Idx].peFlags := 0;
4743   end;
4744   Result := CreatePalette(Pal^);
4745   FreeMem(Pal);
4746 end;
4747
4748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4749 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4750 var
4751   Row: Integer;
4752   pSource, pData: PByte;
4753 begin
4754   result := false;
4755   if Assigned(Data) then begin
4756     if Assigned(aBitmap) then begin
4757       aBitmap.Width  := Width;
4758       aBitmap.Height := Height;
4759
4760       case Format of
4761         tfAlpha8, tfLuminance8: begin
4762           aBitmap.PixelFormat := pf8bit;
4763           aBitmap.Palette     := CreateGrayPalette;
4764         end;
4765         tfRGB5A1:
4766           aBitmap.PixelFormat := pf15bit;
4767         tfR5G6B5:
4768           aBitmap.PixelFormat := pf16bit;
4769         tfRGB8, tfBGR8:
4770           aBitmap.PixelFormat := pf24bit;
4771         tfRGBA8, tfBGRA8:
4772           aBitmap.PixelFormat := pf32bit;
4773       else
4774         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4775       end;
4776
4777       pSource := Data;
4778       for Row := 0 to FileHeight -1 do begin
4779         pData := aBitmap.Scanline[Row];
4780         Move(pSource^, pData^, fRowSize);
4781         Inc(pSource, fRowSize);
4782         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4783           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4784       end;
4785       result := true;
4786     end;
4787   end;
4788 end;
4789
4790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4791 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4792 var
4793   pSource, pData, pTempData: PByte;
4794   Row, RowSize, TempWidth, TempHeight: Integer;
4795   IntFormat: TglBitmapFormat;
4796 begin
4797   result := false;
4798
4799   if (Assigned(aBitmap)) then begin
4800     case aBitmap.PixelFormat of
4801       pf8bit:
4802         IntFormat := tfLuminance8;
4803       pf15bit:
4804         IntFormat := tfRGB5A1;
4805       pf16bit:
4806         IntFormat := tfR5G6B5;
4807       pf24bit:
4808         IntFormat := tfBGR8;
4809       pf32bit:
4810         IntFormat := tfBGRA8;
4811     else
4812       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4813     end;
4814
4815     TempWidth  := aBitmap.Width;
4816     TempHeight := aBitmap.Height;
4817     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4818     GetMem(pData, TempHeight * RowSize);
4819     try
4820       pTempData := pData;
4821       for Row := 0 to TempHeight -1 do begin
4822         pSource := aBitmap.Scanline[Row];
4823         if (Assigned(pSource)) then begin
4824           Move(pSource^, pTempData^, RowSize);
4825           Inc(pTempData, RowSize);
4826         end;
4827       end;
4828       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4829       result := true;
4830     except
4831       if Assigned(pData) then
4832         FreeMem(pData);
4833       raise;
4834     end;
4835   end;
4836 end;
4837
4838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4839 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4840 var
4841   Row, Col, AlphaInterleave: Integer;
4842   pSource, pDest: PByte;
4843 begin
4844   result := false;
4845
4846   if Assigned(Data) then begin
4847     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4848       if Assigned(aBitmap) then begin
4849         aBitmap.PixelFormat := pf8bit;
4850         aBitmap.Palette     := CreateGrayPalette;
4851         aBitmap.Width       := Width;
4852         aBitmap.Height      := Height;
4853
4854         case Format of
4855           tfLuminance8Alpha8:
4856             AlphaInterleave := 1;
4857           tfRGBA8, tfBGRA8:
4858             AlphaInterleave := 3;
4859           else
4860             AlphaInterleave := 0;
4861         end;
4862
4863         // Copy Data
4864         pSource := Data;
4865
4866         for Row := 0 to Height -1 do begin
4867           pDest := aBitmap.Scanline[Row];
4868           if Assigned(pDest) then begin
4869             for Col := 0 to Width -1 do begin
4870               Inc(pSource, AlphaInterleave);
4871               pDest^ := pSource^;
4872               Inc(pDest);
4873               Inc(pSource);
4874             end;
4875           end;
4876         end;
4877         result := true;
4878       end;
4879     end;
4880   end;
4881 end;
4882
4883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4884 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4885 var
4886   tex: TglBitmap2D;
4887 begin
4888   tex := TglBitmap2D.Create;
4889   try
4890     tex.AssignFromBitmap(ABitmap);
4891     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4892   finally
4893     tex.Free;
4894   end;
4895 end;
4896 {$ENDIF}
4897
4898 {$IFDEF GLB_LAZARUS}
4899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4900 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4901 var
4902   rid: TRawImageDescription;
4903   FormatDesc: TFormatDescriptor;
4904 begin
4905   result := false;
4906   if not Assigned(aImage) or (Format = tfEmpty) then
4907     exit;
4908   FormatDesc := TFormatDescriptor.Get(Format);
4909   if FormatDesc.IsCompressed then
4910     exit;
4911
4912   FillChar(rid{%H-}, SizeOf(rid), 0);
4913   if (Format in [
4914        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4915        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4916        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4917     rid.Format := ricfGray
4918   else
4919     rid.Format := ricfRGBA;
4920
4921   rid.Width        := Width;
4922   rid.Height       := Height;
4923   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4924   rid.BitOrder     := riboBitsInOrder;
4925   rid.ByteOrder    := riboLSBFirst;
4926   rid.LineOrder    := riloTopToBottom;
4927   rid.LineEnd      := rileTight;
4928   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4929   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4930   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4931   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4932   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4933   rid.RedShift     := FormatDesc.Shift.r;
4934   rid.GreenShift   := FormatDesc.Shift.g;
4935   rid.BlueShift    := FormatDesc.Shift.b;
4936   rid.AlphaShift   := FormatDesc.Shift.a;
4937
4938   rid.MaskBitsPerPixel  := 0;
4939   rid.PaletteColorCount := 0;
4940
4941   aImage.DataDescription := rid;
4942   aImage.CreateData;
4943
4944   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4945
4946   result := true;
4947 end;
4948
4949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4950 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4951 var
4952   f: TglBitmapFormat;
4953   FormatDesc: TFormatDescriptor;
4954   ImageData: PByte;
4955   ImageSize: Integer;
4956 begin
4957   result := false;
4958   if not Assigned(aImage) then
4959     exit;
4960   for f := High(f) downto Low(f) do begin
4961     FormatDesc := TFormatDescriptor.Get(f);
4962     with aImage.DataDescription do
4963       if FormatDesc.MaskMatch(
4964         (QWord(1 shl RedPrec  )-1) shl RedShift,
4965         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4966         (QWord(1 shl BluePrec )-1) shl BlueShift,
4967         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4968         break;
4969   end;
4970
4971   if (f = tfEmpty) then
4972     exit;
4973
4974   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4975   ImageData := GetMem(ImageSize);
4976   try
4977     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4978     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4979   except
4980     if Assigned(ImageData) then
4981       FreeMem(ImageData);
4982     raise;
4983   end;
4984
4985   result := true;
4986 end;
4987
4988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4989 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4990 var
4991   rid: TRawImageDescription;
4992   FormatDesc: TFormatDescriptor;
4993   Pixel: TglBitmapPixelData;
4994   x, y: Integer;
4995   srcMD: Pointer;
4996   src, dst: PByte;
4997 begin
4998   result := false;
4999   if not Assigned(aImage) or (Format = tfEmpty) then
5000     exit;
5001   FormatDesc := TFormatDescriptor.Get(Format);
5002   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5003     exit;
5004
5005   FillChar(rid{%H-}, SizeOf(rid), 0);
5006   rid.Format       := ricfGray;
5007   rid.Width        := Width;
5008   rid.Height       := Height;
5009   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5010   rid.BitOrder     := riboBitsInOrder;
5011   rid.ByteOrder    := riboLSBFirst;
5012   rid.LineOrder    := riloTopToBottom;
5013   rid.LineEnd      := rileTight;
5014   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5015   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5016   rid.GreenPrec    := 0;
5017   rid.BluePrec     := 0;
5018   rid.AlphaPrec    := 0;
5019   rid.RedShift     := 0;
5020   rid.GreenShift   := 0;
5021   rid.BlueShift    := 0;
5022   rid.AlphaShift   := 0;
5023
5024   rid.MaskBitsPerPixel  := 0;
5025   rid.PaletteColorCount := 0;
5026
5027   aImage.DataDescription := rid;
5028   aImage.CreateData;
5029
5030   srcMD := FormatDesc.CreateMappingData;
5031   try
5032     FormatDesc.PreparePixel(Pixel);
5033     src := Data;
5034     dst := aImage.PixelData;
5035     for y := 0 to Height-1 do
5036       for x := 0 to Width-1 do begin
5037         FormatDesc.Unmap(src, Pixel, srcMD);
5038         case rid.BitsPerPixel of
5039            8: begin
5040             dst^ := Pixel.Data.a;
5041             inc(dst);
5042           end;
5043           16: begin
5044             PWord(dst)^ := Pixel.Data.a;
5045             inc(dst, 2);
5046           end;
5047           24: begin
5048             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5049             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5050             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5051             inc(dst, 3);
5052           end;
5053           32: begin
5054             PCardinal(dst)^ := Pixel.Data.a;
5055             inc(dst, 4);
5056           end;
5057         else
5058           raise EglBitmapUnsupportedFormat.Create(Format);
5059         end;
5060       end;
5061   finally
5062     FormatDesc.FreeMappingData(srcMD);
5063   end;
5064   result := true;
5065 end;
5066
5067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5068 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5069 var
5070   tex: TglBitmap2D;
5071 begin
5072   tex := TglBitmap2D.Create;
5073   try
5074     tex.AssignFromLazIntfImage(aImage);
5075     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5076   finally
5077     tex.Free;
5078   end;
5079 end;
5080 {$ENDIF}
5081
5082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5083 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5084   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5085 var
5086   rs: TResourceStream;
5087 begin
5088   PrepareResType(aResource, aResType);
5089   rs := TResourceStream.Create(aInstance, aResource, aResType);
5090   try
5091     result := AddAlphaFromStream(rs, aFunc, aArgs);
5092   finally
5093     rs.Free;
5094   end;
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5099   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5100 var
5101   rs: TResourceStream;
5102 begin
5103   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5104   try
5105     result := AddAlphaFromStream(rs, aFunc, aArgs);
5106   finally
5107     rs.Free;
5108   end;
5109 end;
5110
5111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5112 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5113 begin
5114   if TFormatDescriptor.Get(Format).IsCompressed then
5115     raise EglBitmapUnsupportedFormat.Create(Format);
5116   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5117 end;
5118
5119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5120 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5121 var
5122   FS: TFileStream;
5123 begin
5124   FS := TFileStream.Create(aFileName, fmOpenRead);
5125   try
5126     result := AddAlphaFromStream(FS, aFunc, aArgs);
5127   finally
5128     FS.Free;
5129   end;
5130 end;
5131
5132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5133 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5134 var
5135   tex: TglBitmap2D;
5136 begin
5137   tex := TglBitmap2D.Create(aStream);
5138   try
5139     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5140   finally
5141     tex.Free;
5142   end;
5143 end;
5144
5145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5146 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5147 var
5148   DestData, DestData2, SourceData: pByte;
5149   TempHeight, TempWidth: Integer;
5150   SourceFD, DestFD: TFormatDescriptor;
5151   SourceMD, DestMD, DestMD2: Pointer;
5152
5153   FuncRec: TglBitmapFunctionRec;
5154 begin
5155   result := false;
5156
5157   Assert(Assigned(Data));
5158   Assert(Assigned(aBitmap));
5159   Assert(Assigned(aBitmap.Data));
5160
5161   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5162     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5163
5164     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5165     DestFD   := TFormatDescriptor.Get(Format);
5166
5167     if not Assigned(aFunc) then begin
5168       aFunc        := glBitmapAlphaFunc;
5169       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5170     end else
5171       FuncRec.Args := aArgs;
5172
5173     // Values
5174     TempHeight := aBitmap.FileHeight;
5175     TempWidth  := aBitmap.FileWidth;
5176
5177     FuncRec.Sender          := Self;
5178     FuncRec.Size            := Dimension;
5179     FuncRec.Position.Fields := FuncRec.Size.Fields;
5180
5181     DestData   := Data;
5182     DestData2  := Data;
5183     SourceData := aBitmap.Data;
5184
5185     // Mapping
5186     SourceFD.PreparePixel(FuncRec.Source);
5187     DestFD.PreparePixel  (FuncRec.Dest);
5188
5189     SourceMD := SourceFD.CreateMappingData;
5190     DestMD   := DestFD.CreateMappingData;
5191     DestMD2  := DestFD.CreateMappingData;
5192     try
5193       FuncRec.Position.Y := 0;
5194       while FuncRec.Position.Y < TempHeight do begin
5195         FuncRec.Position.X := 0;
5196         while FuncRec.Position.X < TempWidth do begin
5197           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5198           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5199           aFunc(FuncRec);
5200           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5201           inc(FuncRec.Position.X);
5202         end;
5203         inc(FuncRec.Position.Y);
5204       end;
5205     finally
5206       SourceFD.FreeMappingData(SourceMD);
5207       DestFD.FreeMappingData(DestMD);
5208       DestFD.FreeMappingData(DestMD2);
5209     end;
5210   end;
5211 end;
5212
5213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5214 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5215 begin
5216   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5217 end;
5218
5219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5220 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5221 var
5222   PixelData: TglBitmapPixelData;
5223 begin
5224   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5225   result := AddAlphaFromColorKeyFloat(
5226     aRed   / PixelData.Range.r,
5227     aGreen / PixelData.Range.g,
5228     aBlue  / PixelData.Range.b,
5229     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5230 end;
5231
5232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5233 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5234 var
5235   values: array[0..2] of Single;
5236   tmp: Cardinal;
5237   i: Integer;
5238   PixelData: TglBitmapPixelData;
5239 begin
5240   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5241   with PixelData do begin
5242     values[0] := aRed;
5243     values[1] := aGreen;
5244     values[2] := aBlue;
5245
5246     for i := 0 to 2 do begin
5247       tmp          := Trunc(Range.arr[i] * aDeviation);
5248       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5249       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5250     end;
5251     Data.a  := 0;
5252     Range.a := 0;
5253   end;
5254   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5255 end;
5256
5257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5258 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5259 begin
5260   result := AddAlphaFromValueFloat(aAlpha / $FF);
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5265 var
5266   PixelData: TglBitmapPixelData;
5267 begin
5268   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5269   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5270 end;
5271
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5274 var
5275   PixelData: TglBitmapPixelData;
5276 begin
5277   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5278   with PixelData do
5279     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5280   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 function TglBitmap.RemoveAlpha: Boolean;
5285 var
5286   FormatDesc: TFormatDescriptor;
5287 begin
5288   result := false;
5289   FormatDesc := TFormatDescriptor.Get(Format);
5290   if Assigned(Data) then begin
5291     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5292       raise EglBitmapUnsupportedFormat.Create(Format);
5293     result := ConvertTo(FormatDesc.WithoutAlpha);
5294   end;
5295 end;
5296
5297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5298 function TglBitmap.Clone: TglBitmap;
5299 var
5300   Temp: TglBitmap;
5301   TempPtr: PByte;
5302   Size: Integer;
5303 begin
5304   result := nil;
5305   Temp := (ClassType.Create as TglBitmap);
5306   try
5307     // copy texture data if assigned
5308     if Assigned(Data) then begin
5309       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5310       GetMem(TempPtr, Size);
5311       try
5312         Move(Data^, TempPtr^, Size);
5313         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5314       except
5315         if Assigned(TempPtr) then
5316           FreeMem(TempPtr);
5317         raise;
5318       end;
5319     end else begin
5320       TempPtr := nil;
5321       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5322     end;
5323
5324         // copy properties
5325     Temp.fID                      := ID;
5326     Temp.fTarget                  := Target;
5327     Temp.fFormat                  := Format;
5328     Temp.fMipMap                  := MipMap;
5329     Temp.fAnisotropic             := Anisotropic;
5330     Temp.fBorderColor             := fBorderColor;
5331     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5332     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5333     Temp.fFilterMin               := fFilterMin;
5334     Temp.fFilterMag               := fFilterMag;
5335     Temp.fWrapS                   := fWrapS;
5336     Temp.fWrapT                   := fWrapT;
5337     Temp.fWrapR                   := fWrapR;
5338     Temp.fFilename                := fFilename;
5339     Temp.fCustomName              := fCustomName;
5340     Temp.fCustomNameW             := fCustomNameW;
5341     Temp.fCustomData              := fCustomData;
5342
5343     result := Temp;
5344   except
5345     FreeAndNil(Temp);
5346     raise;
5347   end;
5348 end;
5349
5350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5351 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5352 var
5353   SourceFD, DestFD: TFormatDescriptor;
5354   SourcePD, DestPD: TglBitmapPixelData;
5355   ShiftData: TShiftData;
5356
5357   function CanCopyDirect: Boolean;
5358   begin
5359     result :=
5360       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5361       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5362       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5363       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5364   end;
5365
5366   function CanShift: Boolean;
5367   begin
5368     result :=
5369       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5370       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5371       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5372       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5373   end;
5374
5375   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5376   begin
5377     result := 0;
5378     while (aSource > aDest) and (aSource > 0) do begin
5379       inc(result);
5380       aSource := aSource shr 1;
5381     end;
5382   end;
5383
5384 begin
5385   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5386     SourceFD := TFormatDescriptor.Get(Format);
5387     DestFD   := TFormatDescriptor.Get(aFormat);
5388
5389     SourceFD.PreparePixel(SourcePD);
5390     DestFD.PreparePixel  (DestPD);
5391
5392     if CanCopyDirect then
5393       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5394     else if CanShift then begin
5395       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5396       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5397       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5398       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5399       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5400     end else
5401       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5402   end else
5403     result := true;
5404 end;
5405
5406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5407 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5408 begin
5409   if aUseRGB or aUseAlpha then
5410     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5411       ((Byte(aUseAlpha) and 1) shl 1) or
5412        (Byte(aUseRGB)   and 1)      ));
5413 end;
5414
5415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5417 begin
5418   fBorderColor[0] := aRed;
5419   fBorderColor[1] := aGreen;
5420   fBorderColor[2] := aBlue;
5421   fBorderColor[3] := aAlpha;
5422   if (ID > 0) then begin
5423     Bind(false);
5424     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5425   end;
5426 end;
5427
5428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5429 procedure TglBitmap.FreeData;
5430 var
5431   TempPtr: PByte;
5432 begin
5433   TempPtr := nil;
5434   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5439   const aAlpha: Byte);
5440 begin
5441   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5442 end;
5443
5444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5445 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5446 var
5447   PixelData: TglBitmapPixelData;
5448 begin
5449   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5450   FillWithColorFloat(
5451     aRed   / PixelData.Range.r,
5452     aGreen / PixelData.Range.g,
5453     aBlue  / PixelData.Range.b,
5454     aAlpha / PixelData.Range.a);
5455 end;
5456
5457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5458 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5459 var
5460   PixelData: TglBitmapPixelData;
5461 begin
5462   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5463   with PixelData do begin
5464     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5465     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5466     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5467     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5468   end;
5469   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5470 end;
5471
5472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5473 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5474 begin
5475   //check MIN filter
5476   case aMin of
5477     GL_NEAREST:
5478       fFilterMin := GL_NEAREST;
5479     GL_LINEAR:
5480       fFilterMin := GL_LINEAR;
5481     GL_NEAREST_MIPMAP_NEAREST:
5482       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5483     GL_LINEAR_MIPMAP_NEAREST:
5484       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5485     GL_NEAREST_MIPMAP_LINEAR:
5486       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5487     GL_LINEAR_MIPMAP_LINEAR:
5488       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5489     else
5490       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5491   end;
5492
5493   //check MAG filter
5494   case aMag of
5495     GL_NEAREST:
5496       fFilterMag := GL_NEAREST;
5497     GL_LINEAR:
5498       fFilterMag := GL_LINEAR;
5499     else
5500       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5501   end;
5502
5503   //apply filter
5504   if (ID > 0) then begin
5505     Bind(false);
5506     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5507
5508     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5509       case fFilterMin of
5510         GL_NEAREST, GL_LINEAR:
5511           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5512         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5513           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5514         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5515           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5516       end;
5517     end else
5518       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5519   end;
5520 end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5524
5525   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5526   begin
5527     case aValue of
5528       GL_CLAMP:
5529         aTarget := GL_CLAMP;
5530
5531       GL_REPEAT:
5532         aTarget := GL_REPEAT;
5533
5534       GL_CLAMP_TO_EDGE: begin
5535         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5536           aTarget := GL_CLAMP_TO_EDGE
5537         else
5538           aTarget := GL_CLAMP;
5539       end;
5540
5541       GL_CLAMP_TO_BORDER: begin
5542         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5543           aTarget := GL_CLAMP_TO_BORDER
5544         else
5545           aTarget := GL_CLAMP;
5546       end;
5547
5548       GL_MIRRORED_REPEAT: begin
5549         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5550           aTarget := GL_MIRRORED_REPEAT
5551         else
5552           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5553       end;
5554     else
5555       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5556     end;
5557   end;
5558
5559 begin
5560   CheckAndSetWrap(S, fWrapS);
5561   CheckAndSetWrap(T, fWrapT);
5562   CheckAndSetWrap(R, fWrapR);
5563
5564   if (ID > 0) then begin
5565     Bind(false);
5566     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5567     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5568     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5569   end;
5570 end;
5571
5572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5573 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5574
5575   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5576   begin
5577     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5578        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5579       fSwizzle[aIndex] := aValue
5580     else
5581       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5582   end;
5583
5584 begin
5585   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5586     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5587   CheckAndSetValue(r, 0);
5588   CheckAndSetValue(g, 1);
5589   CheckAndSetValue(b, 2);
5590   CheckAndSetValue(a, 3);
5591
5592   if (ID > 0) then begin
5593     Bind(false);
5594     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5595   end;
5596 end;
5597
5598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5599 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5600 begin
5601   if aEnableTextureUnit then
5602     glEnable(Target);
5603   if (ID > 0) then
5604     glBindTexture(Target, ID);
5605 end;
5606
5607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5608 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5609 begin
5610   if aDisableTextureUnit then
5611     glDisable(Target);
5612   glBindTexture(Target, 0);
5613 end;
5614
5615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5616 constructor TglBitmap.Create;
5617 begin
5618   if (ClassType = TglBitmap) then
5619     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5620 {$IFDEF GLB_NATIVE_OGL}
5621   glbReadOpenGLExtensions;
5622 {$ENDIF}
5623   inherited Create;
5624 end;
5625
5626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5627 constructor TglBitmap.Create(const aFileName: String);
5628 begin
5629   Create;
5630   LoadFromFile(aFileName);
5631 end;
5632
5633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5634 constructor TglBitmap.Create(const aStream: TStream);
5635 begin
5636   Create;
5637   LoadFromStream(aStream);
5638 end;
5639
5640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5641 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5642 var
5643   Image: PByte;
5644   ImageSize: Integer;
5645 begin
5646   Create;
5647   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5648   GetMem(Image, ImageSize);
5649   try
5650     FillChar(Image^, ImageSize, #$FF);
5651     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5652   except
5653     if Assigned(Image) then
5654       FreeMem(Image);
5655     raise;
5656   end;
5657 end;
5658
5659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5660 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5661   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5662 begin
5663   Create;
5664   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5665 end;
5666
5667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5668 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5669 begin
5670   Create;
5671   LoadFromResource(aInstance, aResource, aResType);
5672 end;
5673
5674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5675 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5676 begin
5677   Create;
5678   LoadFromResourceID(aInstance, aResourceID, aResType);
5679 end;
5680
5681 {$IFDEF GLB_SUPPORT_PNG_READ}
5682 {$IF DEFINED(GLB_LAZ_PNG)}
5683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5684 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5686 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5687 const
5688   MAGIC_LEN = 8;
5689   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5690 var
5691   png: TPortableNetworkGraphic;
5692   intf: TLazIntfImage;
5693   StreamPos: Int64;
5694   magic: String[MAGIC_LEN];
5695 begin
5696   result := true;
5697   StreamPos := aStream.Position;
5698
5699   SetLength(magic, MAGIC_LEN);
5700   aStream.Read(magic[1], MAGIC_LEN);
5701   aStream.Position := StreamPos;
5702   if (magic <> PNG_MAGIC) then begin
5703     result := false;
5704     exit;
5705   end;
5706
5707   png := TPortableNetworkGraphic.Create;
5708   try try
5709     png.LoadFromStream(aStream);
5710     intf := png.CreateIntfImage;
5711     try try
5712       AssignFromLazIntfImage(intf);
5713     except
5714       result := false;
5715       aStream.Position := StreamPos;
5716       exit;
5717     end;
5718     finally
5719       intf.Free;
5720     end;
5721   except
5722     result := false;
5723     aStream.Position := StreamPos;
5724     exit;
5725   end;
5726   finally
5727     png.Free;
5728   end;
5729 end;
5730
5731 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5733 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5734 var
5735   Surface: PSDL_Surface;
5736   RWops: PSDL_RWops;
5737 begin
5738   result := false;
5739   RWops := glBitmapCreateRWops(aStream);
5740   try
5741     if IMG_isPNG(RWops) > 0 then begin
5742       Surface := IMG_LoadPNG_RW(RWops);
5743       try
5744         AssignFromSurface(Surface);
5745         result := true;
5746       finally
5747         SDL_FreeSurface(Surface);
5748       end;
5749     end;
5750   finally
5751     SDL_FreeRW(RWops);
5752   end;
5753 end;
5754
5755 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5757 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5758 begin
5759   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5760 end;
5761
5762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5763 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5764 var
5765   StreamPos: Int64;
5766   signature: array [0..7] of byte;
5767   png: png_structp;
5768   png_info: png_infop;
5769
5770   TempHeight, TempWidth: Integer;
5771   Format: TglBitmapFormat;
5772
5773   png_data: pByte;
5774   png_rows: array of pByte;
5775   Row, LineSize: Integer;
5776 begin
5777   result := false;
5778
5779   if not init_libPNG then
5780     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5781
5782   try
5783     // signature
5784     StreamPos := aStream.Position;
5785     aStream.Read(signature{%H-}, 8);
5786     aStream.Position := StreamPos;
5787
5788     if png_check_sig(@signature, 8) <> 0 then begin
5789       // png read struct
5790       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5791       if png = nil then
5792         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5793
5794       // png info
5795       png_info := png_create_info_struct(png);
5796       if png_info = nil then begin
5797         png_destroy_read_struct(@png, nil, nil);
5798         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5799       end;
5800
5801       // set read callback
5802       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5803
5804       // read informations
5805       png_read_info(png, png_info);
5806
5807       // size
5808       TempHeight := png_get_image_height(png, png_info);
5809       TempWidth := png_get_image_width(png, png_info);
5810
5811       // format
5812       case png_get_color_type(png, png_info) of
5813         PNG_COLOR_TYPE_GRAY:
5814           Format := tfLuminance8;
5815         PNG_COLOR_TYPE_GRAY_ALPHA:
5816           Format := tfLuminance8Alpha8;
5817         PNG_COLOR_TYPE_RGB:
5818           Format := tfRGB8;
5819         PNG_COLOR_TYPE_RGB_ALPHA:
5820           Format := tfRGBA8;
5821         else
5822           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5823       end;
5824
5825       // cut upper 8 bit from 16 bit formats
5826       if png_get_bit_depth(png, png_info) > 8 then
5827         png_set_strip_16(png);
5828
5829       // expand bitdepth smaller than 8
5830       if png_get_bit_depth(png, png_info) < 8 then
5831         png_set_expand(png);
5832
5833       // allocating mem for scanlines
5834       LineSize := png_get_rowbytes(png, png_info);
5835       GetMem(png_data, TempHeight * LineSize);
5836       try
5837         SetLength(png_rows, TempHeight);
5838         for Row := Low(png_rows) to High(png_rows) do begin
5839           png_rows[Row] := png_data;
5840           Inc(png_rows[Row], Row * LineSize);
5841         end;
5842
5843         // read complete image into scanlines
5844         png_read_image(png, @png_rows[0]);
5845
5846         // read end
5847         png_read_end(png, png_info);
5848
5849         // destroy read struct
5850         png_destroy_read_struct(@png, @png_info, nil);
5851
5852         SetLength(png_rows, 0);
5853
5854         // set new data
5855         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5856
5857         result := true;
5858       except
5859         if Assigned(png_data) then
5860           FreeMem(png_data);
5861         raise;
5862       end;
5863     end;
5864   finally
5865     quit_libPNG;
5866   end;
5867 end;
5868
5869 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5871 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5872 var
5873   StreamPos: Int64;
5874   Png: TPNGObject;
5875   Header: String[8];
5876   Row, Col, PixSize, LineSize: Integer;
5877   NewImage, pSource, pDest, pAlpha: pByte;
5878   PngFormat: TglBitmapFormat;
5879   FormatDesc: TFormatDescriptor;
5880
5881 const
5882   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5883
5884 begin
5885   result := false;
5886
5887   StreamPos := aStream.Position;
5888   aStream.Read(Header[0], SizeOf(Header));
5889   aStream.Position := StreamPos;
5890
5891   {Test if the header matches}
5892   if Header = PngHeader then begin
5893     Png := TPNGObject.Create;
5894     try
5895       Png.LoadFromStream(aStream);
5896
5897       case Png.Header.ColorType of
5898         COLOR_GRAYSCALE:
5899           PngFormat := tfLuminance8;
5900         COLOR_GRAYSCALEALPHA:
5901           PngFormat := tfLuminance8Alpha8;
5902         COLOR_RGB:
5903           PngFormat := tfBGR8;
5904         COLOR_RGBALPHA:
5905           PngFormat := tfBGRA8;
5906         else
5907           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5908       end;
5909
5910       FormatDesc := TFormatDescriptor.Get(PngFormat);
5911       PixSize    := Round(FormatDesc.PixelSize);
5912       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5913
5914       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5915       try
5916         pDest := NewImage;
5917
5918         case Png.Header.ColorType of
5919           COLOR_RGB, COLOR_GRAYSCALE:
5920             begin
5921               for Row := 0 to Png.Height -1 do begin
5922                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5923                 Inc(pDest, LineSize);
5924               end;
5925             end;
5926           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5927             begin
5928               PixSize := PixSize -1;
5929
5930               for Row := 0 to Png.Height -1 do begin
5931                 pSource := Png.Scanline[Row];
5932                 pAlpha := pByte(Png.AlphaScanline[Row]);
5933
5934                 for Col := 0 to Png.Width -1 do begin
5935                   Move (pSource^, pDest^, PixSize);
5936                   Inc(pSource, PixSize);
5937                   Inc(pDest, PixSize);
5938
5939                   pDest^ := pAlpha^;
5940                   inc(pAlpha);
5941                   Inc(pDest);
5942                 end;
5943               end;
5944             end;
5945           else
5946             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5947         end;
5948
5949         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5950
5951         result := true;
5952       except
5953         if Assigned(NewImage) then
5954           FreeMem(NewImage);
5955         raise;
5956       end;
5957     finally
5958       Png.Free;
5959     end;
5960   end;
5961 end;
5962 {$IFEND}
5963 {$ENDIF}
5964
5965 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5966 {$IFDEF GLB_LIB_PNG}
5967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5968 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5969 begin
5970   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5971 end;
5972 {$ENDIF}
5973
5974 {$IF DEFINED(GLB_LAZ_PNG)}
5975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5976 procedure TglBitmap.SavePNG(const aStream: TStream);
5977 var
5978   png: TPortableNetworkGraphic;
5979   intf: TLazIntfImage;
5980 begin
5981   png  := TPortableNetworkGraphic.Create;
5982   intf := TLazIntfImage.Create(0, 0);
5983   try
5984     if not AssignToLazIntfImage(intf) then
5985       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5986     png.LoadFromIntfImage(intf);
5987     png.SaveToStream(aStream);
5988   finally
5989     png.Free;
5990     intf.Free;
5991   end;
5992 end;
5993
5994 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5996 procedure TglBitmap.SavePNG(const aStream: TStream);
5997 var
5998   png: png_structp;
5999   png_info: png_infop;
6000   png_rows: array of pByte;
6001   LineSize: Integer;
6002   ColorType: Integer;
6003   Row: Integer;
6004   FormatDesc: TFormatDescriptor;
6005 begin
6006   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6007     raise EglBitmapUnsupportedFormat.Create(Format);
6008
6009   if not init_libPNG then
6010     raise Exception.Create('unable to initialize libPNG.');
6011
6012   try
6013     case Format of
6014       tfAlpha8, tfLuminance8:
6015         ColorType := PNG_COLOR_TYPE_GRAY;
6016       tfLuminance8Alpha8:
6017         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6018       tfBGR8, tfRGB8:
6019         ColorType := PNG_COLOR_TYPE_RGB;
6020       tfBGRA8, tfRGBA8:
6021         ColorType := PNG_COLOR_TYPE_RGBA;
6022       else
6023         raise EglBitmapUnsupportedFormat.Create(Format);
6024     end;
6025
6026     FormatDesc := TFormatDescriptor.Get(Format);
6027     LineSize := FormatDesc.GetSize(Width, 1);
6028
6029     // creating array for scanline
6030     SetLength(png_rows, Height);
6031     try
6032       for Row := 0 to Height - 1 do begin
6033         png_rows[Row] := Data;
6034         Inc(png_rows[Row], Row * LineSize)
6035       end;
6036
6037       // write struct
6038       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6039       if png = nil then
6040         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6041
6042       // create png info
6043       png_info := png_create_info_struct(png);
6044       if png_info = nil then begin
6045         png_destroy_write_struct(@png, nil);
6046         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6047       end;
6048
6049       // set read callback
6050       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6051
6052       // set compression
6053       png_set_compression_level(png, 6);
6054
6055       if Format in [tfBGR8, tfBGRA8] then
6056         png_set_bgr(png);
6057
6058       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6059       png_write_info(png, png_info);
6060       png_write_image(png, @png_rows[0]);
6061       png_write_end(png, png_info);
6062       png_destroy_write_struct(@png, @png_info);
6063     finally
6064       SetLength(png_rows, 0);
6065     end;
6066   finally
6067     quit_libPNG;
6068   end;
6069 end;
6070
6071 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6073 procedure TglBitmap.SavePNG(const aStream: TStream);
6074 var
6075   Png: TPNGObject;
6076
6077   pSource, pDest: pByte;
6078   X, Y, PixSize: Integer;
6079   ColorType: Cardinal;
6080   Alpha: Boolean;
6081
6082   pTemp: pByte;
6083   Temp: Byte;
6084 begin
6085   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6086     raise EglBitmapUnsupportedFormat.Create(Format);
6087
6088   case Format of
6089     tfAlpha8, tfLuminance8: begin
6090       ColorType := COLOR_GRAYSCALE;
6091       PixSize   := 1;
6092       Alpha     := false;
6093     end;
6094     tfLuminance8Alpha8: begin
6095       ColorType := COLOR_GRAYSCALEALPHA;
6096       PixSize   := 1;
6097       Alpha     := true;
6098     end;
6099     tfBGR8, tfRGB8: begin
6100       ColorType := COLOR_RGB;
6101       PixSize   := 3;
6102       Alpha     := false;
6103     end;
6104     tfBGRA8, tfRGBA8: begin
6105       ColorType := COLOR_RGBALPHA;
6106       PixSize   := 3;
6107       Alpha     := true
6108     end;
6109   else
6110     raise EglBitmapUnsupportedFormat.Create(Format);
6111   end;
6112
6113   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6114   try
6115     // Copy ImageData
6116     pSource := Data;
6117     for Y := 0 to Height -1 do begin
6118       pDest := png.ScanLine[Y];
6119       for X := 0 to Width -1 do begin
6120         Move(pSource^, pDest^, PixSize);
6121         Inc(pDest, PixSize);
6122         Inc(pSource, PixSize);
6123         if Alpha then begin
6124           png.AlphaScanline[Y]^[X] := pSource^;
6125           Inc(pSource);
6126         end;
6127       end;
6128
6129       // convert RGB line to BGR
6130       if Format in [tfRGB8, tfRGBA8] then begin
6131         pTemp := png.ScanLine[Y];
6132         for X := 0 to Width -1 do begin
6133           Temp := pByteArray(pTemp)^[0];
6134           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6135           pByteArray(pTemp)^[2] := Temp;
6136           Inc(pTemp, 3);
6137         end;
6138       end;
6139     end;
6140
6141     // Save to Stream
6142     Png.CompressionLevel := 6;
6143     Png.SaveToStream(aStream);
6144   finally
6145     FreeAndNil(Png);
6146   end;
6147 end;
6148 {$IFEND}
6149 {$ENDIF}
6150
6151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6152 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6154 {$IFDEF GLB_LIB_JPEG}
6155 type
6156   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6157   glBitmap_libJPEG_source_mgr = record
6158     pub: jpeg_source_mgr;
6159
6160     SrcStream: TStream;
6161     SrcBuffer: array [1..4096] of byte;
6162   end;
6163
6164   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6165   glBitmap_libJPEG_dest_mgr = record
6166     pub: jpeg_destination_mgr;
6167
6168     DestStream: TStream;
6169     DestBuffer: array [1..4096] of byte;
6170   end;
6171
6172 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6173 begin
6174   //DUMMY
6175 end;
6176
6177
6178 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6179 begin
6180   //DUMMY
6181 end;
6182
6183
6184 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6185 begin
6186   //DUMMY
6187 end;
6188
6189 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6190 begin
6191   //DUMMY
6192 end;
6193
6194
6195 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6196 begin
6197   //DUMMY
6198 end;
6199
6200
6201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6202 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6203 var
6204   src: glBitmap_libJPEG_source_mgr_ptr;
6205   bytes: integer;
6206 begin
6207   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6208
6209   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6210         if (bytes <= 0) then begin
6211                 src^.SrcBuffer[1] := $FF;
6212                 src^.SrcBuffer[2] := JPEG_EOI;
6213                 bytes := 2;
6214         end;
6215
6216         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6217         src^.pub.bytes_in_buffer := bytes;
6218
6219   result := true;
6220 end;
6221
6222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6223 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6224 var
6225   src: glBitmap_libJPEG_source_mgr_ptr;
6226 begin
6227   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6228
6229   if num_bytes > 0 then begin
6230     // wanted byte isn't in buffer so set stream position and read buffer
6231     if num_bytes > src^.pub.bytes_in_buffer then begin
6232       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6233       src^.pub.fill_input_buffer(cinfo);
6234     end else begin
6235       // wanted byte is in buffer so only skip
6236                 inc(src^.pub.next_input_byte, num_bytes);
6237                 dec(src^.pub.bytes_in_buffer, num_bytes);
6238     end;
6239   end;
6240 end;
6241
6242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6243 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6244 var
6245   dest: glBitmap_libJPEG_dest_mgr_ptr;
6246 begin
6247   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6248
6249   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6250     // write complete buffer
6251     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6252
6253     // reset buffer
6254     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6255     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6256   end;
6257
6258   result := true;
6259 end;
6260
6261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6262 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6263 var
6264   Idx: Integer;
6265   dest: glBitmap_libJPEG_dest_mgr_ptr;
6266 begin
6267   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6268
6269   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6270     // check for endblock
6271     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6272       // write endblock
6273       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6274
6275       // leave
6276       break;
6277     end else
6278       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6279   end;
6280 end;
6281 {$ENDIF}
6282
6283 {$IFDEF GLB_SUPPORT_JPEG_READ}
6284 {$IF DEFINED(GLB_LAZ_JPEG)}
6285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6286 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6287 const
6288   MAGIC_LEN = 2;
6289   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6290 var
6291   jpeg: TJPEGImage;
6292   intf: TLazIntfImage;
6293   StreamPos: Int64;
6294   magic: String[MAGIC_LEN];
6295 begin
6296   result := true;
6297   StreamPos := aStream.Position;
6298
6299   SetLength(magic, MAGIC_LEN);
6300   aStream.Read(magic[1], MAGIC_LEN);
6301   aStream.Position := StreamPos;
6302   if (magic <> JPEG_MAGIC) then begin
6303     result := false;
6304     exit;
6305   end;
6306
6307   jpeg := TJPEGImage.Create;
6308   try try
6309     jpeg.LoadFromStream(aStream);
6310     intf := TLazIntfImage.Create(0, 0);
6311     try try
6312       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6313       AssignFromLazIntfImage(intf);
6314     except
6315       result := false;
6316       aStream.Position := StreamPos;
6317       exit;
6318     end;
6319     finally
6320       intf.Free;
6321     end;
6322   except
6323     result := false;
6324     aStream.Position := StreamPos;
6325     exit;
6326   end;
6327   finally
6328     jpeg.Free;
6329   end;
6330 end;
6331
6332 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6334 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6335 var
6336   Surface: PSDL_Surface;
6337   RWops: PSDL_RWops;
6338 begin
6339   result := false;
6340
6341   RWops := glBitmapCreateRWops(aStream);
6342   try
6343     if IMG_isJPG(RWops) > 0 then begin
6344       Surface := IMG_LoadJPG_RW(RWops);
6345       try
6346         AssignFromSurface(Surface);
6347         result := true;
6348       finally
6349         SDL_FreeSurface(Surface);
6350       end;
6351     end;
6352   finally
6353     SDL_FreeRW(RWops);
6354   end;
6355 end;
6356
6357 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6359 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6360 var
6361   StreamPos: Int64;
6362   Temp: array[0..1]of Byte;
6363
6364   jpeg: jpeg_decompress_struct;
6365   jpeg_err: jpeg_error_mgr;
6366
6367   IntFormat: TglBitmapFormat;
6368   pImage: pByte;
6369   TempHeight, TempWidth: Integer;
6370
6371   pTemp: pByte;
6372   Row: Integer;
6373
6374   FormatDesc: TFormatDescriptor;
6375 begin
6376   result := false;
6377
6378   if not init_libJPEG then
6379     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6380
6381   try
6382     // reading first two bytes to test file and set cursor back to begin
6383     StreamPos := aStream.Position;
6384     aStream.Read({%H-}Temp[0], 2);
6385     aStream.Position := StreamPos;
6386
6387     // if Bitmap then read file.
6388     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6389       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6390       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6391
6392       // error managment
6393       jpeg.err := jpeg_std_error(@jpeg_err);
6394       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6395       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6396
6397       // decompression struct
6398       jpeg_create_decompress(@jpeg);
6399
6400       // allocation space for streaming methods
6401       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6402
6403       // seeting up custom functions
6404       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6405         pub.init_source       := glBitmap_libJPEG_init_source;
6406         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6407         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6408         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6409         pub.term_source       := glBitmap_libJPEG_term_source;
6410
6411         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6412         pub.next_input_byte := nil;   // until buffer loaded
6413
6414         SrcStream := aStream;
6415       end;
6416
6417       // set global decoding state
6418       jpeg.global_state := DSTATE_START;
6419
6420       // read header of jpeg
6421       jpeg_read_header(@jpeg, false);
6422
6423       // setting output parameter
6424       case jpeg.jpeg_color_space of
6425         JCS_GRAYSCALE:
6426           begin
6427             jpeg.out_color_space := JCS_GRAYSCALE;
6428             IntFormat := tfLuminance8;
6429           end;
6430         else
6431           jpeg.out_color_space := JCS_RGB;
6432           IntFormat := tfRGB8;
6433       end;
6434
6435       // reading image
6436       jpeg_start_decompress(@jpeg);
6437
6438       TempHeight := jpeg.output_height;
6439       TempWidth := jpeg.output_width;
6440
6441       FormatDesc := TFormatDescriptor.Get(IntFormat);
6442
6443       // creating new image
6444       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6445       try
6446         pTemp := pImage;
6447
6448         for Row := 0 to TempHeight -1 do begin
6449           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6450           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6451         end;
6452
6453         // finish decompression
6454         jpeg_finish_decompress(@jpeg);
6455
6456         // destroy decompression
6457         jpeg_destroy_decompress(@jpeg);
6458
6459         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6460
6461         result := true;
6462       except
6463         if Assigned(pImage) then
6464           FreeMem(pImage);
6465         raise;
6466       end;
6467     end;
6468   finally
6469     quit_libJPEG;
6470   end;
6471 end;
6472
6473 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6475 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6476 var
6477   bmp: TBitmap;
6478   jpg: TJPEGImage;
6479   StreamPos: Int64;
6480   Temp: array[0..1]of Byte;
6481 begin
6482   result := false;
6483
6484   // reading first two bytes to test file and set cursor back to begin
6485   StreamPos := aStream.Position;
6486   aStream.Read(Temp[0], 2);
6487   aStream.Position := StreamPos;
6488
6489   // if Bitmap then read file.
6490   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6491     bmp := TBitmap.Create;
6492     try
6493       jpg := TJPEGImage.Create;
6494       try
6495         jpg.LoadFromStream(aStream);
6496         bmp.Assign(jpg);
6497         result := AssignFromBitmap(bmp);
6498       finally
6499         jpg.Free;
6500       end;
6501     finally
6502       bmp.Free;
6503     end;
6504   end;
6505 end;
6506 {$IFEND}
6507 {$ENDIF}
6508
6509 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6510 {$IF DEFINED(GLB_LAZ_JPEG)}
6511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6512 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6513 var
6514   jpeg: TJPEGImage;
6515   intf: TLazIntfImage;
6516 begin
6517   jpeg := TJPEGImage.Create;
6518   intf := TLazIntfImage.Create(0, 0);
6519   try
6520     if not AssignToLazIntfImage(intf) then
6521       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6522     jpeg.LoadFromIntfImage(intf);
6523     jpeg.SaveToStream(aStream);
6524   finally
6525     intf.Free;
6526     jpeg.Free;
6527   end;
6528 end;
6529
6530 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6532 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6533 var
6534   jpeg: jpeg_compress_struct;
6535   jpeg_err: jpeg_error_mgr;
6536   Row: Integer;
6537   pTemp, pTemp2: pByte;
6538
6539   procedure CopyRow(pDest, pSource: pByte);
6540   var
6541     X: Integer;
6542   begin
6543     for X := 0 to Width - 1 do begin
6544       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6545       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6546       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6547       Inc(pDest, 3);
6548       Inc(pSource, 3);
6549     end;
6550   end;
6551
6552 begin
6553   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6554     raise EglBitmapUnsupportedFormat.Create(Format);
6555
6556   if not init_libJPEG then
6557     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6558
6559   try
6560     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6561     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6562
6563     // error managment
6564     jpeg.err := jpeg_std_error(@jpeg_err);
6565     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6566     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6567
6568     // compression struct
6569     jpeg_create_compress(@jpeg);
6570
6571     // allocation space for streaming methods
6572     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6573
6574     // seeting up custom functions
6575     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6576       pub.init_destination    := glBitmap_libJPEG_init_destination;
6577       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6578       pub.term_destination    := glBitmap_libJPEG_term_destination;
6579
6580       pub.next_output_byte  := @DestBuffer[1];
6581       pub.free_in_buffer    := Length(DestBuffer);
6582
6583       DestStream := aStream;
6584     end;
6585
6586     // very important state
6587     jpeg.global_state := CSTATE_START;
6588     jpeg.image_width  := Width;
6589     jpeg.image_height := Height;
6590     case Format of
6591       tfAlpha8, tfLuminance8: begin
6592         jpeg.input_components := 1;
6593         jpeg.in_color_space   := JCS_GRAYSCALE;
6594       end;
6595       tfRGB8, tfBGR8: begin
6596         jpeg.input_components := 3;
6597         jpeg.in_color_space   := JCS_RGB;
6598       end;
6599     end;
6600
6601     jpeg_set_defaults(@jpeg);
6602     jpeg_set_quality(@jpeg, 95, true);
6603     jpeg_start_compress(@jpeg, true);
6604     pTemp := Data;
6605
6606     if Format = tfBGR8 then
6607       GetMem(pTemp2, fRowSize)
6608     else
6609       pTemp2 := pTemp;
6610
6611     try
6612       for Row := 0 to jpeg.image_height -1 do begin
6613         // prepare row
6614         if Format = tfBGR8 then
6615           CopyRow(pTemp2, pTemp)
6616         else
6617           pTemp2 := pTemp;
6618
6619         // write row
6620         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6621         inc(pTemp, fRowSize);
6622       end;
6623     finally
6624       // free memory
6625       if Format = tfBGR8 then
6626         FreeMem(pTemp2);
6627     end;
6628     jpeg_finish_compress(@jpeg);
6629     jpeg_destroy_compress(@jpeg);
6630   finally
6631     quit_libJPEG;
6632   end;
6633 end;
6634
6635 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6637 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6638 var
6639   Bmp: TBitmap;
6640   Jpg: TJPEGImage;
6641 begin
6642   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6643     raise EglBitmapUnsupportedFormat.Create(Format);
6644
6645   Bmp := TBitmap.Create;
6646   try
6647     Jpg := TJPEGImage.Create;
6648     try
6649       AssignToBitmap(Bmp);
6650       if (Format in [tfAlpha8, tfLuminance8]) then begin
6651         Jpg.Grayscale   := true;
6652         Jpg.PixelFormat := jf8Bit;
6653       end;
6654       Jpg.Assign(Bmp);
6655       Jpg.SaveToStream(aStream);
6656     finally
6657       FreeAndNil(Jpg);
6658     end;
6659   finally
6660     FreeAndNil(Bmp);
6661   end;
6662 end;
6663 {$IFEND}
6664 {$ENDIF}
6665
6666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6667 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6669 const
6670   BMP_MAGIC          = $4D42;
6671
6672   BMP_COMP_RGB       = 0;
6673   BMP_COMP_RLE8      = 1;
6674   BMP_COMP_RLE4      = 2;
6675   BMP_COMP_BITFIELDS = 3;
6676
6677 type
6678   TBMPHeader = packed record
6679     bfType: Word;
6680     bfSize: Cardinal;
6681     bfReserved1: Word;
6682     bfReserved2: Word;
6683     bfOffBits: Cardinal;
6684   end;
6685
6686   TBMPInfo = packed record
6687     biSize: Cardinal;
6688     biWidth: Longint;
6689     biHeight: Longint;
6690     biPlanes: Word;
6691     biBitCount: Word;
6692     biCompression: Cardinal;
6693     biSizeImage: Cardinal;
6694     biXPelsPerMeter: Longint;
6695     biYPelsPerMeter: Longint;
6696     biClrUsed: Cardinal;
6697     biClrImportant: Cardinal;
6698   end;
6699
6700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6701 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6702
6703   //////////////////////////////////////////////////////////////////////////////////////////////////
6704   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6705   begin
6706     result := tfEmpty;
6707     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6708     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6709
6710     //Read Compression
6711     case aInfo.biCompression of
6712       BMP_COMP_RLE4,
6713       BMP_COMP_RLE8: begin
6714         raise EglBitmap.Create('RLE compression is not supported');
6715       end;
6716       BMP_COMP_BITFIELDS: begin
6717         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6718           aStream.Read(aMask.r, SizeOf(aMask.r));
6719           aStream.Read(aMask.g, SizeOf(aMask.g));
6720           aStream.Read(aMask.b, SizeOf(aMask.b));
6721           aStream.Read(aMask.a, SizeOf(aMask.a));
6722         end else
6723           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6724       end;
6725     end;
6726
6727     //get suitable format
6728     case aInfo.biBitCount of
6729        8: result := tfLuminance8;
6730       16: result := tfBGR5;
6731       24: result := tfBGR8;
6732       32: result := tfBGRA8;
6733     end;
6734   end;
6735
6736   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6737   var
6738     i, c: Integer;
6739     ColorTable: TbmpColorTable;
6740   begin
6741     result := nil;
6742     if (aInfo.biBitCount >= 16) then
6743       exit;
6744     aFormat := tfLuminance8;
6745     c := aInfo.biClrUsed;
6746     if (c = 0) then
6747       c := 1 shl aInfo.biBitCount;
6748     SetLength(ColorTable, c);
6749     for i := 0 to c-1 do begin
6750       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6751       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6752         aFormat := tfRGB8;
6753     end;
6754
6755     result := TbmpColorTableFormat.Create;
6756     result.PixelSize  := aInfo.biBitCount / 8;
6757     result.ColorTable := ColorTable;
6758     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6759   end;
6760
6761   //////////////////////////////////////////////////////////////////////////////////////////////////
6762   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6763     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6764   var
6765     TmpFormat: TglBitmapFormat;
6766     FormatDesc: TFormatDescriptor;
6767   begin
6768     result := nil;
6769     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6770       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6771         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6772         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6773           aFormat := FormatDesc.Format;
6774           exit;
6775         end;
6776       end;
6777
6778       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6779         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6780       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6781         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6782
6783       result := TbmpBitfieldFormat.Create;
6784       result.PixelSize := aInfo.biBitCount / 8;
6785       result.RedMask   := aMask.r;
6786       result.GreenMask := aMask.g;
6787       result.BlueMask  := aMask.b;
6788       result.AlphaMask := aMask.a;
6789     end;
6790   end;
6791
6792 var
6793   //simple types
6794   StartPos: Int64;
6795   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6796   PaddingBuff: Cardinal;
6797   LineBuf, ImageData, TmpData: PByte;
6798   SourceMD, DestMD: Pointer;
6799   BmpFormat: TglBitmapFormat;
6800
6801   //records
6802   Mask: TglBitmapColorRec;
6803   Header: TBMPHeader;
6804   Info: TBMPInfo;
6805
6806   //classes
6807   SpecialFormat: TFormatDescriptor;
6808   FormatDesc: TFormatDescriptor;
6809
6810   //////////////////////////////////////////////////////////////////////////////////////////////////
6811   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6812   var
6813     i: Integer;
6814     Pixel: TglBitmapPixelData;
6815   begin
6816     aStream.Read(aLineBuf^, rbLineSize);
6817     SpecialFormat.PreparePixel(Pixel);
6818     for i := 0 to Info.biWidth-1 do begin
6819       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6820       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6821       FormatDesc.Map(Pixel, aData, DestMD);
6822     end;
6823   end;
6824
6825 begin
6826   result        := false;
6827   BmpFormat     := tfEmpty;
6828   SpecialFormat := nil;
6829   LineBuf       := nil;
6830   SourceMD      := nil;
6831   DestMD        := nil;
6832
6833   // Header
6834   StartPos := aStream.Position;
6835   aStream.Read(Header{%H-}, SizeOf(Header));
6836
6837   if Header.bfType = BMP_MAGIC then begin
6838     try try
6839       BmpFormat        := ReadInfo(Info, Mask);
6840       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6841       if not Assigned(SpecialFormat) then
6842         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6843       aStream.Position := StartPos + Header.bfOffBits;
6844
6845       if (BmpFormat <> tfEmpty) then begin
6846         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6847         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6848         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6849         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6850
6851         //get Memory
6852         DestMD    := FormatDesc.CreateMappingData;
6853         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6854         GetMem(ImageData, ImageSize);
6855         if Assigned(SpecialFormat) then begin
6856           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6857           SourceMD := SpecialFormat.CreateMappingData;
6858         end;
6859
6860         //read Data
6861         try try
6862           FillChar(ImageData^, ImageSize, $FF);
6863           TmpData := ImageData;
6864           if (Info.biHeight > 0) then
6865             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6866           for i := 0 to Abs(Info.biHeight)-1 do begin
6867             if Assigned(SpecialFormat) then
6868               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6869             else
6870               aStream.Read(TmpData^, wbLineSize);   //else only read data
6871             if (Info.biHeight > 0) then
6872               dec(TmpData, wbLineSize)
6873             else
6874               inc(TmpData, wbLineSize);
6875             aStream.Read(PaddingBuff{%H-}, Padding);
6876           end;
6877           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6878           result := true;
6879         finally
6880           if Assigned(LineBuf) then
6881             FreeMem(LineBuf);
6882           if Assigned(SourceMD) then
6883             SpecialFormat.FreeMappingData(SourceMD);
6884           FormatDesc.FreeMappingData(DestMD);
6885         end;
6886         except
6887           if Assigned(ImageData) then
6888             FreeMem(ImageData);
6889           raise;
6890         end;
6891       end else
6892         raise EglBitmap.Create('LoadBMP - No suitable format found');
6893     except
6894       aStream.Position := StartPos;
6895       raise;
6896     end;
6897     finally
6898       FreeAndNil(SpecialFormat);
6899     end;
6900   end
6901     else aStream.Position := StartPos;
6902 end;
6903
6904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6905 procedure TglBitmap.SaveBMP(const aStream: TStream);
6906 var
6907   Header: TBMPHeader;
6908   Info: TBMPInfo;
6909   Converter: TFormatDescriptor;
6910   FormatDesc: TFormatDescriptor;
6911   SourceFD, DestFD: Pointer;
6912   pData, srcData, dstData, ConvertBuffer: pByte;
6913
6914   Pixel: TglBitmapPixelData;
6915   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6916   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6917
6918   PaddingBuff: Cardinal;
6919
6920   function GetLineWidth : Integer;
6921   begin
6922     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6923   end;
6924
6925 begin
6926   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6927     raise EglBitmapUnsupportedFormat.Create(Format);
6928
6929   Converter  := nil;
6930   FormatDesc := TFormatDescriptor.Get(Format);
6931   ImageSize  := FormatDesc.GetSize(Dimension);
6932
6933   FillChar(Header{%H-}, SizeOf(Header), 0);
6934   Header.bfType      := BMP_MAGIC;
6935   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6936   Header.bfReserved1 := 0;
6937   Header.bfReserved2 := 0;
6938   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6939
6940   FillChar(Info{%H-}, SizeOf(Info), 0);
6941   Info.biSize        := SizeOf(Info);
6942   Info.biWidth       := Width;
6943   Info.biHeight      := Height;
6944   Info.biPlanes      := 1;
6945   Info.biCompression := BMP_COMP_RGB;
6946   Info.biSizeImage   := ImageSize;
6947
6948   try
6949     case Format of
6950       tfLuminance4: begin
6951         Info.biBitCount  := 4;
6952         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6953         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6954         Converter := TbmpColorTableFormat.Create;
6955         with (Converter as TbmpColorTableFormat) do begin
6956           PixelSize := 0.5;
6957           Format    := Format;
6958           Range     := glBitmapColorRec($F, $F, $F, $0);
6959           CreateColorTable;
6960         end;
6961       end;
6962
6963       tfR3G3B2, tfLuminance8: begin
6964         Info.biBitCount  :=  8;
6965         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6966         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6967         Converter := TbmpColorTableFormat.Create;
6968         with (Converter as TbmpColorTableFormat) do begin
6969           PixelSize := 1;
6970           Format    := Format;
6971           if (Format = tfR3G3B2) then begin
6972             Range := glBitmapColorRec($7, $7, $3, $0);
6973             Shift := glBitmapShiftRec(0, 3, 6, 0);
6974           end else
6975             Range := glBitmapColorRec($FF, $FF, $FF, $0);
6976           CreateColorTable;
6977         end;
6978       end;
6979
6980       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6981       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6982         Info.biBitCount    := 16;
6983         Info.biCompression := BMP_COMP_BITFIELDS;
6984       end;
6985
6986       tfBGR8, tfRGB8: begin
6987         Info.biBitCount := 24;
6988         if (Format = tfRGB8) then
6989           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
6990       end;
6991
6992       tfRGB10, tfRGB10A2, tfRGBA8,
6993       tfBGR10, tfBGR10A2, tfBGRA8: begin
6994         Info.biBitCount    := 32;
6995         Info.biCompression := BMP_COMP_BITFIELDS;
6996       end;
6997     else
6998       raise EglBitmapUnsupportedFormat.Create(Format);
6999     end;
7000     Info.biXPelsPerMeter := 2835;
7001     Info.biYPelsPerMeter := 2835;
7002
7003     // prepare bitmasks
7004     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7005       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7006       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7007
7008       RedMask    := FormatDesc.RedMask;
7009       GreenMask  := FormatDesc.GreenMask;
7010       BlueMask   := FormatDesc.BlueMask;
7011       AlphaMask  := FormatDesc.AlphaMask;
7012     end;
7013
7014     // headers
7015     aStream.Write(Header, SizeOf(Header));
7016     aStream.Write(Info, SizeOf(Info));
7017
7018     // colortable
7019     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7020       with (Converter as TbmpColorTableFormat) do
7021         aStream.Write(ColorTable[0].b,
7022           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7023
7024     // bitmasks
7025     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7026       aStream.Write(RedMask,   SizeOf(Cardinal));
7027       aStream.Write(GreenMask, SizeOf(Cardinal));
7028       aStream.Write(BlueMask,  SizeOf(Cardinal));
7029       aStream.Write(AlphaMask, SizeOf(Cardinal));
7030     end;
7031
7032     // image data
7033     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7034     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7035     Padding     := GetLineWidth - wbLineSize;
7036     PaddingBuff := 0;
7037
7038     pData := Data;
7039     inc(pData, (Height-1) * rbLineSize);
7040
7041     // prepare row buffer. But only for RGB because RGBA supports color masks
7042     // so it's possible to change color within the image.
7043     if Assigned(Converter) then begin
7044       FormatDesc.PreparePixel(Pixel);
7045       GetMem(ConvertBuffer, wbLineSize);
7046       SourceFD := FormatDesc.CreateMappingData;
7047       DestFD   := Converter.CreateMappingData;
7048     end else
7049       ConvertBuffer := nil;
7050
7051     try
7052       for LineIdx := 0 to Height - 1 do begin
7053         // preparing row
7054         if Assigned(Converter) then begin
7055           srcData := pData;
7056           dstData := ConvertBuffer;
7057           for PixelIdx := 0 to Info.biWidth-1 do begin
7058             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7059             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7060             Converter.Map(Pixel, dstData, DestFD);
7061           end;
7062           aStream.Write(ConvertBuffer^, wbLineSize);
7063         end else begin
7064           aStream.Write(pData^, rbLineSize);
7065         end;
7066         dec(pData, rbLineSize);
7067         if (Padding > 0) then
7068           aStream.Write(PaddingBuff, Padding);
7069       end;
7070     finally
7071       // destroy row buffer
7072       if Assigned(ConvertBuffer) then begin
7073         FormatDesc.FreeMappingData(SourceFD);
7074         Converter.FreeMappingData(DestFD);
7075         FreeMem(ConvertBuffer);
7076       end;
7077     end;
7078   finally
7079     if Assigned(Converter) then
7080       Converter.Free;
7081   end;
7082 end;
7083
7084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7085 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7087 type
7088   TTGAHeader = packed record
7089     ImageID: Byte;
7090     ColorMapType: Byte;
7091     ImageType: Byte;
7092     //ColorMapSpec: Array[0..4] of Byte;
7093     ColorMapStart: Word;
7094     ColorMapLength: Word;
7095     ColorMapEntrySize: Byte;
7096     OrigX: Word;
7097     OrigY: Word;
7098     Width: Word;
7099     Height: Word;
7100     Bpp: Byte;
7101     ImageDesc: Byte;
7102   end;
7103
7104 const
7105   TGA_UNCOMPRESSED_RGB  =  2;
7106   TGA_UNCOMPRESSED_GRAY =  3;
7107   TGA_COMPRESSED_RGB    = 10;
7108   TGA_COMPRESSED_GRAY   = 11;
7109
7110   TGA_NONE_COLOR_TABLE  = 0;
7111
7112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7113 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7114 var
7115   Header: TTGAHeader;
7116   ImageData: System.PByte;
7117   StartPosition: Int64;
7118   PixelSize, LineSize: Integer;
7119   tgaFormat: TglBitmapFormat;
7120   FormatDesc: TFormatDescriptor;
7121   Counter: packed record
7122     X, Y: packed record
7123       low, high, dir: Integer;
7124     end;
7125   end;
7126
7127 const
7128   CACHE_SIZE = $4000;
7129
7130   ////////////////////////////////////////////////////////////////////////////////////////
7131   procedure ReadUncompressed;
7132   var
7133     i, j: Integer;
7134     buf, tmp1, tmp2: System.PByte;
7135   begin
7136     buf := nil;
7137     if (Counter.X.dir < 0) then
7138       GetMem(buf, LineSize);
7139     try
7140       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7141         tmp1 := ImageData;
7142         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7143         if (Counter.X.dir < 0) then begin               //flip X
7144           aStream.Read(buf^, LineSize);
7145           tmp2 := buf;
7146           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7147           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7148             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7149               tmp1^ := tmp2^;
7150               inc(tmp1);
7151               inc(tmp2);
7152             end;
7153             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7154           end;
7155         end else
7156           aStream.Read(tmp1^, LineSize);
7157         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7158       end;
7159     finally
7160       if Assigned(buf) then
7161         FreeMem(buf);
7162     end;
7163   end;
7164
7165   ////////////////////////////////////////////////////////////////////////////////////////
7166   procedure ReadCompressed;
7167
7168     /////////////////////////////////////////////////////////////////
7169     var
7170       TmpData: System.PByte;
7171       LinePixelsRead: Integer;
7172     procedure CheckLine;
7173     begin
7174       if (LinePixelsRead >= Header.Width) then begin
7175         LinePixelsRead := 0;
7176         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7177         TmpData := ImageData;
7178         inc(TmpData, Counter.Y.low * LineSize);           //set line
7179         if (Counter.X.dir < 0) then                       //if x flipped then
7180           inc(TmpData, LineSize - PixelSize);             //set last pixel
7181       end;
7182     end;
7183
7184     /////////////////////////////////////////////////////////////////
7185     var
7186       Cache: PByte;
7187       CacheSize, CachePos: Integer;
7188     procedure CachedRead(out Buffer; Count: Integer);
7189     var
7190       BytesRead: Integer;
7191     begin
7192       if (CachePos + Count > CacheSize) then begin
7193         //if buffer overflow save non read bytes
7194         BytesRead := 0;
7195         if (CacheSize - CachePos > 0) then begin
7196           BytesRead := CacheSize - CachePos;
7197           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7198           inc(CachePos, BytesRead);
7199         end;
7200
7201         //load cache from file
7202         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7203         aStream.Read(Cache^, CacheSize);
7204         CachePos := 0;
7205
7206         //read rest of requested bytes
7207         if (Count - BytesRead > 0) then begin
7208           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7209           inc(CachePos, Count - BytesRead);
7210         end;
7211       end else begin
7212         //if no buffer overflow just read the data
7213         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7214         inc(CachePos, Count);
7215       end;
7216     end;
7217
7218     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7219     begin
7220       case PixelSize of
7221         1: begin
7222           aBuffer^ := aData^;
7223           inc(aBuffer, Counter.X.dir);
7224         end;
7225         2: begin
7226           PWord(aBuffer)^ := PWord(aData)^;
7227           inc(aBuffer, 2 * Counter.X.dir);
7228         end;
7229         3: begin
7230           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7231           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7232           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7233           inc(aBuffer, 3 * Counter.X.dir);
7234         end;
7235         4: begin
7236           PCardinal(aBuffer)^ := PCardinal(aData)^;
7237           inc(aBuffer, 4 * Counter.X.dir);
7238         end;
7239       end;
7240     end;
7241
7242   var
7243     TotalPixelsToRead, TotalPixelsRead: Integer;
7244     Temp: Byte;
7245     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7246     PixelRepeat: Boolean;
7247     PixelsToRead, PixelCount: Integer;
7248   begin
7249     CacheSize := 0;
7250     CachePos  := 0;
7251
7252     TotalPixelsToRead := Header.Width * Header.Height;
7253     TotalPixelsRead   := 0;
7254     LinePixelsRead    := 0;
7255
7256     GetMem(Cache, CACHE_SIZE);
7257     try
7258       TmpData := ImageData;
7259       inc(TmpData, Counter.Y.low * LineSize);           //set line
7260       if (Counter.X.dir < 0) then                       //if x flipped then
7261         inc(TmpData, LineSize - PixelSize);             //set last pixel
7262
7263       repeat
7264         //read CommandByte
7265         CachedRead(Temp, 1);
7266         PixelRepeat  := (Temp and $80) > 0;
7267         PixelsToRead := (Temp and $7F) + 1;
7268         inc(TotalPixelsRead, PixelsToRead);
7269
7270         if PixelRepeat then
7271           CachedRead(buf[0], PixelSize);
7272         while (PixelsToRead > 0) do begin
7273           CheckLine;
7274           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7275           while (PixelCount > 0) do begin
7276             if not PixelRepeat then
7277               CachedRead(buf[0], PixelSize);
7278             PixelToBuffer(@buf[0], TmpData);
7279             inc(LinePixelsRead);
7280             dec(PixelsToRead);
7281             dec(PixelCount);
7282           end;
7283         end;
7284       until (TotalPixelsRead >= TotalPixelsToRead);
7285     finally
7286       FreeMem(Cache);
7287     end;
7288   end;
7289
7290   function IsGrayFormat: Boolean;
7291   begin
7292     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7293   end;
7294
7295 begin
7296   result := false;
7297
7298   // reading header to test file and set cursor back to begin
7299   StartPosition := aStream.Position;
7300   aStream.Read(Header{%H-}, SizeOf(Header));
7301
7302   // no colormapped files
7303   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7304     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7305   begin
7306     try
7307       if Header.ImageID <> 0 then       // skip image ID
7308         aStream.Position := aStream.Position + Header.ImageID;
7309
7310       tgaFormat := tfEmpty;
7311       case Header.Bpp of
7312          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7313                0: tgaFormat := tfLuminance8;
7314                8: tgaFormat := tfAlpha8;
7315             end;
7316
7317         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7318                0: tgaFormat := tfLuminance16;
7319                8: tgaFormat := tfLuminance8Alpha8;
7320             end else case (Header.ImageDesc and $F) of
7321                0: tgaFormat := tfBGR5;
7322                1: tgaFormat := tfBGR5A1;
7323                4: tgaFormat := tfBGRA4;
7324             end;
7325
7326         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7327                0: tgaFormat := tfBGR8;
7328             end;
7329
7330         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7331                2: tgaFormat := tfBGR10A2;
7332                8: tgaFormat := tfBGRA8;
7333             end;
7334       end;
7335
7336       if (tgaFormat = tfEmpty) then
7337         raise EglBitmap.Create('LoadTga - unsupported format');
7338
7339       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7340       PixelSize  := FormatDesc.GetSize(1, 1);
7341       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7342
7343       GetMem(ImageData, LineSize * Header.Height);
7344       try
7345         //column direction
7346         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7347           Counter.X.low  := Header.Height-1;;
7348           Counter.X.high := 0;
7349           Counter.X.dir  := -1;
7350         end else begin
7351           Counter.X.low  := 0;
7352           Counter.X.high := Header.Height-1;
7353           Counter.X.dir  := 1;
7354         end;
7355
7356         // Row direction
7357         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7358           Counter.Y.low  := 0;
7359           Counter.Y.high := Header.Height-1;
7360           Counter.Y.dir  := 1;
7361         end else begin
7362           Counter.Y.low  := Header.Height-1;;
7363           Counter.Y.high := 0;
7364           Counter.Y.dir  := -1;
7365         end;
7366
7367         // Read Image
7368         case Header.ImageType of
7369           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7370             ReadUncompressed;
7371           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7372             ReadCompressed;
7373         end;
7374
7375         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7376         result := true;
7377       except
7378         if Assigned(ImageData) then
7379           FreeMem(ImageData);
7380         raise;
7381       end;
7382     finally
7383       aStream.Position := StartPosition;
7384     end;
7385   end
7386     else aStream.Position := StartPosition;
7387 end;
7388
7389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7390 procedure TglBitmap.SaveTGA(const aStream: TStream);
7391 var
7392   Header: TTGAHeader;
7393   LineSize, Size, x, y: Integer;
7394   Pixel: TglBitmapPixelData;
7395   LineBuf, SourceData, DestData: PByte;
7396   SourceMD, DestMD: Pointer;
7397   FormatDesc: TFormatDescriptor;
7398   Converter: TFormatDescriptor;
7399 begin
7400   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7401     raise EglBitmapUnsupportedFormat.Create(Format);
7402
7403   //prepare header
7404   FillChar(Header{%H-}, SizeOf(Header), 0);
7405
7406   //set ImageType
7407   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7408                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7409     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7410   else
7411     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7412
7413   //set BitsPerPixel
7414   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7415     Header.Bpp := 8
7416   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7417                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7418     Header.Bpp := 16
7419   else if (Format in [tfBGR8, tfRGB8]) then
7420     Header.Bpp := 24
7421   else
7422     Header.Bpp := 32;
7423
7424   //set AlphaBitCount
7425   case Format of
7426     tfRGB5A1, tfBGR5A1:
7427       Header.ImageDesc := 1 and $F;
7428     tfRGB10A2, tfBGR10A2:
7429       Header.ImageDesc := 2 and $F;
7430     tfRGBA4, tfBGRA4:
7431       Header.ImageDesc := 4 and $F;
7432     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7433       Header.ImageDesc := 8 and $F;
7434   end;
7435
7436   Header.Width     := Width;
7437   Header.Height    := Height;
7438   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7439   aStream.Write(Header, SizeOf(Header));
7440
7441   // convert RGB(A) to BGR(A)
7442   Converter  := nil;
7443   FormatDesc := TFormatDescriptor.Get(Format);
7444   Size       := FormatDesc.GetSize(Dimension);
7445   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7446     if (FormatDesc.RGBInverted = tfEmpty) then
7447       raise EglBitmap.Create('inverted RGB format is empty');
7448     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7449     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7450        (Converter.PixelSize <> FormatDesc.PixelSize) then
7451       raise EglBitmap.Create('invalid inverted RGB format');
7452   end;
7453
7454   if Assigned(Converter) then begin
7455     LineSize := FormatDesc.GetSize(Width, 1);
7456     GetMem(LineBuf, LineSize);
7457     SourceMD := FormatDesc.CreateMappingData;
7458     DestMD   := Converter.CreateMappingData;
7459     try
7460       SourceData := Data;
7461       for y := 0 to Height-1 do begin
7462         DestData := LineBuf;
7463         for x := 0 to Width-1 do begin
7464           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7465           Converter.Map(Pixel, DestData, DestMD);
7466         end;
7467         aStream.Write(LineBuf^, LineSize);
7468       end;
7469     finally
7470       FreeMem(LineBuf);
7471       FormatDesc.FreeMappingData(SourceMD);
7472       FormatDesc.FreeMappingData(DestMD);
7473     end;
7474   end else
7475     aStream.Write(Data^, Size);
7476 end;
7477
7478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7479 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7481 const
7482   DDS_MAGIC: Cardinal         = $20534444;
7483
7484   // DDS_header.dwFlags
7485   DDSD_CAPS                   = $00000001;
7486   DDSD_HEIGHT                 = $00000002;
7487   DDSD_WIDTH                  = $00000004;
7488   DDSD_PIXELFORMAT            = $00001000;
7489
7490   // DDS_header.sPixelFormat.dwFlags
7491   DDPF_ALPHAPIXELS            = $00000001;
7492   DDPF_ALPHA                  = $00000002;
7493   DDPF_FOURCC                 = $00000004;
7494   DDPF_RGB                    = $00000040;
7495   DDPF_LUMINANCE              = $00020000;
7496
7497   // DDS_header.sCaps.dwCaps1
7498   DDSCAPS_TEXTURE             = $00001000;
7499
7500   // DDS_header.sCaps.dwCaps2
7501   DDSCAPS2_CUBEMAP            = $00000200;
7502
7503   D3DFMT_DXT1                 = $31545844;
7504   D3DFMT_DXT3                 = $33545844;
7505   D3DFMT_DXT5                 = $35545844;
7506
7507 type
7508   TDDSPixelFormat = packed record
7509     dwSize: Cardinal;
7510     dwFlags: Cardinal;
7511     dwFourCC: Cardinal;
7512     dwRGBBitCount: Cardinal;
7513     dwRBitMask: Cardinal;
7514     dwGBitMask: Cardinal;
7515     dwBBitMask: Cardinal;
7516     dwABitMask: Cardinal;
7517   end;
7518
7519   TDDSCaps = packed record
7520     dwCaps1: Cardinal;
7521     dwCaps2: Cardinal;
7522     dwDDSX: Cardinal;
7523     dwReserved: Cardinal;
7524   end;
7525
7526   TDDSHeader = packed record
7527     dwSize: Cardinal;
7528     dwFlags: Cardinal;
7529     dwHeight: Cardinal;
7530     dwWidth: Cardinal;
7531     dwPitchOrLinearSize: Cardinal;
7532     dwDepth: Cardinal;
7533     dwMipMapCount: Cardinal;
7534     dwReserved: array[0..10] of Cardinal;
7535     PixelFormat: TDDSPixelFormat;
7536     Caps: TDDSCaps;
7537     dwReserved2: Cardinal;
7538   end;
7539
7540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7541 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7542 var
7543   Header: TDDSHeader;
7544   Converter: TbmpBitfieldFormat;
7545
7546   function GetDDSFormat: TglBitmapFormat;
7547   var
7548     fd: TFormatDescriptor;
7549     i: Integer;
7550     Range: TglBitmapColorRec;
7551     match: Boolean;
7552   begin
7553     result := tfEmpty;
7554     with Header.PixelFormat do begin
7555       // Compresses
7556       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7557         case Header.PixelFormat.dwFourCC of
7558           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7559           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7560           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7561         end;
7562       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7563
7564         //find matching format
7565         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7566           fd := TFormatDescriptor.Get(result);
7567           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7568              (8 * fd.PixelSize = dwRGBBitCount) then
7569             exit;
7570         end;
7571
7572         //find format with same Range
7573         Range.r := dwRBitMask;
7574         Range.g := dwGBitMask;
7575         Range.b := dwBBitMask;
7576         Range.a := dwABitMask;
7577         for i := 0 to 3 do begin
7578           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7579             Range.arr[i] := Range.arr[i] shr 1;
7580         end;
7581         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7582           fd := TFormatDescriptor.Get(result);
7583           match := true;
7584           for i := 0 to 3 do
7585             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7586               match := false;
7587               break;
7588             end;
7589           if match then
7590             break;
7591         end;
7592
7593         //no format with same range found -> use default
7594         if (result = tfEmpty) then begin
7595           if (dwABitMask > 0) then
7596             result := tfBGRA8
7597           else
7598             result := tfBGR8;
7599         end;
7600
7601         Converter := TbmpBitfieldFormat.Create;
7602         Converter.RedMask   := dwRBitMask;
7603         Converter.GreenMask := dwGBitMask;
7604         Converter.BlueMask  := dwBBitMask;
7605         Converter.AlphaMask := dwABitMask;
7606         Converter.PixelSize := dwRGBBitCount / 8;
7607       end;
7608     end;
7609   end;
7610
7611 var
7612   StreamPos: Int64;
7613   x, y, LineSize, RowSize, Magic: Cardinal;
7614   NewImage, TmpData, RowData, SrcData: System.PByte;
7615   SourceMD, DestMD: Pointer;
7616   Pixel: TglBitmapPixelData;
7617   ddsFormat: TglBitmapFormat;
7618   FormatDesc: TFormatDescriptor;
7619
7620 begin
7621   result    := false;
7622   Converter := nil;
7623   StreamPos := aStream.Position;
7624
7625   // Magic
7626   aStream.Read(Magic{%H-}, sizeof(Magic));
7627   if (Magic <> DDS_MAGIC) then begin
7628     aStream.Position := StreamPos;
7629     exit;
7630   end;
7631
7632   //Header
7633   aStream.Read(Header{%H-}, sizeof(Header));
7634   if (Header.dwSize <> SizeOf(Header)) or
7635      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7636         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7637   begin
7638     aStream.Position := StreamPos;
7639     exit;
7640   end;
7641
7642   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7643     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7644
7645   ddsFormat := GetDDSFormat;
7646   try
7647     if (ddsFormat = tfEmpty) then
7648       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7649
7650     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7651     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7652     GetMem(NewImage, Header.dwHeight * LineSize);
7653     try
7654       TmpData := NewImage;
7655
7656       //Converter needed
7657       if Assigned(Converter) then begin
7658         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7659         GetMem(RowData, RowSize);
7660         SourceMD := Converter.CreateMappingData;
7661         DestMD   := FormatDesc.CreateMappingData;
7662         try
7663           for y := 0 to Header.dwHeight-1 do begin
7664             TmpData := NewImage;
7665             inc(TmpData, y * LineSize);
7666             SrcData := RowData;
7667             aStream.Read(SrcData^, RowSize);
7668             for x := 0 to Header.dwWidth-1 do begin
7669               Converter.Unmap(SrcData, Pixel, SourceMD);
7670               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7671               FormatDesc.Map(Pixel, TmpData, DestMD);
7672             end;
7673           end;
7674         finally
7675           Converter.FreeMappingData(SourceMD);
7676           FormatDesc.FreeMappingData(DestMD);
7677           FreeMem(RowData);
7678         end;
7679       end else
7680
7681       // Compressed
7682       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7683         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7684         for Y := 0 to Header.dwHeight-1 do begin
7685           aStream.Read(TmpData^, RowSize);
7686           Inc(TmpData, LineSize);
7687         end;
7688       end else
7689
7690       // Uncompressed
7691       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7692         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7693         for Y := 0 to Header.dwHeight-1 do begin
7694           aStream.Read(TmpData^, RowSize);
7695           Inc(TmpData, LineSize);
7696         end;
7697       end else
7698         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7699
7700       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7701       result := true;
7702     except
7703       if Assigned(NewImage) then
7704         FreeMem(NewImage);
7705       raise;
7706     end;
7707   finally
7708     FreeAndNil(Converter);
7709   end;
7710 end;
7711
7712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7713 procedure TglBitmap.SaveDDS(const aStream: TStream);
7714 var
7715   Header: TDDSHeader;
7716   FormatDesc: TFormatDescriptor;
7717 begin
7718   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7719     raise EglBitmapUnsupportedFormat.Create(Format);
7720
7721   FormatDesc := TFormatDescriptor.Get(Format);
7722
7723   // Generell
7724   FillChar(Header{%H-}, SizeOf(Header), 0);
7725   Header.dwSize  := SizeOf(Header);
7726   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7727
7728   Header.dwWidth  := Max(1, Width);
7729   Header.dwHeight := Max(1, Height);
7730
7731   // Caps
7732   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7733
7734   // Pixelformat
7735   Header.PixelFormat.dwSize := sizeof(Header);
7736   if (FormatDesc.IsCompressed) then begin
7737     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7738     case Format of
7739       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7740       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7741       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7742     end;
7743   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7744     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7745     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7746     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7747   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7748     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7749     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7750     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7751     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7752   end else begin
7753     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7754     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7755     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7756     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7757     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7758     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7759   end;
7760
7761   if (FormatDesc.HasAlpha) then
7762     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7763
7764   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7765   aStream.Write(Header, SizeOf(Header));
7766   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7767 end;
7768
7769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7770 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7772 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7773   const aWidth: Integer; const aHeight: Integer);
7774 var
7775   pTemp: pByte;
7776   Size: Integer;
7777 begin
7778   if (aHeight > 1) then begin
7779     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7780     GetMem(pTemp, Size);
7781     try
7782       Move(aData^, pTemp^, Size);
7783       FreeMem(aData);
7784       aData := nil;
7785     except
7786       FreeMem(pTemp);
7787       raise;
7788     end;
7789   end else
7790     pTemp := aData;
7791   inherited SetDataPointer(pTemp, aFormat, aWidth);
7792 end;
7793
7794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7795 function TglBitmap1D.FlipHorz: Boolean;
7796 var
7797   Col: Integer;
7798   pTempDest, pDest, pSource: PByte;
7799 begin
7800   result := inherited FlipHorz;
7801   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7802     pSource := Data;
7803     GetMem(pDest, fRowSize);
7804     try
7805       pTempDest := pDest;
7806       Inc(pTempDest, fRowSize);
7807       for Col := 0 to Width-1 do begin
7808         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7809         Move(pSource^, pTempDest^, fPixelSize);
7810         Inc(pSource, fPixelSize);
7811       end;
7812       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7813       result := true;
7814     except
7815       if Assigned(pDest) then
7816         FreeMem(pDest);
7817       raise;
7818     end;
7819   end;
7820 end;
7821
7822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7823 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7824 var
7825   FormatDesc: TFormatDescriptor;
7826 begin
7827   // Upload data
7828   FormatDesc := TFormatDescriptor.Get(Format);
7829   if FormatDesc.IsCompressed then begin
7830     if not Assigned(glCompressedTexImage1D) then
7831       raise EglBitmap.Create('compressed formats not supported by video adapter');
7832     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7833   end else if aBuildWithGlu then
7834     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7835   else
7836     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7837
7838   // Free Data
7839   if (FreeDataAfterGenTexture) then
7840     FreeData;
7841 end;
7842
7843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7844 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7845 var
7846   BuildWithGlu, TexRec: Boolean;
7847   TexSize: Integer;
7848 begin
7849   if Assigned(Data) then begin
7850     // Check Texture Size
7851     if (aTestTextureSize) then begin
7852       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7853
7854       if (Width > TexSize) then
7855         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7856
7857       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7858                 (Target = GL_TEXTURE_RECTANGLE);
7859       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7860         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7861     end;
7862
7863     CreateId;
7864     SetupParameters(BuildWithGlu);
7865     UploadData(BuildWithGlu);
7866     glAreTexturesResident(1, @fID, @fIsResident);
7867   end;
7868 end;
7869
7870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7871 procedure TglBitmap1D.AfterConstruction;
7872 begin
7873   inherited;
7874   Target := GL_TEXTURE_1D;
7875 end;
7876
7877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7878 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7880 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7881 begin
7882   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7883     result := fLines[aIndex]
7884   else
7885     result := nil;
7886 end;
7887
7888 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7889 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7890   const aWidth: Integer; const aHeight: Integer);
7891 var
7892   Idx, LineWidth: Integer;
7893 begin
7894   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7895
7896   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7897     // Assigning Data
7898     if Assigned(Data) then begin
7899       SetLength(fLines, GetHeight);
7900       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7901
7902       for Idx := 0 to GetHeight-1 do begin
7903         fLines[Idx] := Data;
7904         Inc(fLines[Idx], Idx * LineWidth);
7905       end;
7906     end
7907       else SetLength(fLines, 0);
7908   end else begin
7909     SetLength(fLines, 0);
7910   end;
7911 end;
7912
7913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7914 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7915 var
7916   FormatDesc: TFormatDescriptor;
7917 begin
7918   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7919
7920   FormatDesc := TFormatDescriptor.Get(Format);
7921   if FormatDesc.IsCompressed then begin
7922     if not Assigned(glCompressedTexImage2D) then
7923       raise EglBitmap.Create('compressed formats not supported by video adapter');
7924     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7925   end else if aBuildWithGlu then begin
7926     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7927       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7928   end else begin
7929     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7930       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7931   end;
7932
7933   // Freigeben
7934   if (FreeDataAfterGenTexture) then
7935     FreeData;
7936 end;
7937
7938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7939 procedure TglBitmap2D.AfterConstruction;
7940 begin
7941   inherited;
7942   Target := GL_TEXTURE_2D;
7943 end;
7944
7945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7946 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7947 var
7948   Temp: pByte;
7949   Size, w, h: Integer;
7950   FormatDesc: TFormatDescriptor;
7951 begin
7952   FormatDesc := TFormatDescriptor.Get(aFormat);
7953   if FormatDesc.IsCompressed then
7954     raise EglBitmapUnsupportedFormat.Create(aFormat);
7955
7956   w    := aRight  - aLeft;
7957   h    := aBottom - aTop;
7958   Size := FormatDesc.GetSize(w, h);
7959   GetMem(Temp, Size);
7960   try
7961     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7962     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7963     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7964     FlipVert;
7965   except
7966     if Assigned(Temp) then
7967       FreeMem(Temp);
7968     raise;
7969   end;
7970 end;
7971
7972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7973 procedure TglBitmap2D.GetDataFromTexture;
7974 var
7975   Temp: PByte;
7976   TempWidth, TempHeight: Integer;
7977   TempIntFormat: Cardinal;
7978   IntFormat, f: TglBitmapFormat;
7979   FormatDesc: TFormatDescriptor;
7980 begin
7981   Bind;
7982
7983   // Request Data
7984   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7985   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7986   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7987
7988   IntFormat := tfEmpty;
7989   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7990     FormatDesc := TFormatDescriptor.Get(f);
7991     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7992       IntFormat := FormatDesc.Format;
7993       break;
7994     end;
7995   end;
7996
7997   // Getting data from OpenGL
7998   FormatDesc := TFormatDescriptor.Get(IntFormat);
7999   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8000   try
8001     if FormatDesc.IsCompressed then begin
8002       if not Assigned(glGetCompressedTexImage) then
8003         raise EglBitmap.Create('compressed formats not supported by video adapter');
8004       glGetCompressedTexImage(Target, 0, Temp)
8005     end else
8006       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8007     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8008   except
8009     if Assigned(Temp) then
8010       FreeMem(Temp);
8011     raise;
8012   end;
8013 end;
8014
8015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8016 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8017 var
8018   BuildWithGlu, PotTex, TexRec: Boolean;
8019   TexSize: Integer;
8020 begin
8021   if Assigned(Data) then begin
8022     // Check Texture Size
8023     if (aTestTextureSize) then begin
8024       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8025
8026       if ((Height > TexSize) or (Width > TexSize)) then
8027         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8028
8029       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8030       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8031       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8032         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8033     end;
8034
8035     CreateId;
8036     SetupParameters(BuildWithGlu);
8037     UploadData(Target, BuildWithGlu);
8038     glAreTexturesResident(1, @fID, @fIsResident);
8039   end;
8040 end;
8041
8042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8043 function TglBitmap2D.FlipHorz: Boolean;
8044 var
8045   Col, Row: Integer;
8046   TempDestData, DestData, SourceData: PByte;
8047   ImgSize: Integer;
8048 begin
8049   result := inherited FlipHorz;
8050   if Assigned(Data) then begin
8051     SourceData := Data;
8052     ImgSize := Height * fRowSize;
8053     GetMem(DestData, ImgSize);
8054     try
8055       TempDestData := DestData;
8056       Dec(TempDestData, fRowSize + fPixelSize);
8057       for Row := 0 to Height -1 do begin
8058         Inc(TempDestData, fRowSize * 2);
8059         for Col := 0 to Width -1 do begin
8060           Move(SourceData^, TempDestData^, fPixelSize);
8061           Inc(SourceData, fPixelSize);
8062           Dec(TempDestData, fPixelSize);
8063         end;
8064       end;
8065       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8066       result := true;
8067     except
8068       if Assigned(DestData) then
8069         FreeMem(DestData);
8070       raise;
8071     end;
8072   end;
8073 end;
8074
8075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8076 function TglBitmap2D.FlipVert: Boolean;
8077 var
8078   Row: Integer;
8079   TempDestData, DestData, SourceData: PByte;
8080 begin
8081   result := inherited FlipVert;
8082   if Assigned(Data) then begin
8083     SourceData := Data;
8084     GetMem(DestData, Height * fRowSize);
8085     try
8086       TempDestData := DestData;
8087       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8088       for Row := 0 to Height -1 do begin
8089         Move(SourceData^, TempDestData^, fRowSize);
8090         Dec(TempDestData, fRowSize);
8091         Inc(SourceData, fRowSize);
8092       end;
8093       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8094       result := true;
8095     except
8096       if Assigned(DestData) then
8097         FreeMem(DestData);
8098       raise;
8099     end;
8100   end;
8101 end;
8102
8103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8104 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8106 type
8107   TMatrixItem = record
8108     X, Y: Integer;
8109     W: Single;
8110   end;
8111
8112   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8113   TglBitmapToNormalMapRec = Record
8114     Scale: Single;
8115     Heights: array of Single;
8116     MatrixU : array of TMatrixItem;
8117     MatrixV : array of TMatrixItem;
8118   end;
8119
8120 const
8121   ONE_OVER_255 = 1 / 255;
8122
8123   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8124 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8125 var
8126   Val: Single;
8127 begin
8128   with FuncRec do begin
8129     Val :=
8130       Source.Data.r * LUMINANCE_WEIGHT_R +
8131       Source.Data.g * LUMINANCE_WEIGHT_G +
8132       Source.Data.b * LUMINANCE_WEIGHT_B;
8133     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8134   end;
8135 end;
8136
8137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8138 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8139 begin
8140   with FuncRec do
8141     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8142 end;
8143
8144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8145 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8146 type
8147   TVec = Array[0..2] of Single;
8148 var
8149   Idx: Integer;
8150   du, dv: Double;
8151   Len: Single;
8152   Vec: TVec;
8153
8154   function GetHeight(X, Y: Integer): Single;
8155   begin
8156     with FuncRec do begin
8157       X := Max(0, Min(Size.X -1, X));
8158       Y := Max(0, Min(Size.Y -1, Y));
8159       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8160     end;
8161   end;
8162
8163 begin
8164   with FuncRec do begin
8165     with PglBitmapToNormalMapRec(Args)^ do begin
8166       du := 0;
8167       for Idx := Low(MatrixU) to High(MatrixU) do
8168         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8169
8170       dv := 0;
8171       for Idx := Low(MatrixU) to High(MatrixU) do
8172         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8173
8174       Vec[0] := -du * Scale;
8175       Vec[1] := -dv * Scale;
8176       Vec[2] := 1;
8177     end;
8178
8179     // Normalize
8180     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8181     if Len <> 0 then begin
8182       Vec[0] := Vec[0] * Len;
8183       Vec[1] := Vec[1] * Len;
8184       Vec[2] := Vec[2] * Len;
8185     end;
8186
8187     // Farbe zuweisem
8188     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8189     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8190     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8191   end;
8192 end;
8193
8194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8195 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8196 var
8197   Rec: TglBitmapToNormalMapRec;
8198
8199   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8200   begin
8201     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8202       Matrix[Index].X := X;
8203       Matrix[Index].Y := Y;
8204       Matrix[Index].W := W;
8205     end;
8206   end;
8207
8208 begin
8209   if TFormatDescriptor.Get(Format).IsCompressed then
8210     raise EglBitmapUnsupportedFormat.Create(Format);
8211
8212   if aScale > 100 then
8213     Rec.Scale := 100
8214   else if aScale < -100 then
8215     Rec.Scale := -100
8216   else
8217     Rec.Scale := aScale;
8218
8219   SetLength(Rec.Heights, Width * Height);
8220   try
8221     case aFunc of
8222       nm4Samples: begin
8223         SetLength(Rec.MatrixU, 2);
8224         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8225         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8226
8227         SetLength(Rec.MatrixV, 2);
8228         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8229         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8230       end;
8231
8232       nmSobel: begin
8233         SetLength(Rec.MatrixU, 6);
8234         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8235         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8236         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8237         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8238         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8239         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8240
8241         SetLength(Rec.MatrixV, 6);
8242         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8243         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8244         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8245         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8246         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8247         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8248       end;
8249
8250       nm3x3: begin
8251         SetLength(Rec.MatrixU, 6);
8252         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8253         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8254         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8255         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8256         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8257         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8258
8259         SetLength(Rec.MatrixV, 6);
8260         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8261         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8262         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8263         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8264         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8265         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8266       end;
8267
8268       nm5x5: begin
8269         SetLength(Rec.MatrixU, 20);
8270         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8271         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8272         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8273         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8274         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8275         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8276         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8277         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8278         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8279         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8280         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8281         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8282         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8283         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8284         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8285         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8286         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8287         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8288         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8289         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8290
8291         SetLength(Rec.MatrixV, 20);
8292         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8293         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8294         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8295         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8296         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8297         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8298         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8299         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8300         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8301         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8302         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8303         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8304         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8305         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8306         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8307         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8308         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8309         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8310         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8311         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8312       end;
8313     end;
8314
8315     // Daten Sammeln
8316     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8317       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8318     else
8319       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8320     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8321   finally
8322     SetLength(Rec.Heights, 0);
8323   end;
8324 end;
8325
8326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8327 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8329 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8330 begin
8331   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8332 end;
8333
8334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8335 procedure TglBitmapCubeMap.AfterConstruction;
8336 begin
8337   inherited;
8338
8339   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8340     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8341
8342   SetWrap;
8343   Target   := GL_TEXTURE_CUBE_MAP;
8344   fGenMode := GL_REFLECTION_MAP;
8345 end;
8346
8347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8348 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8349 var
8350   BuildWithGlu: Boolean;
8351   TexSize: Integer;
8352 begin
8353   if (aTestTextureSize) then begin
8354     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8355
8356     if (Height > TexSize) or (Width > TexSize) then
8357       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8358
8359     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8360       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8361   end;
8362
8363   if (ID = 0) then
8364     CreateID;
8365   SetupParameters(BuildWithGlu);
8366   UploadData(aCubeTarget, BuildWithGlu);
8367 end;
8368
8369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8370 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8371 begin
8372   inherited Bind (aEnableTextureUnit);
8373   if aEnableTexCoordsGen then begin
8374     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8375     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8376     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8377     glEnable(GL_TEXTURE_GEN_S);
8378     glEnable(GL_TEXTURE_GEN_T);
8379     glEnable(GL_TEXTURE_GEN_R);
8380   end;
8381 end;
8382
8383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8384 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8385 begin
8386   inherited Unbind(aDisableTextureUnit);
8387   if aDisableTexCoordsGen then begin
8388     glDisable(GL_TEXTURE_GEN_S);
8389     glDisable(GL_TEXTURE_GEN_T);
8390     glDisable(GL_TEXTURE_GEN_R);
8391   end;
8392 end;
8393
8394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8395 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8397 type
8398   TVec = Array[0..2] of Single;
8399   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8400
8401   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8402   TglBitmapNormalMapRec = record
8403     HalfSize : Integer;
8404     Func: TglBitmapNormalMapGetVectorFunc;
8405   end;
8406
8407   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8408 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8409 begin
8410   aVec[0] := aHalfSize;
8411   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8412   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8413 end;
8414
8415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8416 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8417 begin
8418   aVec[0] := - aHalfSize;
8419   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8420   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8421 end;
8422
8423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8424 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8425 begin
8426   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8427   aVec[1] := aHalfSize;
8428   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8429 end;
8430
8431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8432 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8433 begin
8434   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8435   aVec[1] := - aHalfSize;
8436   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8437 end;
8438
8439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8440 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8441 begin
8442   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8443   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8444   aVec[2] := aHalfSize;
8445 end;
8446
8447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8448 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8449 begin
8450   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8451   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8452   aVec[2] := - aHalfSize;
8453 end;
8454
8455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8456 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8457 var
8458   i: Integer;
8459   Vec: TVec;
8460   Len: Single;
8461 begin
8462   with FuncRec do begin
8463     with PglBitmapNormalMapRec(Args)^ do begin
8464       Func(Vec, Position, HalfSize);
8465
8466       // Normalize
8467       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8468       if Len <> 0 then begin
8469         Vec[0] := Vec[0] * Len;
8470         Vec[1] := Vec[1] * Len;
8471         Vec[2] := Vec[2] * Len;
8472       end;
8473
8474       // Scale Vector and AddVectro
8475       Vec[0] := Vec[0] * 0.5 + 0.5;
8476       Vec[1] := Vec[1] * 0.5 + 0.5;
8477       Vec[2] := Vec[2] * 0.5 + 0.5;
8478     end;
8479
8480     // Set Color
8481     for i := 0 to 2 do
8482       Dest.Data.arr[i] := Round(Vec[i] * 255);
8483   end;
8484 end;
8485
8486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8487 procedure TglBitmapNormalMap.AfterConstruction;
8488 begin
8489   inherited;
8490   fGenMode := GL_NORMAL_MAP;
8491 end;
8492
8493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8494 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8495 var
8496   Rec: TglBitmapNormalMapRec;
8497   SizeRec: TglBitmapPixelPosition;
8498 begin
8499   Rec.HalfSize := aSize div 2;
8500   FreeDataAfterGenTexture := false;
8501
8502   SizeRec.Fields := [ffX, ffY];
8503   SizeRec.X := aSize;
8504   SizeRec.Y := aSize;
8505
8506   // Positive X
8507   Rec.Func := glBitmapNormalMapPosX;
8508   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8509   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8510
8511   // Negative X
8512   Rec.Func := glBitmapNormalMapNegX;
8513   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8514   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8515
8516   // Positive Y
8517   Rec.Func := glBitmapNormalMapPosY;
8518   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8519   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8520
8521   // Negative Y
8522   Rec.Func := glBitmapNormalMapNegY;
8523   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8524   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8525
8526   // Positive Z
8527   Rec.Func := glBitmapNormalMapPosZ;
8528   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8529   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8530
8531   // Negative Z
8532   Rec.Func := glBitmapNormalMapNegZ;
8533   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8534   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8535 end;
8536
8537
8538 initialization
8539   glBitmapSetDefaultFormat (tfEmpty);
8540   glBitmapSetDefaultMipmap (mmMipmap);
8541   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8542   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8543   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8544
8545   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8546   glBitmapSetDefaultDeleteTextureOnFree    (true);
8547
8548   TFormatDescriptor.Init;
8549
8550 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8551   OpenGLInitialized := false;
8552   InitOpenGLCS := TCriticalSection.Create;
8553 {$ENDIF}
8554
8555 finalization
8556   TFormatDescriptor.Finalize;
8557
8558 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8559   FreeAndNil(InitOpenGLCS);
8560 {$ENDIF}
8561
8562 end.