glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 3.0.0 unstable
  15 ------------------------------------------------------------
  16 History
  17 20-11-2013
  18 - refactoring of the complete library
  19 21-03-2010
  20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  21   then it's your problem if that isn't true. This prevents the unit for incompatibility
  22   with newer versions of Delphi.
  23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  25 10-08-2008
  26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  27 - Additional Datapointer for functioninterface now has the name CustomData
  28 24-07-2008
  29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  30 - If you load an texture from an file the property Filename will be set to the name of the file
  31 - Three new properties to attach custom data to the Texture objects
  32   - CustomName  (free for use string)
  33   - CustomNameW (free for use widestring)
  34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  35 27-05-2008
  36 - RLE TGAs loaded much faster
  37 26-05-2008
  38 - fixed some problem with reading RLE TGAs.
  39 21-05-2008
  40 - function clone now only copys data if it's assigned and now it also copies the ID
  41 - it seems that lazarus dont like comments in comments.
  42 01-05-2008
  43 - It's possible to set the id of the texture
  44 - define GLB_NO_NATIVE_GL deactivated by default
  45 27-04-2008
  46 - Now supports the following libraries
  47   - SDL and SDL_image
  48   - libPNG
  49   - libJPEG
  50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  51 - BMPs now loaded manuel
  52 - Large restructuring
  53 - Property DataPtr now has the name Data
  54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  55 - Unused Depth removed
  56 - Function FreeData to freeing image data added
  57 24-10-2007
  58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  59 15-11-2006
  60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  62 - Function ReadOpenGLExtension is now only intern
  63 29-06-2006
  64 - pngimage now disabled by default like all other versions.
  65 26-06-2006
  66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  67 22-06-2006
  68 - Fixed some Problem with Delphi 5
  69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  70 22-03-2006
  71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  72 09-03-2006
  73 - Internal Format ifDepth8 added
  74 - function GrabScreen now supports all uncompressed formats
  75 31-01-2006
  76 - AddAlphaFromglBitmap implemented
  77 29-12-2005
  78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  79 28-12-2005
  80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  81   property Width, Height, Depth are still existing and new property Dimension are avail
  82 11-12-2005
  83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  84 19-10-2005
  85 - Added function GrabScreen to class TglBitmap2D
  86 18-10-2005
  87 - Added support to Save images
  88 - Added function Clone to Clone Instance
  89 11-10-2005
  90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  91   Usefull for Future
  92 - Several speed optimizations
  93 09-10-2005
  94 - Internal structure change. Loading of TGA, PNG and DDS improved.
  95   Data, format and size will now set directly with SetDataPtr.
  96 - AddFunc now works with all Types of Images and Formats
  97 - Some Funtions moved to Baseclass TglBitmap
  98 06-10-2005
  99 - Added Support to decompress DXT3 and DXT5 compressed Images.
 100 - Added Mapping to convert data from one format into an other.
 101 05-10-2005
 102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 103   supported Input format (supported by GetPixel) into any uncompresed Format
 104 - Added Support to decompress DXT1 compressed Images.
 105 - SwapColors replaced by ConvertTo
 106 04-10-2005
 107 - Added Support for compressed DDSs
 108 - Added new internal formats (DXT1, DXT3, DXT5)
 109 29-09-2005
 110 - Parameter Components renamed to InternalFormat
 111 23-09-2005
 112 - Some AllocMem replaced with GetMem (little speed change)
 113 - better exception handling. Better protection from memory leaks.
 114 22-09-2005
 115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 117 07-09-2005
 118 - Added support for Grayscale textures
 119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 120 10-07-2005
 121 - Added support for GL_VERSION_2_0
 122 - Added support for GL_EXT_texture_filter_anisotropic
 123 04-07-2005
 124 - Function FillWithColor fills the Image with one Color
 125 - Function LoadNormalMap added
 126 30-06-2005
 127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 128 - ToNormalMap now supports Sobel (nmSobel) function.
 129 29-06-2005
 130 - support for RLE Compressed RGB TGAs added
 131 28-06-2005
 132 - Class TglBitmapNormalMap added to support Normalmap generation
 133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 135 16-06-2005
 136 - Method LoadCubeMapClass removed
 137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 138 - virtual abstract method GenTexture in class TglBitmap now is protected
 139 12-06-2005
 140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 141 10-06-2005
 142 - little enhancement for IsPowerOfTwo
 143 - TglBitmap1D.GenTexture now tests NPOT Textures
 144 06-06-2005
 145 - some little name changes. All properties or function with Texture in name are
 146   now without texture in name. We have allways texture so we dosn't name it.
 147 03-06-2005
 148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 150 02-06-2005
 151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 152 25-04-2005
 153 - Function Unbind added
 154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 155 21-04-2005
 156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 157 29-03-2005
 158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 159   To Enable png's use the define pngimage
 160 22-03-2005
 161 - New Functioninterface added
 162 - Function GetPixel added
 163 27-11-2004
 164 - Property BuildMipMaps renamed to MipMap
 165 21-11-2004
 166 - property Name removed.
 167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 168 22-05-2004
 169 - property name added. Only used in glForms!
 170 26-11-2003
 171 - property FreeDataAfterGenTexture is now available as default (default = true)
 172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 173 - function MoveMemory replaced with function Move (little speed change)
 174 - several calculations stored in variables (little speed change)
 175 29-09-2003
 176 - property BuildMipsMaps added (default = true)
 177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 178 - property FreeDataAfterGenTexture added (default = true)
 179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 180 - parameter DisableOtherTextureUnits of Bind removed
 181 - parameter FreeDataAfterGeneration of GenTextures removed
 182 12-09-2003
 183 - TglBitmap dosn't delete data if class was destroyed (fixed)
 184 09-09-2003
 185 - Bind now enables TextureUnits (by params)
 186 - GenTextures can leave data (by param)
 187 - LoadTextures now optimal
 188 03-09-2003
 189 - Performance optimization in AddFunc
 190 - procedure Bind moved to subclasses
 191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 192 19-08-2003
 193 - Texturefilter and texturewrap now also as defaults
 194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 195   Magfilter = GL_LINEAR
 196   Wrap(str) = GL_CLAMP_TO_EDGE
 197 - Added new format tfCompressed to create a compressed texture.
 198 - propertys IsCompressed, TextureSize and IsResident added
 199   IsCompressed and TextureSize only contains data from level 0
 200 18-08-2003
 201 - Added function AddFunc to add PerPixelEffects to Image
 202 - LoadFromFunc now based on AddFunc
 203 - Invert now based on AddFunc
 204 - SwapColors now based on AddFunc
 205 16-08-2003
 206 - Added function FlipHorz
 207 15-08-2003
 208 - Added function LaodFromFunc to create images with function
 209 - Added function FlipVert
 210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 211 29-07-2003
 212 - Added Alphafunctions to calculate alpha per function
 213 - Added Alpha from ColorKey using alphafunctions
 214 28-07-2003
 215 - First full functionally Version of glBitmap
 216 - Support for 24Bit and 32Bit TGA Pictures added
 217 25-07-2003
 218 - begin of programming
 219 ***********************************************************}
 220 unit glBitmap;
 221
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 225
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 229 // activate to enable build-in OpenGL support with statically linked methods
 230 // use dglOpenGL.pas if not enabled
 231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 232
 233 // activate to enable build-in OpenGL support with dynamically linked methods
 234 // use dglOpenGL.pas if not enabled
 235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 236
 237
 238 // activate to enable the support for SDL_surfaces
 239 {.$DEFINE GLB_SDL}
 240
 241 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 242 {.$DEFINE GLB_DELPHI}
 243
 244 // activate to enable the support for TLazIntfImage from Lazarus
 245 {.$DEFINE GLB_LAZARUS}
 246
 247
 248
 249 // activate to enable the support of SDL_image to load files. (READ ONLY)
 250 // If you enable SDL_image all other libraries will be ignored!
 251 {.$DEFINE GLB_SDL_IMAGE}
 252
 253
 254
 255 // activate to enable Lazarus TPortableNetworkGraphic support
 256 // if you enable this pngImage and libPNG will be ignored
 257 {.$DEFINE GLB_LAZ_PNG}
 258
 259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 260 // if you enable pngimage the libPNG will be ignored
 261 {.$DEFINE GLB_PNGIMAGE}
 262
 263 // activate to use the libPNG -> http://www.libpng.org/
 264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 265 {.$DEFINE GLB_LIB_PNG}
 266
 267
 268
 269 // activate to enable Lazarus TJPEGImage support
 270 // if you enable this delphi jpegs and libJPEG will be ignored
 271 {.$DEFINE GLB_LAZ_JPEG}
 272
 273 // if you enable delphi jpegs the libJPEG will be ignored
 274 {.$DEFINE GLB_DELPHI_JPEG}
 275
 276 // activate to use the libJPEG -> http://www.ijg.org/
 277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 278 {.$DEFINE GLB_LIB_JPEG}
 279
 280
 281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 284 // Delphi Versions
 285 {$IFDEF fpc}
 286   {$MODE Delphi}
 287
 288   {$IFDEF CPUI386}
 289     {$DEFINE CPU386}
 290     {$ASMMODE INTEL}
 291   {$ENDIF}
 292
 293   {$IFNDEF WINDOWS}
 294     {$linklib c}
 295   {$ENDIF}
 296 {$ENDIF}
 297
 298 // Operation System
 299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 300   {$DEFINE GLB_WIN}
 301 {$ELSEIF DEFINED(LINUX)}
 302   {$DEFINE GLB_LINUX}
 303 {$IFEND}
 304
 305 // native OpenGL Support
 306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 307   {$DEFINE GLB_NATIVE_OGL}
 308 {$IFEND}
 309
 310 // checking define combinations
 311 //SDL Image
 312 {$IFDEF GLB_SDL_IMAGE}
 313   {$IFNDEF GLB_SDL}
 314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 315     {$DEFINE GLB_SDL}
 316   {$ENDIF}
 317
 318   {$IFDEF GLB_LAZ_PNG}
 319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 320     {$undef GLB_LAZ_PNG}
 321   {$ENDIF}
 322
 323   {$IFDEF GLB_PNGIMAGE}
 324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 325     {$undef GLB_PNGIMAGE}
 326   {$ENDIF}
 327
 328   {$IFDEF GLB_LAZ_JPEG}
 329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 330     {$undef GLB_LAZ_JPEG}
 331   {$ENDIF}
 332
 333   {$IFDEF GLB_DELPHI_JPEG}
 334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 335     {$undef GLB_DELPHI_JPEG}
 336   {$ENDIF}
 337
 338   {$IFDEF GLB_LIB_PNG}
 339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 340     {$undef GLB_LIB_PNG}
 341   {$ENDIF}
 342
 343   {$IFDEF GLB_LIB_JPEG}
 344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 345     {$undef GLB_LIB_JPEG}
 346   {$ENDIF}
 347
 348   {$DEFINE GLB_SUPPORT_PNG_READ}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350 {$ENDIF}
 351
 352 // Lazarus TPortableNetworkGraphic
 353 {$IFDEF GLB_LAZ_PNG}
 354   {$IFNDEF GLB_LAZARUS}
 355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 356     {$DEFINE GLB_LAZARUS}
 357   {$ENDIF}
 358
 359   {$IFDEF GLB_PNGIMAGE}
 360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 361     {$undef GLB_PNGIMAGE}
 362   {$ENDIF}
 363
 364   {$IFDEF GLB_LIB_PNG}
 365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 366     {$undef GLB_LIB_PNG}
 367   {$ENDIF}
 368
 369   {$DEFINE GLB_SUPPORT_PNG_READ}
 370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 371 {$ENDIF}
 372
 373 // PNG Image
 374 {$IFDEF GLB_PNGIMAGE}
 375   {$IFDEF GLB_LIB_PNG}
 376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 377     {$undef GLB_LIB_PNG}
 378   {$ENDIF}
 379
 380   {$DEFINE GLB_SUPPORT_PNG_READ}
 381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 382 {$ENDIF}
 383
 384 // libPNG
 385 {$IFDEF GLB_LIB_PNG}
 386   {$DEFINE GLB_SUPPORT_PNG_READ}
 387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 388 {$ENDIF}
 389
 390 // Lazarus TJPEGImage
 391 {$IFDEF GLB_LAZ_JPEG}
 392   {$IFNDEF GLB_LAZARUS}
 393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 394     {$DEFINE GLB_LAZARUS}
 395   {$ENDIF}
 396
 397   {$IFDEF GLB_DELPHI_JPEG}
 398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 399     {$undef GLB_DELPHI_JPEG}
 400   {$ENDIF}
 401
 402   {$IFDEF GLB_LIB_JPEG}
 403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 404     {$undef GLB_LIB_JPEG}
 405   {$ENDIF}
 406
 407   {$DEFINE GLB_SUPPORT_JPEG_READ}
 408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 409 {$ENDIF}
 410
 411 // JPEG Image
 412 {$IFDEF GLB_DELPHI_JPEG}
 413   {$IFDEF GLB_LIB_JPEG}
 414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 415     {$undef GLB_LIB_JPEG}
 416   {$ENDIF}
 417
 418   {$DEFINE GLB_SUPPORT_JPEG_READ}
 419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 420 {$ENDIF}
 421
 422 // libJPEG
 423 {$IFDEF GLB_LIB_JPEG}
 424   {$DEFINE GLB_SUPPORT_JPEG_READ}
 425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 426 {$ENDIF}
 427
 428 // native OpenGL
 429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 431 {$IFEND}
 432
 433 // general options
 434 {$EXTENDEDSYNTAX ON}
 435 {$LONGSTRINGS ON}
 436 {$ALIGN ON}
 437 {$IFNDEF FPC}
 438   {$OPTIMIZATION ON}
 439 {$ENDIF}
 440
 441 interface
 442
 443 uses
 444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
 445   {$IF DEFINED(GLB_WIN) AND
 446        (DEFINED(GLB_NATIVE_OGL) OR
 447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 448
 449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 452
 453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 458
 459   Classes, SysUtils;
 460
 461 {$IFDEF GLB_NATIVE_OGL}
 462 const
 463   GL_TRUE   = 1;
 464   GL_FALSE  = 0;
 465
 466   GL_ZERO = 0;
 467   GL_ONE  = 1;
 468
 469   GL_VERSION    = $1F02;
 470   GL_EXTENSIONS = $1F03;
 471
 472   GL_TEXTURE_1D         = $0DE0;
 473   GL_TEXTURE_2D         = $0DE1;
 474   GL_TEXTURE_RECTANGLE  = $84F5;
 475
 476   GL_NORMAL_MAP                   = $8511;
 477   GL_TEXTURE_CUBE_MAP             = $8513;
 478   GL_REFLECTION_MAP               = $8512;
 479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 485
 486   GL_TEXTURE_WIDTH            = $1000;
 487   GL_TEXTURE_HEIGHT           = $1001;
 488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 490
 491   GL_S = $2000;
 492   GL_T = $2001;
 493   GL_R = $2002;
 494   GL_Q = $2003;
 495
 496   GL_TEXTURE_GEN_S = $0C60;
 497   GL_TEXTURE_GEN_T = $0C61;
 498   GL_TEXTURE_GEN_R = $0C62;
 499   GL_TEXTURE_GEN_Q = $0C63;
 500
 501   GL_RED    = $1903;
 502   GL_GREEN  = $1904;
 503   GL_BLUE   = $1905;
 504
 505   GL_ALPHA    = $1906;
 506   GL_ALPHA4   = $803B;
 507   GL_ALPHA8   = $803C;
 508   GL_ALPHA12  = $803D;
 509   GL_ALPHA16  = $803E;
 510
 511   GL_LUMINANCE    = $1909;
 512   GL_LUMINANCE4   = $803F;
 513   GL_LUMINANCE8   = $8040;
 514   GL_LUMINANCE12  = $8041;
 515   GL_LUMINANCE16  = $8042;
 516
 517   GL_LUMINANCE_ALPHA      = $190A;
 518   GL_LUMINANCE4_ALPHA4    = $8043;
 519   GL_LUMINANCE6_ALPHA2    = $8044;
 520   GL_LUMINANCE8_ALPHA8    = $8045;
 521   GL_LUMINANCE12_ALPHA4   = $8046;
 522   GL_LUMINANCE12_ALPHA12  = $8047;
 523   GL_LUMINANCE16_ALPHA16  = $8048;
 524
 525   GL_RGB      = $1907;
 526   GL_BGR      = $80E0;
 527   GL_R3_G3_B2 = $2A10;
 528   GL_RGB4     = $804F;
 529   GL_RGB5     = $8050;
 530   GL_RGB565   = $8D62;
 531   GL_RGB8     = $8051;
 532   GL_RGB10    = $8052;
 533   GL_RGB12    = $8053;
 534   GL_RGB16    = $8054;
 535
 536   GL_RGBA     = $1908;
 537   GL_BGRA     = $80E1;
 538   GL_RGBA2    = $8055;
 539   GL_RGBA4    = $8056;
 540   GL_RGB5_A1  = $8057;
 541   GL_RGBA8    = $8058;
 542   GL_RGB10_A2 = $8059;
 543   GL_RGBA12   = $805A;
 544   GL_RGBA16   = $805B;
 545
 546   GL_DEPTH_COMPONENT    = $1902;
 547   GL_DEPTH_COMPONENT16  = $81A5;
 548   GL_DEPTH_COMPONENT24  = $81A6;
 549   GL_DEPTH_COMPONENT32  = $81A7;
 550
 551   GL_COMPRESSED_RGB                 = $84ED;
 552   GL_COMPRESSED_RGBA                = $84EE;
 553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 557
 558   GL_UNSIGNED_BYTE            = $1401;
 559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 561
 562   GL_UNSIGNED_SHORT             = $1403;
 563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 569
 570   GL_UNSIGNED_INT                 = $1405;
 571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 575
 576   { Texture Filter }
 577   GL_TEXTURE_MAG_FILTER     = $2800;
 578   GL_TEXTURE_MIN_FILTER     = $2801;
 579   GL_NEAREST                = $2600;
 580   GL_NEAREST_MIPMAP_NEAREST = $2700;
 581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 582   GL_LINEAR                 = $2601;
 583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 585
 586   { Texture Wrap }
 587   GL_TEXTURE_WRAP_S   = $2802;
 588   GL_TEXTURE_WRAP_T   = $2803;
 589   GL_TEXTURE_WRAP_R   = $8072;
 590   GL_CLAMP            = $2900;
 591   GL_REPEAT           = $2901;
 592   GL_CLAMP_TO_EDGE    = $812F;
 593   GL_CLAMP_TO_BORDER  = $812D;
 594   GL_MIRRORED_REPEAT  = $8370;
 595
 596   { Other }
 597   GL_GENERATE_MIPMAP      = $8191;
 598   GL_TEXTURE_BORDER_COLOR = $1004;
 599   GL_MAX_TEXTURE_SIZE     = $0D33;
 600   GL_PACK_ALIGNMENT       = $0D05;
 601   GL_UNPACK_ALIGNMENT     = $0CF5;
 602
 603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 606   GL_TEXTURE_GEN_MODE               = $2500;
 607
 608 {$IF DEFINED(GLB_WIN)}
 609   libglu    = 'glu32.dll';
 610   libopengl = 'opengl32.dll';
 611 {$ELSEIF DEFINED(GLB_LINUX)}
 612   libglu    = 'libGLU.so.1';
 613   libopengl = 'libGL.so.1';
 614 {$IFEND}
 615
 616 type
 617   GLboolean = BYTEBOOL;
 618   GLint     = Integer;
 619   GLsizei   = Integer;
 620   GLuint    = Cardinal;
 621   GLfloat   = Single;
 622   GLenum    = Cardinal;
 623
 624   PGLvoid    = Pointer;
 625   PGLboolean = ^GLboolean;
 626   PGLint     = ^GLint;
 627   PGLuint    = ^GLuint;
 628   PGLfloat   = ^GLfloat;
 629
 630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 633
 634 {$IF DEFINED(GLB_WIN)}
 635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 636 {$ELSEIF DEFINED(GLB_LINUX)}
 637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 639 {$IFEND}
 640
 641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 644
 645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 647
 648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 655
 656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 660
 661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 664
 665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 668
 669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 671
 672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 675
 676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 678
 679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 686
 687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 691
 692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 695
 696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 699
 700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 702 {$IFEND}
 703
 704 var
 705   GL_VERSION_1_2,
 706   GL_VERSION_1_3,
 707   GL_VERSION_1_4,
 708   GL_VERSION_2_0,
 709   GL_VERSION_3_3,
 710
 711   GL_SGIS_generate_mipmap,
 712
 713   GL_ARB_texture_border_clamp,
 714   GL_ARB_texture_mirrored_repeat,
 715   GL_ARB_texture_rectangle,
 716   GL_ARB_texture_non_power_of_two,
 717   GL_ARB_texture_swizzle,
 718   GL_ARB_texture_cube_map,
 719
 720   GL_IBM_texture_mirrored_repeat,
 721
 722   GL_NV_texture_rectangle,
 723
 724   GL_EXT_texture_edge_clamp,
 725   GL_EXT_texture_rectangle,
 726   GL_EXT_texture_swizzle,
 727   GL_EXT_texture_cube_map,
 728   GL_EXT_texture_filter_anisotropic: Boolean;
 729
 730   glCompressedTexImage1D: TglCompressedTexImage1D;
 731   glCompressedTexImage2D: TglCompressedTexImage2D;
 732   glGetCompressedTexImage: TglGetCompressedTexImage;
 733
 734 {$IF DEFINED(GLB_WIN)}
 735   wglGetProcAddress: TwglGetProcAddress;
 736 {$ELSEIF DEFINED(GLB_LINUX)}
 737   glXGetProcAddress: TglXGetProcAddress;
 738   glXGetProcAddressARB: TglXGetProcAddress;
 739 {$IFEND}
 740
 741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 742   glEnable: TglEnable;
 743   glDisable: TglDisable;
 744
 745   glGetString: TglGetString;
 746   glGetIntegerv: TglGetIntegerv;
 747
 748   glTexParameteri: TglTexParameteri;
 749   glTexParameteriv: TglTexParameteriv;
 750   glTexParameterfv: TglTexParameterfv;
 751   glGetTexParameteriv: TglGetTexParameteriv;
 752   glGetTexParameterfv: TglGetTexParameterfv;
 753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 755
 756   glTexGeni: TglTexGeni;
 757   glGenTextures: TglGenTextures;
 758   glBindTexture: TglBindTexture;
 759   glDeleteTextures: TglDeleteTextures;
 760
 761   glAreTexturesResident: TglAreTexturesResident;
 762   glReadPixels: TglReadPixels;
 763   glPixelStorei: TglPixelStorei;
 764
 765   glTexImage1D: TglTexImage1D;
 766   glTexImage2D: TglTexImage2D;
 767   glGetTexImage: TglGetTexImage;
 768
 769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 771 {$ENDIF}
 772 {$ENDIF}
 773
 774 type
 775 ////////////////////////////////////////////////////////////////////////////////////////////////////
 776   TglBitmapFormat = (
 777     tfEmpty = 0, //must be smallest value!
 778
 779     tfAlpha4,
 780     tfAlpha8,
 781     tfAlpha12,
 782     tfAlpha16,
 783
 784     tfLuminance4,
 785     tfLuminance8,
 786     tfLuminance12,
 787     tfLuminance16,
 788
 789     tfLuminance4Alpha4,
 790     tfLuminance6Alpha2,
 791     tfLuminance8Alpha8,
 792     tfLuminance12Alpha4,
 793     tfLuminance12Alpha12,
 794     tfLuminance16Alpha16,
 795
 796     tfR3G3B2,
 797     tfRGB4,
 798     tfR5G6B5,
 799     tfRGB5,
 800     tfRGB8,
 801     tfRGB10,
 802     tfRGB12,
 803     tfRGB16,
 804
 805     tfRGBA2,
 806     tfRGBA4,
 807     tfRGB5A1,
 808     tfRGBA8,
 809     tfRGB10A2,
 810     tfRGBA12,
 811     tfRGBA16,
 812
 813     tfBGR4,
 814     tfB5G6R5,
 815     tfBGR5,
 816     tfBGR8,
 817     tfBGR10,
 818     tfBGR12,
 819     tfBGR16,
 820
 821     tfBGRA2,
 822     tfBGRA4,
 823     tfBGR5A1,
 824     tfBGRA8,
 825     tfBGR10A2,
 826     tfBGRA12,
 827     tfBGRA16,
 828
 829     tfDepth16,
 830     tfDepth24,
 831     tfDepth32,
 832
 833     tfS3tcDtx1RGBA,
 834     tfS3tcDtx3RGBA,
 835     tfS3tcDtx5RGBA
 836   );
 837
 838   TglBitmapFileType = (
 839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 841      ftDDS,
 842      ftTGA,
 843      ftBMP);
 844    TglBitmapFileTypes = set of TglBitmapFileType;
 845
 846    TglBitmapMipMap = (
 847      mmNone,
 848      mmMipmap,
 849      mmMipmapGlu);
 850
 851    TglBitmapNormalMapFunc = (
 852      nm4Samples,
 853      nmSobel,
 854      nm3x3,
 855      nm5x5);
 856
 857  ////////////////////////////////////////////////////////////////////////////////////////////////////
 858    EglBitmap                  = class(Exception);
 859    EglBitmapNotSupported      = class(Exception);
 860    EglBitmapSizeToLarge       = class(EglBitmap);
 861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
 862    EglBitmapUnsupportedFormat = class(EglBitmap)
 863      constructor Create(const aFormat: TglBitmapFormat); overload;
 864      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 865    end;
 866
 867 ////////////////////////////////////////////////////////////////////////////////////////////////////
 868   TglBitmapColorRec = packed record
 869   case Integer of
 870     0: (r, g, b, a: Cardinal);
 871     1: (arr: array[0..3] of Cardinal);
 872   end;
 873
 874   TglBitmapPixelData = packed record
 875     Data, Range: TglBitmapColorRec;
 876     Format: TglBitmapFormat;
 877   end;
 878   PglBitmapPixelData = ^TglBitmapPixelData;
 879
 880 ////////////////////////////////////////////////////////////////////////////////////////////////////
 881   TglBitmapPixelPositionFields = set of (ffX, ffY);
 882   TglBitmapPixelPosition = record
 883     Fields : TglBitmapPixelPositionFields;
 884     X : Word;
 885     Y : Word;
 886   end;
 887
 888   TglBitmapFormatDescriptor = class(TObject)
 889   protected
 890     function GetIsCompressed: Boolean; virtual; abstract;
 891     function GetHasAlpha:     Boolean; virtual; abstract;
 892
 893     function GetglDataFormat:     GLenum;  virtual; abstract;
 894     function GetglFormat:         GLenum;  virtual; abstract;
 895     function GetglInternalFormat: GLenum;  virtual; abstract;
 896   public
 897     property IsCompressed: Boolean read GetIsCompressed;
 898     property HasAlpha:     Boolean read GetHasAlpha;
 899
 900     property glFormat:         GLenum  read GetglFormat;
 901     property glInternalFormat: GLenum  read GetglInternalFormat;
 902     property glDataFormat:     GLenum  read GetglDataFormat;
 903   end;
 904
 905 ////////////////////////////////////////////////////////////////////////////////////////////////////
 906   TglBitmap = class;
 907   TglBitmapFunctionRec = record
 908     Sender:   TglBitmap;
 909     Size:     TglBitmapPixelPosition;
 910     Position: TglBitmapPixelPosition;
 911     Source:   TglBitmapPixelData;
 912     Dest:     TglBitmapPixelData;
 913     Args:     Pointer;
 914   end;
 915   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 916
 917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 918   TglBitmap = class
 919   private
 920     function GetFormatDesc: TglBitmapFormatDescriptor;
 921   protected
 922     fID: GLuint;
 923     fTarget: GLuint;
 924     fAnisotropic: Integer;
 925     fDeleteTextureOnFree: Boolean;
 926     fFreeDataAfterGenTexture: Boolean;
 927     fData: PByte;
 928     fIsResident: Boolean;
 929     fBorderColor: array[0..3] of Single;
 930
 931     fDimension: TglBitmapPixelPosition;
 932     fMipMap: TglBitmapMipMap;
 933     fFormat: TglBitmapFormat;
 934
 935     // Mapping
 936     fPixelSize: Integer;
 937     fRowSize: Integer;
 938
 939     // Filtering
 940     fFilterMin: GLenum;
 941     fFilterMag: GLenum;
 942
 943     // TexturWarp
 944     fWrapS: GLenum;
 945     fWrapT: GLenum;
 946     fWrapR: GLenum;
 947
 948     //Swizzle
 949     fSwizzle: array[0..3] of GLenum;
 950
 951     // CustomData
 952     fFilename: String;
 953     fCustomName: String;
 954     fCustomNameW: WideString;
 955     fCustomData: Pointer;
 956
 957     //Getter
 958     function GetWidth:  Integer; virtual;
 959     function GetHeight: Integer; virtual;
 960
 961     function GetFileWidth:  Integer; virtual;
 962     function GetFileHeight: Integer; virtual;
 963
 964     //Setter
 965     procedure SetCustomData(const aValue: Pointer);
 966     procedure SetCustomName(const aValue: String);
 967     procedure SetCustomNameW(const aValue: WideString);
 968     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 969     procedure SetFormat(const aValue: TglBitmapFormat);
 970     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 971     procedure SetID(const aValue: Cardinal);
 972     procedure SetMipMap(const aValue: TglBitmapMipMap);
 973     procedure SetTarget(const aValue: Cardinal);
 974     procedure SetAnisotropic(const aValue: Integer);
 975
 976     procedure CreateID;
 977     procedure SetupParameters(out aBuildWithGlu: Boolean);
 978     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 979       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 980     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 981
 982     function FlipHorz: Boolean; virtual;
 983     function FlipVert: Boolean; virtual;
 984
 985     property Width:  Integer read GetWidth;
 986     property Height: Integer read GetHeight;
 987
 988     property FileWidth:  Integer read GetFileWidth;
 989     property FileHeight: Integer read GetFileHeight;
 990   public
 991     //Properties
 992     property ID:           Cardinal        read fID          write SetID;
 993     property Target:       Cardinal        read fTarget      write SetTarget;
 994     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 995     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 996     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 997
 998     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
 999
1000     property Filename:    String     read fFilename;
1001     property CustomName:  String     read fCustomName  write SetCustomName;
1002     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1003     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1004
1005     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1006     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1007
1008     property Dimension:  TglBitmapPixelPosition  read fDimension;
1009     property Data:       PByte                   read fData;
1010     property IsResident: Boolean                 read fIsResident;
1011
1012     procedure AfterConstruction; override;
1013     procedure BeforeDestruction; override;
1014
1015     procedure PrepareResType(var aResource: String; var aResType: PChar);
1016
1017     //Load
1018     procedure LoadFromFile(const aFilename: String);
1019     procedure LoadFromStream(const aStream: TStream); virtual;
1020     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1021       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1022     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1023     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1024
1025     //Save
1026     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1027     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1028
1029     //Convert
1030     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1031     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1032       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1033   public
1034     //Alpha & Co
1035     {$IFDEF GLB_SDL}
1036     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1037     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1038     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1039     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1040       const aArgs: Pointer = nil): Boolean;
1041     {$ENDIF}
1042
1043     {$IFDEF GLB_DELPHI}
1044     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1045     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1046     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1047     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1048       const aArgs: Pointer = nil): Boolean;
1049     {$ENDIF}
1050
1051     {$IFDEF GLB_LAZARUS}
1052     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1053     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1054     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1055     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1056       const aArgs: Pointer = nil): Boolean;
1057     {$ENDIF}
1058
1059     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1060       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1061     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1062       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1063
1064     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1065     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1066     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1067     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1068
1069     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1070     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1071     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1072
1073     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1074     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1075     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1076
1077     function RemoveAlpha: Boolean; virtual;
1078   public
1079     //Common
1080     function Clone: TglBitmap;
1081     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1082     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1083     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1084     procedure FreeData;
1085
1086     //ColorFill
1087     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1088     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1089     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1090
1091     //TexParameters
1092     procedure SetFilter(const aMin, aMag: GLenum);
1093     procedure SetWrap(
1094       const S: GLenum = GL_CLAMP_TO_EDGE;
1095       const T: GLenum = GL_CLAMP_TO_EDGE;
1096       const R: GLenum = GL_CLAMP_TO_EDGE);
1097     procedure SetSwizzle(const r, g, b, a: GLenum);
1098
1099     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1100     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1101
1102     //Constructors
1103     constructor Create; overload;
1104     constructor Create(const aFileName: String); overload;
1105     constructor Create(const aStream: TStream); overload;
1106     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
1107     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1108     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1109     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1110   private
1111     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1112     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1113
1114     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1115     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1116
1117     function LoadBMP(const aStream: TStream): Boolean; virtual;
1118     procedure SaveBMP(const aStream: TStream); virtual;
1119
1120     function LoadTGA(const aStream: TStream): Boolean; virtual;
1121     procedure SaveTGA(const aStream: TStream); virtual;
1122
1123     function LoadDDS(const aStream: TStream): Boolean; virtual;
1124     procedure SaveDDS(const aStream: TStream); virtual;
1125   end;
1126
1127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1128   TglBitmap1D = class(TglBitmap)
1129   protected
1130     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1131       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1132     procedure UploadData(const aBuildWithGlu: Boolean);
1133   public
1134     property Width;
1135     procedure AfterConstruction; override;
1136     function FlipHorz: Boolean; override;
1137     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1138   end;
1139
1140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1141   TglBitmap2D = class(TglBitmap)
1142   protected
1143     fLines: array of PByte;
1144     function GetScanline(const aIndex: Integer): Pointer;
1145     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1146       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1147     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1148   public
1149     property Width;
1150     property Height;
1151     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1152
1153     procedure AfterConstruction; override;
1154
1155     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1156     procedure GetDataFromTexture;
1157     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1158
1159     function FlipHorz: Boolean; override;
1160     function FlipVert: Boolean; override;
1161
1162     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1163       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1164   end;
1165
1166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1167   TglBitmapCubeMap = class(TglBitmap2D)
1168   protected
1169     fGenMode: Integer;
1170     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1171   public
1172     procedure AfterConstruction; override;
1173     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1174     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1175     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1176   end;
1177
1178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1179   TglBitmapNormalMap = class(TglBitmapCubeMap)
1180   public
1181     procedure AfterConstruction; override;
1182     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1183   end;
1184
1185 const
1186   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1187
1188 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1189 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1190 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1191 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1192 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1193 procedure glBitmapSetDefaultWrap(
1194   const S: Cardinal = GL_CLAMP_TO_EDGE;
1195   const T: Cardinal = GL_CLAMP_TO_EDGE;
1196   const R: Cardinal = GL_CLAMP_TO_EDGE);
1197
1198 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1199 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1200 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1201 function glBitmapGetDefaultFormat: TglBitmapFormat;
1202 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1203 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1204
1205 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1206 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1207 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1208
1209 var
1210   glBitmapDefaultDeleteTextureOnFree: Boolean;
1211   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1212   glBitmapDefaultFormat: TglBitmapFormat;
1213   glBitmapDefaultMipmap: TglBitmapMipMap;
1214   glBitmapDefaultFilterMin: Cardinal;
1215   glBitmapDefaultFilterMag: Cardinal;
1216   glBitmapDefaultWrapS: Cardinal;
1217   glBitmapDefaultWrapT: Cardinal;
1218   glBitmapDefaultWrapR: Cardinal;
1219   glDefaultSwizzle: array[0..3] of GLenum;
1220
1221 {$IFDEF GLB_DELPHI}
1222 function CreateGrayPalette: HPALETTE;
1223 {$ENDIF}
1224
1225 implementation
1226
1227 uses
1228   Math, syncobjs, typinfo
1229   {$IFDEF GLB_DELPHI}, Types{$ENDIF};
1230
1231 type
1232 {$IFNDEF fpc}
1233   QWord   = System.UInt64;
1234   PQWord  = ^QWord;
1235
1236   PtrInt  = Longint;
1237   PtrUInt = DWord;
1238 {$ENDIF}
1239
1240 ////////////////////////////////////////////////////////////////////////////////////////////////////
1241   TShiftRec = packed record
1242   case Integer of
1243     0: (r, g, b, a: Byte);
1244     1: (arr: array[0..3] of Byte);
1245   end;
1246
1247   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1248   private
1249     function GetRedMask: QWord;
1250     function GetGreenMask: QWord;
1251     function GetBlueMask: QWord;
1252     function GetAlphaMask: QWord;
1253   protected
1254     fFormat: TglBitmapFormat;
1255     fWithAlpha: TglBitmapFormat;
1256     fWithoutAlpha: TglBitmapFormat;
1257     fRGBInverted: TglBitmapFormat;
1258     fUncompressed: TglBitmapFormat;
1259     fPixelSize: Single;
1260     fIsCompressed: Boolean;
1261
1262     fRange: TglBitmapColorRec;
1263     fShift: TShiftRec;
1264
1265     fglFormat:         GLenum;
1266     fglInternalFormat: GLenum;
1267     fglDataFormat:     GLenum;
1268
1269     function GetIsCompressed: Boolean; override;
1270     function GetHasAlpha: Boolean; override;
1271
1272     function GetglFormat: GLenum; override;
1273     function GetglInternalFormat: GLenum; override;
1274     function GetglDataFormat: GLenum; override;
1275
1276     function GetComponents: Integer; virtual;
1277   public
1278     property Format:       TglBitmapFormat read fFormat;
1279     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1280     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1281     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1282     property Components:   Integer         read GetComponents;
1283     property PixelSize:    Single          read fPixelSize;
1284
1285     property Range: TglBitmapColorRec read fRange;
1286     property Shift: TShiftRec         read fShift;
1287
1288     property RedMask:   QWord read GetRedMask;
1289     property GreenMask: QWord read GetGreenMask;
1290     property BlueMask:  QWord read GetBlueMask;
1291     property AlphaMask: QWord read GetAlphaMask;
1292
1293     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1294     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1295
1296     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1297     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1298
1299     function CreateMappingData: Pointer; virtual;
1300     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1301
1302     function IsEmpty:  Boolean; virtual;
1303     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1304
1305     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1306
1307     constructor Create; virtual;
1308   public
1309     class procedure Init;
1310     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1311     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1312     class procedure Clear;
1313     class procedure Finalize;
1314   end;
1315   TFormatDescriptorClass = class of TFormatDescriptor;
1316
1317   TfdEmpty = class(TFormatDescriptor);
1318
1319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1320   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1321     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1322     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1323     constructor Create; override;
1324   end;
1325
1326   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1327     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1328     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1329     constructor Create; override;
1330   end;
1331
1332   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1333     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1334     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1335     constructor Create; override;
1336   end;
1337
1338   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1339     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1340     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1341     constructor Create; override;
1342   end;
1343
1344   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1345     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1346     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1347     constructor Create; override;
1348   end;
1349
1350   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1351     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1352     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1353     constructor Create; override;
1354   end;
1355
1356   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1357     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1358     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1359     constructor Create; override;
1360   end;
1361
1362   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1363     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1364     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1365     constructor Create; override;
1366   end;
1367
1368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1369   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1370     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1371     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1372     constructor Create; override;
1373   end;
1374
1375   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1376     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1377     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1378     constructor Create; override;
1379   end;
1380
1381   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1382     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1383     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1384     constructor Create; override;
1385   end;
1386
1387   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390     constructor Create; override;
1391   end;
1392
1393   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1394     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1395     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1396     constructor Create; override;
1397   end;
1398
1399   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1400     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1401     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1402     constructor Create; override;
1403   end;
1404
1405   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1406     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1407     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1408     constructor Create; override;
1409   end;
1410
1411   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1412     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1413     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1414     constructor Create; override;
1415   end;
1416
1417   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1418     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1419     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1420     constructor Create; override;
1421   end;
1422
1423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1424   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1425     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1426     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1427     constructor Create; override;
1428   end;
1429
1430   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1431     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1432     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1433     constructor Create; override;
1434   end;
1435
1436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1437   TfdAlpha4 = class(TfdAlpha_UB1)
1438     constructor Create; override;
1439   end;
1440
1441   TfdAlpha8 = class(TfdAlpha_UB1)
1442     constructor Create; override;
1443   end;
1444
1445   TfdAlpha12 = class(TfdAlpha_US1)
1446     constructor Create; override;
1447   end;
1448
1449   TfdAlpha16 = class(TfdAlpha_US1)
1450     constructor Create; override;
1451   end;
1452
1453   TfdLuminance4 = class(TfdLuminance_UB1)
1454     constructor Create; override;
1455   end;
1456
1457   TfdLuminance8 = class(TfdLuminance_UB1)
1458     constructor Create; override;
1459   end;
1460
1461   TfdLuminance12 = class(TfdLuminance_US1)
1462     constructor Create; override;
1463   end;
1464
1465   TfdLuminance16 = class(TfdLuminance_US1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1470     constructor Create; override;
1471   end;
1472
1473   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1474     constructor Create; override;
1475   end;
1476
1477   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1478     constructor Create; override;
1479   end;
1480
1481   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1482     constructor Create; override;
1483   end;
1484
1485   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1486     constructor Create; override;
1487   end;
1488
1489   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1490     constructor Create; override;
1491   end;
1492
1493   TfdR3G3B2 = class(TfdUniversal_UB1)
1494     constructor Create; override;
1495   end;
1496
1497   TfdRGB4 = class(TfdUniversal_US1)
1498     constructor Create; override;
1499   end;
1500
1501   TfdR5G6B5 = class(TfdUniversal_US1)
1502     constructor Create; override;
1503   end;
1504
1505   TfdRGB5 = class(TfdUniversal_US1)
1506     constructor Create; override;
1507   end;
1508
1509   TfdRGB8 = class(TfdRGB_UB3)
1510     constructor Create; override;
1511   end;
1512
1513   TfdRGB10 = class(TfdUniversal_UI1)
1514     constructor Create; override;
1515   end;
1516
1517   TfdRGB12 = class(TfdRGB_US3)
1518     constructor Create; override;
1519   end;
1520
1521   TfdRGB16 = class(TfdRGB_US3)
1522     constructor Create; override;
1523   end;
1524
1525   TfdRGBA2 = class(TfdRGBA_UB4)
1526     constructor Create; override;
1527   end;
1528
1529   TfdRGBA4 = class(TfdUniversal_US1)
1530     constructor Create; override;
1531   end;
1532
1533   TfdRGB5A1 = class(TfdUniversal_US1)
1534     constructor Create; override;
1535   end;
1536
1537   TfdRGBA8 = class(TfdRGBA_UB4)
1538     constructor Create; override;
1539   end;
1540
1541   TfdRGB10A2 = class(TfdUniversal_UI1)
1542     constructor Create; override;
1543   end;
1544
1545   TfdRGBA12 = class(TfdRGBA_US4)
1546     constructor Create; override;
1547   end;
1548
1549   TfdRGBA16 = class(TfdRGBA_US4)
1550     constructor Create; override;
1551   end;
1552
1553   TfdBGR4 = class(TfdUniversal_US1)
1554     constructor Create; override;
1555   end;
1556
1557   TfdB5G6R5 = class(TfdUniversal_US1)
1558     constructor Create; override;
1559   end;
1560
1561   TfdBGR5 = class(TfdUniversal_US1)
1562     constructor Create; override;
1563   end;
1564
1565   TfdBGR8 = class(TfdBGR_UB3)
1566     constructor Create; override;
1567   end;
1568
1569   TfdBGR10 = class(TfdUniversal_UI1)
1570     constructor Create; override;
1571   end;
1572
1573   TfdBGR12 = class(TfdBGR_US3)
1574     constructor Create; override;
1575   end;
1576
1577   TfdBGR16 = class(TfdBGR_US3)
1578     constructor Create; override;
1579   end;
1580
1581   TfdBGRA2 = class(TfdBGRA_UB4)
1582     constructor Create; override;
1583   end;
1584
1585   TfdBGRA4 = class(TfdUniversal_US1)
1586     constructor Create; override;
1587   end;
1588
1589   TfdBGR5A1 = class(TfdUniversal_US1)
1590     constructor Create; override;
1591   end;
1592
1593   TfdBGRA8 = class(TfdBGRA_UB4)
1594     constructor Create; override;
1595   end;
1596
1597   TfdBGR10A2 = class(TfdUniversal_UI1)
1598     constructor Create; override;
1599   end;
1600
1601   TfdBGRA12 = class(TfdBGRA_US4)
1602     constructor Create; override;
1603   end;
1604
1605   TfdBGRA16 = class(TfdBGRA_US4)
1606     constructor Create; override;
1607   end;
1608
1609   TfdDepth16 = class(TfdDepth_US1)
1610     constructor Create; override;
1611   end;
1612
1613   TfdDepth24 = class(TfdDepth_UI1)
1614     constructor Create; override;
1615   end;
1616
1617   TfdDepth32 = class(TfdDepth_UI1)
1618     constructor Create; override;
1619   end;
1620
1621   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1622     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1623     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1624     constructor Create; override;
1625   end;
1626
1627   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1628     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1629     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1630     constructor Create; override;
1631   end;
1632
1633   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1634     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1635     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1636     constructor Create; override;
1637   end;
1638
1639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1640   TbmpBitfieldFormat = class(TFormatDescriptor)
1641   private
1642     procedure SetRedMask  (const aValue: QWord);
1643     procedure SetGreenMask(const aValue: QWord);
1644     procedure SetBlueMask (const aValue: QWord);
1645     procedure SetAlphaMask(const aValue: QWord);
1646
1647     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1648   public
1649     property RedMask:   QWord read GetRedMask   write SetRedMask;
1650     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1651     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1652     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1653
1654     property PixelSize: Single read fPixelSize write fPixelSize;
1655
1656     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1657     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1658   end;
1659
1660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1661   TbmpColorTableEnty = packed record
1662     b, g, r, a: Byte;
1663   end;
1664   TbmpColorTable = array of TbmpColorTableEnty;
1665   TbmpColorTableFormat = class(TFormatDescriptor)
1666   private
1667     fColorTable: TbmpColorTable;
1668   public
1669     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1670     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1671     property Range:      TglBitmapColorRec read fRange      write fRange;
1672     property Shift:      TShiftRec         read fShift      write fShift;
1673     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1674
1675     procedure CreateColorTable;
1676
1677     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1678     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1679     destructor Destroy; override;
1680   end;
1681
1682 const
1683   LUMINANCE_WEIGHT_R = 0.30;
1684   LUMINANCE_WEIGHT_G = 0.59;
1685   LUMINANCE_WEIGHT_B = 0.11;
1686
1687   ALPHA_WEIGHT_R = 0.30;
1688   ALPHA_WEIGHT_G = 0.59;
1689   ALPHA_WEIGHT_B = 0.11;
1690
1691   DEPTH_WEIGHT_R = 0.333333333;
1692   DEPTH_WEIGHT_G = 0.333333333;
1693   DEPTH_WEIGHT_B = 0.333333333;
1694
1695   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1696
1697   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1698     TfdEmpty,
1699
1700     TfdAlpha4,
1701     TfdAlpha8,
1702     TfdAlpha12,
1703     TfdAlpha16,
1704
1705     TfdLuminance4,
1706     TfdLuminance8,
1707     TfdLuminance12,
1708     TfdLuminance16,
1709
1710     TfdLuminance4Alpha4,
1711     TfdLuminance6Alpha2,
1712     TfdLuminance8Alpha8,
1713     TfdLuminance12Alpha4,
1714     TfdLuminance12Alpha12,
1715     TfdLuminance16Alpha16,
1716
1717     TfdR3G3B2,
1718     TfdRGB4,
1719     TfdR5G6B5,
1720     TfdRGB5,
1721     TfdRGB8,
1722     TfdRGB10,
1723     TfdRGB12,
1724     TfdRGB16,
1725
1726     TfdRGBA2,
1727     TfdRGBA4,
1728     TfdRGB5A1,
1729     TfdRGBA8,
1730     TfdRGB10A2,
1731     TfdRGBA12,
1732     TfdRGBA16,
1733
1734     TfdBGR4,
1735     TfdB5G6R5,
1736     TfdBGR5,
1737     TfdBGR8,
1738     TfdBGR10,
1739     TfdBGR12,
1740     TfdBGR16,
1741
1742     TfdBGRA2,
1743     TfdBGRA4,
1744     TfdBGR5A1,
1745     TfdBGRA8,
1746     TfdBGR10A2,
1747     TfdBGRA12,
1748     TfdBGRA16,
1749
1750     TfdDepth16,
1751     TfdDepth24,
1752     TfdDepth32,
1753
1754     TfdS3tcDtx1RGBA,
1755     TfdS3tcDtx3RGBA,
1756     TfdS3tcDtx5RGBA
1757   );
1758
1759 var
1760   FormatDescriptorCS: TCriticalSection;
1761   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1762
1763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1764 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1765 begin
1766   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1767 end;
1768
1769 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1770 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1771 begin
1772   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1773 end;
1774
1775 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1776 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1777 begin
1778   result.Fields := [];
1779
1780   if X >= 0 then
1781     result.Fields := result.Fields + [ffX];
1782   if Y >= 0 then
1783     result.Fields := result.Fields + [ffY];
1784
1785   result.X := Max(0, X);
1786   result.Y := Max(0, Y);
1787 end;
1788
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1791 begin
1792   result.r := r;
1793   result.g := g;
1794   result.b := b;
1795   result.a := a;
1796 end;
1797
1798 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1799 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1800 var
1801   i: Integer;
1802 begin
1803   result := false;
1804   for i := 0 to high(r1.arr) do
1805     if (r1.arr[i] <> r2.arr[i]) then
1806       exit;
1807   result := true;
1808 end;
1809
1810 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1811 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1812 begin
1813   result.r := r;
1814   result.g := g;
1815   result.b := b;
1816   result.a := a;
1817 end;
1818
1819 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1820 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1821 begin
1822   result := [];
1823
1824   if (aFormat in [
1825         //4 bbp
1826         tfLuminance4,
1827
1828         //8bpp
1829         tfR3G3B2, tfLuminance8,
1830
1831         //16bpp
1832         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1833         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1834
1835         //24bpp
1836         tfBGR8, tfRGB8,
1837
1838         //32bpp
1839         tfRGB10, tfRGB10A2, tfRGBA8,
1840         tfBGR10, tfBGR10A2, tfBGRA8]) then
1841     result := result + [ftBMP];
1842
1843   if (aFormat in [
1844         //8 bpp
1845         tfLuminance8, tfAlpha8,
1846
1847         //16 bpp
1848         tfLuminance16, tfLuminance8Alpha8,
1849         tfRGB5, tfRGB5A1, tfRGBA4,
1850         tfBGR5, tfBGR5A1, tfBGRA4,
1851
1852         //24 bpp
1853         tfRGB8, tfBGR8,
1854
1855         //32 bpp
1856         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1857     result := result + [ftTGA];
1858
1859   if (aFormat in [
1860         //8 bpp
1861         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1862         tfR3G3B2, tfRGBA2, tfBGRA2,
1863
1864         //16 bpp
1865         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1866         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1867         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1868
1869         //24 bpp
1870         tfRGB8, tfBGR8,
1871
1872         //32 bbp
1873         tfLuminance16Alpha16,
1874         tfRGBA8, tfRGB10A2,
1875         tfBGRA8, tfBGR10A2,
1876
1877         //compressed
1878         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1879     result := result + [ftDDS];
1880
1881   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1882   if aFormat in [
1883       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1884       tfRGB8, tfRGBA8,
1885       tfBGR8, tfBGRA8] then
1886     result := result + [ftPNG];
1887   {$ENDIF}
1888
1889   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1890   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1891     result := result + [ftJPEG];
1892   {$ENDIF}
1893 end;
1894
1895 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1896 function IsPowerOfTwo(aNumber: Integer): Boolean;
1897 begin
1898   while (aNumber and 1) = 0 do
1899     aNumber := aNumber shr 1;
1900   result := aNumber = 1;
1901 end;
1902
1903 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1904 function GetTopMostBit(aBitSet: QWord): Integer;
1905 begin
1906   result := 0;
1907   while aBitSet > 0 do begin
1908     inc(result);
1909     aBitSet := aBitSet shr 1;
1910   end;
1911 end;
1912
1913 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1914 function CountSetBits(aBitSet: QWord): Integer;
1915 begin
1916   result := 0;
1917   while aBitSet > 0 do begin
1918     if (aBitSet and 1) = 1 then
1919       inc(result);
1920     aBitSet := aBitSet shr 1;
1921   end;
1922 end;
1923
1924 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1925 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1926 begin
1927   result := Trunc(
1928     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1929     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1930     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1931 end;
1932
1933 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1934 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1935 begin
1936   result := Trunc(
1937     DEPTH_WEIGHT_R * aPixel.Data.r +
1938     DEPTH_WEIGHT_G * aPixel.Data.g +
1939     DEPTH_WEIGHT_B * aPixel.Data.b);
1940 end;
1941
1942 {$IFDEF GLB_NATIVE_OGL}
1943 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1944 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1945 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1946 var
1947   GL_LibHandle: Pointer = nil;
1948
1949 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1950 begin
1951   if not Assigned(aLibHandle) then
1952     aLibHandle := GL_LibHandle;
1953
1954 {$IF DEFINED(GLB_WIN)}
1955   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1956   if Assigned(result) then
1957     exit;
1958
1959   if Assigned(wglGetProcAddress) then
1960     result := wglGetProcAddress(aProcName);
1961 {$ELSEIF DEFINED(GLB_LINUX)}
1962   if Assigned(glXGetProcAddress) then begin
1963     result := glXGetProcAddress(aProcName);
1964     if Assigned(result) then
1965       exit;
1966   end;
1967
1968   if Assigned(glXGetProcAddressARB) then begin
1969     result := glXGetProcAddressARB(aProcName);
1970     if Assigned(result) then
1971       exit;
1972   end;
1973
1974   result := dlsym(aLibHandle, aProcName);
1975 {$IFEND}
1976   if not Assigned(result) and aRaiseOnErr then
1977     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1978 end;
1979
1980 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1981 var
1982   GLU_LibHandle: Pointer = nil;
1983   OpenGLInitialized: Boolean;
1984   InitOpenGLCS: TCriticalSection;
1985
1986 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1987 procedure glbInitOpenGL;
1988
1989   ////////////////////////////////////////////////////////////////////////////////
1990   function glbLoadLibrary(const aName: PChar): Pointer;
1991   begin
1992     {$IF DEFINED(GLB_WIN)}
1993     result := {%H-}Pointer(LoadLibrary(aName));
1994     {$ELSEIF DEFINED(GLB_LINUX)}
1995     result := dlopen(Name, RTLD_LAZY);
1996     {$ELSE}
1997     result := nil;
1998     {$IFEND}
1999   end;
2000
2001   ////////////////////////////////////////////////////////////////////////////////
2002   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2003   begin
2004     result := false;
2005     if not Assigned(aLibHandle) then
2006       exit;
2007
2008     {$IF DEFINED(GLB_WIN)}
2009     Result := FreeLibrary({%H-}HINST(aLibHandle));
2010     {$ELSEIF DEFINED(GLB_LINUX)}
2011     Result := dlclose(aLibHandle) = 0;
2012     {$IFEND}
2013   end;
2014
2015 begin
2016   if Assigned(GL_LibHandle) then
2017     glbFreeLibrary(GL_LibHandle);
2018
2019   if Assigned(GLU_LibHandle) then
2020     glbFreeLibrary(GLU_LibHandle);
2021
2022   GL_LibHandle := glbLoadLibrary(libopengl);
2023   if not Assigned(GL_LibHandle) then
2024     raise EglBitmap.Create('unable to load library: ' + libopengl);
2025
2026   GLU_LibHandle := glbLoadLibrary(libglu);
2027   if not Assigned(GLU_LibHandle) then
2028     raise EglBitmap.Create('unable to load library: ' + libglu);
2029
2030 {$IF DEFINED(GLB_WIN)}
2031   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2032 {$ELSEIF DEFINED(GLB_LINUX)}
2033   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2034   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2035 {$IFEND}
2036
2037   glEnable := glbGetProcAddress('glEnable');
2038   glDisable := glbGetProcAddress('glDisable');
2039   glGetString := glbGetProcAddress('glGetString');
2040   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2041   glTexParameteri := glbGetProcAddress('glTexParameteri');
2042   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2043   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2044   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2045   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2046   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2047   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2048   glTexGeni := glbGetProcAddress('glTexGeni');
2049   glGenTextures := glbGetProcAddress('glGenTextures');
2050   glBindTexture := glbGetProcAddress('glBindTexture');
2051   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2052   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2053   glReadPixels := glbGetProcAddress('glReadPixels');
2054   glPixelStorei := glbGetProcAddress('glPixelStorei');
2055   glTexImage1D := glbGetProcAddress('glTexImage1D');
2056   glTexImage2D := glbGetProcAddress('glTexImage2D');
2057   glGetTexImage := glbGetProcAddress('glGetTexImage');
2058
2059   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2060   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2061 end;
2062 {$ENDIF}
2063
2064 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2065 procedure glbReadOpenGLExtensions;
2066 var
2067   Buffer: AnsiString;
2068   MajorVersion, MinorVersion: Integer;
2069
2070   ///////////////////////////////////////////////////////////////////////////////////////////
2071   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2072   var
2073     Separator: Integer;
2074   begin
2075     aMinor := 0;
2076     aMajor := 0;
2077
2078     Separator := Pos(AnsiString('.'), aBuffer);
2079     if (Separator > 1) and (Separator < Length(aBuffer)) and
2080        (aBuffer[Separator - 1] in ['0'..'9']) and
2081        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2082
2083       Dec(Separator);
2084       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2085         Dec(Separator);
2086
2087       Delete(aBuffer, 1, Separator);
2088       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2089
2090       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2091         Inc(Separator);
2092
2093       Delete(aBuffer, Separator, 255);
2094       Separator := Pos(AnsiString('.'), aBuffer);
2095
2096       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2097       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2098     end;
2099   end;
2100
2101   ///////////////////////////////////////////////////////////////////////////////////////////
2102   function CheckExtension(const Extension: AnsiString): Boolean;
2103   var
2104     ExtPos: Integer;
2105   begin
2106     ExtPos := Pos(Extension, Buffer);
2107     result := ExtPos > 0;
2108     if result then
2109       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2110   end;
2111
2112   ///////////////////////////////////////////////////////////////////////////////////////////
2113   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2114   begin
2115     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2116   end;
2117
2118 begin
2119 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2120   InitOpenGLCS.Enter;
2121   try
2122     if not OpenGLInitialized then begin
2123       glbInitOpenGL;
2124       OpenGLInitialized := true;
2125     end;
2126   finally
2127     InitOpenGLCS.Leave;
2128   end;
2129 {$ENDIF}
2130
2131   // Version
2132   Buffer := glGetString(GL_VERSION);
2133   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2134
2135   GL_VERSION_1_2 := CheckVersion(1, 2);
2136   GL_VERSION_1_3 := CheckVersion(1, 3);
2137   GL_VERSION_1_4 := CheckVersion(1, 4);
2138   GL_VERSION_2_0 := CheckVersion(2, 0);
2139   GL_VERSION_3_3 := CheckVersion(3, 3);
2140
2141   // Extensions
2142   Buffer := glGetString(GL_EXTENSIONS);
2143   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2144   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2145   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2146   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2147   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2148   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2149   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2150   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2151   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2152   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2153   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2154   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2155   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2156   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2157
2158   if GL_VERSION_1_3 then begin
2159     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2160     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2161     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2162   end else begin
2163     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2164     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2165     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2166   end;
2167 end;
2168 {$ENDIF}
2169
2170 {$IFDEF GLB_SDL_IMAGE}
2171 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2175 begin
2176   result := TStream(context^.unknown.data1).Seek(offset, whence);
2177 end;
2178
2179 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2180 begin
2181   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2182 end;
2183
2184 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2185 begin
2186   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2187 end;
2188
2189 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2190 begin
2191   result := 0;
2192 end;
2193
2194 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2195 begin
2196   result := SDL_AllocRW;
2197
2198   if result = nil then
2199     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2200
2201   result^.seek := glBitmapRWseek;
2202   result^.read := glBitmapRWread;
2203   result^.write := glBitmapRWwrite;
2204   result^.close := glBitmapRWclose;
2205   result^.unknown.data1 := Stream;
2206 end;
2207 {$ENDIF}
2208
2209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2210 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2211 begin
2212   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2213 end;
2214
2215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2216 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2217 begin
2218   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2219 end;
2220
2221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2222 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2223 begin
2224   glBitmapDefaultMipmap := aValue;
2225 end;
2226
2227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2228 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2229 begin
2230   glBitmapDefaultFormat := aFormat;
2231 end;
2232
2233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2234 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2235 begin
2236   glBitmapDefaultFilterMin := aMin;
2237   glBitmapDefaultFilterMag := aMag;
2238 end;
2239
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2242 begin
2243   glBitmapDefaultWrapS := S;
2244   glBitmapDefaultWrapT := T;
2245   glBitmapDefaultWrapR := R;
2246 end;
2247
2248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2250 begin
2251   glDefaultSwizzle[0] := r;
2252   glDefaultSwizzle[1] := g;
2253   glDefaultSwizzle[2] := b;
2254   glDefaultSwizzle[3] := a;
2255 end;
2256
2257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2258 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2259 begin
2260   result := glBitmapDefaultDeleteTextureOnFree;
2261 end;
2262
2263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2264 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2265 begin
2266   result := glBitmapDefaultFreeDataAfterGenTextures;
2267 end;
2268
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2271 begin
2272   result := glBitmapDefaultMipmap;
2273 end;
2274
2275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2276 function glBitmapGetDefaultFormat: TglBitmapFormat;
2277 begin
2278   result := glBitmapDefaultFormat;
2279 end;
2280
2281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2282 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2283 begin
2284   aMin := glBitmapDefaultFilterMin;
2285   aMag := glBitmapDefaultFilterMag;
2286 end;
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2290 begin
2291   S := glBitmapDefaultWrapS;
2292   T := glBitmapDefaultWrapT;
2293   R := glBitmapDefaultWrapR;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2298 begin
2299   r := glDefaultSwizzle[0];
2300   g := glDefaultSwizzle[1];
2301   b := glDefaultSwizzle[2];
2302   a := glDefaultSwizzle[3];
2303 end;
2304
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2308 function TFormatDescriptor.GetRedMask: QWord;
2309 begin
2310   result := fRange.r shl fShift.r;
2311 end;
2312
2313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2314 function TFormatDescriptor.GetGreenMask: QWord;
2315 begin
2316   result := fRange.g shl fShift.g;
2317 end;
2318
2319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 function TFormatDescriptor.GetBlueMask: QWord;
2321 begin
2322   result := fRange.b shl fShift.b;
2323 end;
2324
2325 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2326 function TFormatDescriptor.GetAlphaMask: QWord;
2327 begin
2328   result := fRange.a shl fShift.a;
2329 end;
2330
2331 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2332 function TFormatDescriptor.GetIsCompressed: Boolean;
2333 begin
2334   result := fIsCompressed;
2335 end;
2336
2337 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2338 function TFormatDescriptor.GetHasAlpha: Boolean;
2339 begin
2340   result := (fRange.a > 0);
2341 end;
2342
2343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2344 function TFormatDescriptor.GetglFormat: GLenum;
2345 begin
2346   result := fglFormat;
2347 end;
2348
2349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2350 function TFormatDescriptor.GetglInternalFormat: GLenum;
2351 begin
2352   result := fglInternalFormat;
2353 end;
2354
2355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2356 function TFormatDescriptor.GetglDataFormat: GLenum;
2357 begin
2358   result := fglDataFormat;
2359 end;
2360
2361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 function TFormatDescriptor.GetComponents: Integer;
2363 var
2364   i: Integer;
2365 begin
2366   result := 0;
2367   for i := 0 to 3 do
2368     if (fRange.arr[i] > 0) then
2369       inc(result);
2370 end;
2371
2372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2373 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2374 var
2375   w, h: Integer;
2376 begin
2377   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2378     w := Max(1, aSize.X);
2379     h := Max(1, aSize.Y);
2380     result := GetSize(w, h);
2381   end else
2382     result := 0;
2383 end;
2384
2385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2387 begin
2388   result := 0;
2389   if (aWidth <= 0) or (aHeight <= 0) then
2390     exit;
2391   result := Ceil(aWidth * aHeight * fPixelSize);
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.CreateMappingData: Pointer;
2396 begin
2397   result := nil;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2402 begin
2403   //DUMMY
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function TFormatDescriptor.IsEmpty: Boolean;
2408 begin
2409   result := (fFormat = tfEmpty);
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2414 begin
2415   result := false;
2416   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2417     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2418   if (aRedMask   <> RedMask) then
2419     exit;
2420   if (aGreenMask <> GreenMask) then
2421     exit;
2422   if (aBlueMask  <> BlueMask) then
2423     exit;
2424   if (aAlphaMask <> AlphaMask) then
2425     exit;
2426   result := true;
2427 end;
2428
2429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2430 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2431 begin
2432   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2433   aPixel.Data   := fRange;
2434   aPixel.Range  := fRange;
2435   aPixel.Format := fFormat;
2436 end;
2437
2438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2439 constructor TFormatDescriptor.Create;
2440 begin
2441   inherited Create;
2442
2443   fFormat       := tfEmpty;
2444   fWithAlpha    := tfEmpty;
2445   fWithoutAlpha := tfEmpty;
2446   fRGBInverted  := tfEmpty;
2447   fUncompressed := tfEmpty;
2448   fPixelSize    := 0.0;
2449   fIsCompressed := false;
2450
2451   fglFormat         := 0;
2452   fglInternalFormat := 0;
2453   fglDataFormat     := 0;
2454
2455   FillChar(fRange, 0, SizeOf(fRange));
2456   FillChar(fShift, 0, SizeOf(fShift));
2457 end;
2458
2459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2462 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2463 begin
2464   aData^ := aPixel.Data.a;
2465   inc(aData);
2466 end;
2467
2468 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2469 begin
2470   aPixel.Data.r := 0;
2471   aPixel.Data.g := 0;
2472   aPixel.Data.b := 0;
2473   aPixel.Data.a := aData^;
2474   inc(aData);
2475 end;
2476
2477 constructor TfdAlpha_UB1.Create;
2478 begin
2479   inherited Create;
2480   fPixelSize        := 1.0;
2481   fRange.a          := $FF;
2482   fglFormat         := GL_ALPHA;
2483   fglDataFormat     := GL_UNSIGNED_BYTE;
2484 end;
2485
2486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2487 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2490 begin
2491   aData^ := LuminanceWeight(aPixel);
2492   inc(aData);
2493 end;
2494
2495 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2496 begin
2497   aPixel.Data.r := aData^;
2498   aPixel.Data.g := aData^;
2499   aPixel.Data.b := aData^;
2500   aPixel.Data.a := 0;
2501   inc(aData);
2502 end;
2503
2504 constructor TfdLuminance_UB1.Create;
2505 begin
2506   inherited Create;
2507   fPixelSize        := 1.0;
2508   fRange.r          := $FF;
2509   fRange.g          := $FF;
2510   fRange.b          := $FF;
2511   fglFormat         := GL_LUMINANCE;
2512   fglDataFormat     := GL_UNSIGNED_BYTE;
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2519 var
2520   i: Integer;
2521 begin
2522   aData^ := 0;
2523   for i := 0 to 3 do
2524     if (fRange.arr[i] > 0) then
2525       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2526   inc(aData);
2527 end;
2528
2529 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2530 var
2531   i: Integer;
2532 begin
2533   for i := 0 to 3 do
2534     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2535   inc(aData);
2536 end;
2537
2538 constructor TfdUniversal_UB1.Create;
2539 begin
2540   inherited Create;
2541   fPixelSize := 1.0;
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2548 begin
2549   inherited Map(aPixel, aData, aMapData);
2550   aData^ := aPixel.Data.a;
2551   inc(aData);
2552 end;
2553
2554 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2555 begin
2556   inherited Unmap(aData, aPixel, aMapData);
2557   aPixel.Data.a := aData^;
2558   inc(aData);
2559 end;
2560
2561 constructor TfdLuminanceAlpha_UB2.Create;
2562 begin
2563   inherited Create;
2564   fPixelSize        := 2.0;
2565   fRange.a          := $FF;
2566   fShift.a          :=   8;
2567   fglFormat         := GL_LUMINANCE_ALPHA;
2568   fglDataFormat     := GL_UNSIGNED_BYTE;
2569 end;
2570
2571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2574 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2575 begin
2576   aData^ := aPixel.Data.r;
2577   inc(aData);
2578   aData^ := aPixel.Data.g;
2579   inc(aData);
2580   aData^ := aPixel.Data.b;
2581   inc(aData);
2582 end;
2583
2584 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2585 begin
2586   aPixel.Data.r := aData^;
2587   inc(aData);
2588   aPixel.Data.g := aData^;
2589   inc(aData);
2590   aPixel.Data.b := aData^;
2591   inc(aData);
2592   aPixel.Data.a := 0;
2593 end;
2594
2595 constructor TfdRGB_UB3.Create;
2596 begin
2597   inherited Create;
2598   fPixelSize        := 3.0;
2599   fRange.r          := $FF;
2600   fRange.g          := $FF;
2601   fRange.b          := $FF;
2602   fShift.r          :=   0;
2603   fShift.g          :=   8;
2604   fShift.b          :=  16;
2605   fglFormat         := GL_RGB;
2606   fglDataFormat     := GL_UNSIGNED_BYTE;
2607 end;
2608
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2613 begin
2614   aData^ := aPixel.Data.b;
2615   inc(aData);
2616   aData^ := aPixel.Data.g;
2617   inc(aData);
2618   aData^ := aPixel.Data.r;
2619   inc(aData);
2620 end;
2621
2622 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2623 begin
2624   aPixel.Data.b := aData^;
2625   inc(aData);
2626   aPixel.Data.g := aData^;
2627   inc(aData);
2628   aPixel.Data.r := aData^;
2629   inc(aData);
2630   aPixel.Data.a := 0;
2631 end;
2632
2633 constructor TfdBGR_UB3.Create;
2634 begin
2635   fPixelSize        := 3.0;
2636   fRange.r          := $FF;
2637   fRange.g          := $FF;
2638   fRange.b          := $FF;
2639   fShift.r          :=  16;
2640   fShift.g          :=   8;
2641   fShift.b          :=   0;
2642   fglFormat         := GL_BGR;
2643   fglDataFormat     := GL_UNSIGNED_BYTE;
2644 end;
2645
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2650 begin
2651   inherited Map(aPixel, aData, aMapData);
2652   aData^ := aPixel.Data.a;
2653   inc(aData);
2654 end;
2655
2656 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2657 begin
2658   inherited Unmap(aData, aPixel, aMapData);
2659   aPixel.Data.a := aData^;
2660   inc(aData);
2661 end;
2662
2663 constructor TfdRGBA_UB4.Create;
2664 begin
2665   inherited Create;
2666   fPixelSize        := 4.0;
2667   fRange.a          := $FF;
2668   fShift.a          :=  24;
2669   fglFormat         := GL_RGBA;
2670   fglDataFormat     := GL_UNSIGNED_BYTE;
2671 end;
2672
2673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2677 begin
2678   inherited Map(aPixel, aData, aMapData);
2679   aData^ := aPixel.Data.a;
2680   inc(aData);
2681 end;
2682
2683 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2684 begin
2685   inherited Unmap(aData, aPixel, aMapData);
2686   aPixel.Data.a := aData^;
2687   inc(aData);
2688 end;
2689
2690 constructor TfdBGRA_UB4.Create;
2691 begin
2692   inherited Create;
2693   fPixelSize        := 4.0;
2694   fRange.a          := $FF;
2695   fShift.a          :=  24;
2696   fglFormat         := GL_BGRA;
2697   fglDataFormat     := GL_UNSIGNED_BYTE;
2698 end;
2699
2700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2701 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2703 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2704 begin
2705   PWord(aData)^ := aPixel.Data.a;
2706   inc(aData, 2);
2707 end;
2708
2709 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2710 begin
2711   aPixel.Data.r := 0;
2712   aPixel.Data.g := 0;
2713   aPixel.Data.b := 0;
2714   aPixel.Data.a := PWord(aData)^;
2715   inc(aData, 2);
2716 end;
2717
2718 constructor TfdAlpha_US1.Create;
2719 begin
2720   inherited Create;
2721   fPixelSize        := 2.0;
2722   fRange.a          := $FFFF;
2723   fglFormat         := GL_ALPHA;
2724   fglDataFormat     := GL_UNSIGNED_SHORT;
2725 end;
2726
2727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2728 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2731 begin
2732   PWord(aData)^ := LuminanceWeight(aPixel);
2733   inc(aData, 2);
2734 end;
2735
2736 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2737 begin
2738   aPixel.Data.r := PWord(aData)^;
2739   aPixel.Data.g := PWord(aData)^;
2740   aPixel.Data.b := PWord(aData)^;
2741   aPixel.Data.a := 0;
2742   inc(aData, 2);
2743 end;
2744
2745 constructor TfdLuminance_US1.Create;
2746 begin
2747   inherited Create;
2748   fPixelSize        := 2.0;
2749   fRange.r          := $FFFF;
2750   fRange.g          := $FFFF;
2751   fRange.b          := $FFFF;
2752   fglFormat         := GL_LUMINANCE;
2753   fglDataFormat     := GL_UNSIGNED_SHORT;
2754 end;
2755
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2760 var
2761   i: Integer;
2762 begin
2763   PWord(aData)^ := 0;
2764   for i := 0 to 3 do
2765     if (fRange.arr[i] > 0) then
2766       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2767   inc(aData, 2);
2768 end;
2769
2770 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2771 var
2772   i: Integer;
2773 begin
2774   for i := 0 to 3 do
2775     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2776   inc(aData, 2);
2777 end;
2778
2779 constructor TfdUniversal_US1.Create;
2780 begin
2781   inherited Create;
2782   fPixelSize := 2.0;
2783 end;
2784
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2789 begin
2790   PWord(aData)^ := DepthWeight(aPixel);
2791   inc(aData, 2);
2792 end;
2793
2794 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2795 begin
2796   aPixel.Data.r := PWord(aData)^;
2797   aPixel.Data.g := PWord(aData)^;
2798   aPixel.Data.b := PWord(aData)^;
2799   aPixel.Data.a := 0;
2800   inc(aData, 2);
2801 end;
2802
2803 constructor TfdDepth_US1.Create;
2804 begin
2805   inherited Create;
2806   fPixelSize        := 2.0;
2807   fRange.r          := $FFFF;
2808   fRange.g          := $FFFF;
2809   fRange.b          := $FFFF;
2810   fglFormat         := GL_DEPTH_COMPONENT;
2811   fglDataFormat     := GL_UNSIGNED_SHORT;
2812 end;
2813
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2818 begin
2819   inherited Map(aPixel, aData, aMapData);
2820   PWord(aData)^ := aPixel.Data.a;
2821   inc(aData, 2);
2822 end;
2823
2824 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2825 begin
2826   inherited Unmap(aData, aPixel, aMapData);
2827   aPixel.Data.a := PWord(aData)^;
2828   inc(aData, 2);
2829 end;
2830
2831 constructor TfdLuminanceAlpha_US2.Create;
2832 begin
2833   inherited Create;
2834   fPixelSize        :=   4.0;
2835   fRange.a          := $FFFF;
2836   fShift.a          :=    16;
2837   fglFormat         := GL_LUMINANCE_ALPHA;
2838   fglDataFormat     := GL_UNSIGNED_SHORT;
2839 end;
2840
2841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2844 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2845 begin
2846   PWord(aData)^ := aPixel.Data.r;
2847   inc(aData, 2);
2848   PWord(aData)^ := aPixel.Data.g;
2849   inc(aData, 2);
2850   PWord(aData)^ := aPixel.Data.b;
2851   inc(aData, 2);
2852 end;
2853
2854 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2855 begin
2856   aPixel.Data.r := PWord(aData)^;
2857   inc(aData, 2);
2858   aPixel.Data.g := PWord(aData)^;
2859   inc(aData, 2);
2860   aPixel.Data.b := PWord(aData)^;
2861   inc(aData, 2);
2862   aPixel.Data.a := 0;
2863 end;
2864
2865 constructor TfdRGB_US3.Create;
2866 begin
2867   inherited Create;
2868   fPixelSize        :=   6.0;
2869   fRange.r          := $FFFF;
2870   fRange.g          := $FFFF;
2871   fRange.b          := $FFFF;
2872   fShift.r          :=     0;
2873   fShift.g          :=    16;
2874   fShift.b          :=    32;
2875   fglFormat         := GL_RGB;
2876   fglDataFormat     := GL_UNSIGNED_SHORT;
2877 end;
2878
2879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2883 begin
2884   PWord(aData)^ := aPixel.Data.b;
2885   inc(aData, 2);
2886   PWord(aData)^ := aPixel.Data.g;
2887   inc(aData, 2);
2888   PWord(aData)^ := aPixel.Data.r;
2889   inc(aData, 2);
2890 end;
2891
2892 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2893 begin
2894   aPixel.Data.b := PWord(aData)^;
2895   inc(aData, 2);
2896   aPixel.Data.g := PWord(aData)^;
2897   inc(aData, 2);
2898   aPixel.Data.r := PWord(aData)^;
2899   inc(aData, 2);
2900   aPixel.Data.a := 0;
2901 end;
2902
2903 constructor TfdBGR_US3.Create;
2904 begin
2905   inherited Create;
2906   fPixelSize        :=   6.0;
2907   fRange.r          := $FFFF;
2908   fRange.g          := $FFFF;
2909   fRange.b          := $FFFF;
2910   fShift.r          :=    32;
2911   fShift.g          :=    16;
2912   fShift.b          :=     0;
2913   fglFormat         := GL_BGR;
2914   fglDataFormat     := GL_UNSIGNED_SHORT;
2915 end;
2916
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2921 begin
2922   inherited Map(aPixel, aData, aMapData);
2923   PWord(aData)^ := aPixel.Data.a;
2924   inc(aData, 2);
2925 end;
2926
2927 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2928 begin
2929   inherited Unmap(aData, aPixel, aMapData);
2930   aPixel.Data.a := PWord(aData)^;
2931   inc(aData, 2);
2932 end;
2933
2934 constructor TfdRGBA_US4.Create;
2935 begin
2936   inherited Create;
2937   fPixelSize        :=   8.0;
2938   fRange.a          := $FFFF;
2939   fShift.a          :=    48;
2940   fglFormat         := GL_RGBA;
2941   fglDataFormat     := GL_UNSIGNED_SHORT;
2942 end;
2943
2944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2945 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2947 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2948 begin
2949   inherited Map(aPixel, aData, aMapData);
2950   PWord(aData)^ := aPixel.Data.a;
2951   inc(aData, 2);
2952 end;
2953
2954 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2955 begin
2956   inherited Unmap(aData, aPixel, aMapData);
2957   aPixel.Data.a := PWord(aData)^;
2958   inc(aData, 2);
2959 end;
2960
2961 constructor TfdBGRA_US4.Create;
2962 begin
2963   inherited Create;
2964   fPixelSize        :=   8.0;
2965   fRange.a          := $FFFF;
2966   fShift.a          :=    48;
2967   fglFormat         := GL_BGRA;
2968   fglDataFormat     := GL_UNSIGNED_SHORT;
2969 end;
2970
2971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2972 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2974 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2975 var
2976   i: Integer;
2977 begin
2978   PCardinal(aData)^ := 0;
2979   for i := 0 to 3 do
2980     if (fRange.arr[i] > 0) then
2981       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2982   inc(aData, 4);
2983 end;
2984
2985 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2986 var
2987   i: Integer;
2988 begin
2989   for i := 0 to 3 do
2990     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2991   inc(aData, 2);
2992 end;
2993
2994 constructor TfdUniversal_UI1.Create;
2995 begin
2996   inherited Create;
2997   fPixelSize := 4.0;
2998 end;
2999
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3004 begin
3005   PCardinal(aData)^ := DepthWeight(aPixel);
3006   inc(aData, 4);
3007 end;
3008
3009 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3010 begin
3011   aPixel.Data.r := PCardinal(aData)^;
3012   aPixel.Data.g := PCardinal(aData)^;
3013   aPixel.Data.b := PCardinal(aData)^;
3014   aPixel.Data.a := 0;
3015   inc(aData, 4);
3016 end;
3017
3018 constructor TfdDepth_UI1.Create;
3019 begin
3020   inherited Create;
3021   fPixelSize        := 4.0;
3022   fRange.r          := $FFFFFFFF;
3023   fRange.g          := $FFFFFFFF;
3024   fRange.b          := $FFFFFFFF;
3025   fglFormat         := GL_DEPTH_COMPONENT;
3026   fglDataFormat     := GL_UNSIGNED_INT;
3027 end;
3028
3029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 constructor TfdAlpha4.Create;
3033 begin
3034   inherited Create;
3035   fFormat           := tfAlpha4;
3036   fWithAlpha        := tfAlpha4;
3037   fglInternalFormat := GL_ALPHA4;
3038 end;
3039
3040 constructor TfdAlpha8.Create;
3041 begin
3042   inherited Create;
3043   fFormat           := tfAlpha8;
3044   fWithAlpha        := tfAlpha8;
3045   fglInternalFormat := GL_ALPHA8;
3046 end;
3047
3048 constructor TfdAlpha12.Create;
3049 begin
3050   inherited Create;
3051   fFormat           := tfAlpha12;
3052   fWithAlpha        := tfAlpha12;
3053   fglInternalFormat := GL_ALPHA12;
3054 end;
3055
3056 constructor TfdAlpha16.Create;
3057 begin
3058   inherited Create;
3059   fFormat           := tfAlpha16;
3060   fWithAlpha        := tfAlpha16;
3061   fglInternalFormat := GL_ALPHA16;
3062 end;
3063
3064 constructor TfdLuminance4.Create;
3065 begin
3066   inherited Create;
3067   fFormat           := tfLuminance4;
3068   fWithAlpha        := tfLuminance4Alpha4;
3069   fWithoutAlpha     := tfLuminance4;
3070   fglInternalFormat := GL_LUMINANCE4;
3071 end;
3072
3073 constructor TfdLuminance8.Create;
3074 begin
3075   inherited Create;
3076   fFormat           := tfLuminance8;
3077   fWithAlpha        := tfLuminance8Alpha8;
3078   fWithoutAlpha     := tfLuminance8;
3079   fglInternalFormat := GL_LUMINANCE8;
3080 end;
3081
3082 constructor TfdLuminance12.Create;
3083 begin
3084   inherited Create;
3085   fFormat           := tfLuminance12;
3086   fWithAlpha        := tfLuminance12Alpha12;
3087   fWithoutAlpha     := tfLuminance12;
3088   fglInternalFormat := GL_LUMINANCE12;
3089 end;
3090
3091 constructor TfdLuminance16.Create;
3092 begin
3093   inherited Create;
3094   fFormat           := tfLuminance16;
3095   fWithAlpha        := tfLuminance16Alpha16;
3096   fWithoutAlpha     := tfLuminance16;
3097   fglInternalFormat := GL_LUMINANCE16;
3098 end;
3099
3100 constructor TfdLuminance4Alpha4.Create;
3101 begin
3102   inherited Create;
3103   fFormat           := tfLuminance4Alpha4;
3104   fWithAlpha        := tfLuminance4Alpha4;
3105   fWithoutAlpha     := tfLuminance4;
3106   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3107 end;
3108
3109 constructor TfdLuminance6Alpha2.Create;
3110 begin
3111   inherited Create;
3112   fFormat           := tfLuminance6Alpha2;
3113   fWithAlpha        := tfLuminance6Alpha2;
3114   fWithoutAlpha     := tfLuminance8;
3115   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3116 end;
3117
3118 constructor TfdLuminance8Alpha8.Create;
3119 begin
3120   inherited Create;
3121   fFormat           := tfLuminance8Alpha8;
3122   fWithAlpha        := tfLuminance8Alpha8;
3123   fWithoutAlpha     := tfLuminance8;
3124   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3125 end;
3126
3127 constructor TfdLuminance12Alpha4.Create;
3128 begin
3129   inherited Create;
3130   fFormat           := tfLuminance12Alpha4;
3131   fWithAlpha        := tfLuminance12Alpha4;
3132   fWithoutAlpha     := tfLuminance12;
3133   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3134 end;
3135
3136 constructor TfdLuminance12Alpha12.Create;
3137 begin
3138   inherited Create;
3139   fFormat           := tfLuminance12Alpha12;
3140   fWithAlpha        := tfLuminance12Alpha12;
3141   fWithoutAlpha     := tfLuminance12;
3142   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3143 end;
3144
3145 constructor TfdLuminance16Alpha16.Create;
3146 begin
3147   inherited Create;
3148   fFormat           := tfLuminance16Alpha16;
3149   fWithAlpha        := tfLuminance16Alpha16;
3150   fWithoutAlpha     := tfLuminance16;
3151   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3152 end;
3153
3154 constructor TfdR3G3B2.Create;
3155 begin
3156   inherited Create;
3157   fFormat           := tfR3G3B2;
3158   fWithAlpha        := tfRGBA2;
3159   fWithoutAlpha     := tfR3G3B2;
3160   fRange.r          := $7;
3161   fRange.g          := $7;
3162   fRange.b          := $3;
3163   fShift.r          :=  0;
3164   fShift.g          :=  3;
3165   fShift.b          :=  6;
3166   fglFormat         := GL_RGB;
3167   fglInternalFormat := GL_R3_G3_B2;
3168   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3169 end;
3170
3171 constructor TfdRGB4.Create;
3172 begin
3173   inherited Create;
3174   fFormat           := tfRGB4;
3175   fWithAlpha        := tfRGBA4;
3176   fWithoutAlpha     := tfRGB4;
3177   fRGBInverted      := tfBGR4;
3178   fRange.r          := $F;
3179   fRange.g          := $F;
3180   fRange.b          := $F;
3181   fShift.r          :=  0;
3182   fShift.g          :=  4;
3183   fShift.b          :=  8;
3184   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3185   fglInternalFormat := GL_RGB4;
3186   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3187 end;
3188
3189 constructor TfdR5G6B5.Create;
3190 begin
3191   inherited Create;
3192   fFormat           := tfR5G6B5;
3193   fWithAlpha        := tfRGBA4;
3194   fWithoutAlpha     := tfR5G6B5;
3195   fRGBInverted      := tfB5G6R5;
3196   fRange.r          := $1F;
3197   fRange.g          := $3F;
3198   fRange.b          := $1F;
3199   fShift.r          :=   0;
3200   fShift.g          :=   5;
3201   fShift.b          :=  11;
3202   fglFormat         := GL_RGB;
3203   fglInternalFormat := GL_RGB565;
3204   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3205 end;
3206
3207 constructor TfdRGB5.Create;
3208 begin
3209   inherited Create;
3210   fFormat           := tfRGB5;
3211   fWithAlpha        := tfRGB5A1;
3212   fWithoutAlpha     := tfRGB5;
3213   fRGBInverted      := tfBGR5;
3214   fRange.r          := $1F;
3215   fRange.g          := $1F;
3216   fRange.b          := $1F;
3217   fShift.r          :=   0;
3218   fShift.g          :=   5;
3219   fShift.b          :=  10;
3220   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3221   fglInternalFormat := GL_RGB5;
3222   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3223 end;
3224
3225 constructor TfdRGB8.Create;
3226 begin
3227   inherited Create;
3228   fFormat           := tfRGB8;
3229   fWithAlpha        := tfRGBA8;
3230   fWithoutAlpha     := tfRGB8;
3231   fRGBInverted      := tfBGR8;
3232   fglInternalFormat := GL_RGB8;
3233 end;
3234
3235 constructor TfdRGB10.Create;
3236 begin
3237   inherited Create;
3238   fFormat           := tfRGB10;
3239   fWithAlpha        := tfRGB10A2;
3240   fWithoutAlpha     := tfRGB10;
3241   fRGBInverted      := tfBGR10;
3242   fRange.r          := $3FF;
3243   fRange.g          := $3FF;
3244   fRange.b          := $3FF;
3245   fShift.r          :=    0;
3246   fShift.g          :=   10;
3247   fShift.b          :=   20;
3248   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3249   fglInternalFormat := GL_RGB10;
3250   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3251 end;
3252
3253 constructor TfdRGB12.Create;
3254 begin
3255   inherited Create;
3256   fFormat           := tfRGB12;
3257   fWithAlpha        := tfRGBA12;
3258   fWithoutAlpha     := tfRGB12;
3259   fRGBInverted      := tfBGR12;
3260   fglInternalFormat := GL_RGB12;
3261 end;
3262
3263 constructor TfdRGB16.Create;
3264 begin
3265   inherited Create;
3266   fFormat           := tfRGB16;
3267   fWithAlpha        := tfRGBA16;
3268   fWithoutAlpha     := tfRGB16;
3269   fRGBInverted      := tfBGR16;
3270   fglInternalFormat := GL_RGB16;
3271 end;
3272
3273 constructor TfdRGBA2.Create;
3274 begin
3275   inherited Create;
3276   fFormat           := tfRGBA2;
3277   fWithAlpha        := tfRGBA2;
3278   fWithoutAlpha     := tfR3G3B2;
3279   fRGBInverted      := tfBGRA2;
3280   fglInternalFormat := GL_RGBA2;
3281 end;
3282
3283 constructor TfdRGBA4.Create;
3284 begin
3285   inherited Create;
3286   fFormat           := tfRGBA4;
3287   fWithAlpha        := tfRGBA4;
3288   fWithoutAlpha     := tfRGB4;
3289   fRGBInverted      := tfBGRA4;
3290   fRange.r          := $F;
3291   fRange.g          := $F;
3292   fRange.b          := $F;
3293   fRange.a          := $F;
3294   fShift.r          :=  0;
3295   fShift.g          :=  4;
3296   fShift.b          :=  8;
3297   fShift.a          := 12;
3298   fglFormat         := GL_RGBA;
3299   fglInternalFormat := GL_RGBA4;
3300   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3301 end;
3302
3303 constructor TfdRGB5A1.Create;
3304 begin
3305   inherited Create;
3306   fFormat           := tfRGB5A1;
3307   fWithAlpha        := tfRGB5A1;
3308   fWithoutAlpha     := tfRGB5;
3309   fRGBInverted      := tfBGR5A1;
3310   fRange.r          := $1F;
3311   fRange.g          := $1F;
3312   fRange.b          := $1F;
3313   fRange.a          := $01;
3314   fShift.r          :=   0;
3315   fShift.g          :=   5;
3316   fShift.b          :=  10;
3317   fShift.a          :=  15;
3318   fglFormat         := GL_RGBA;
3319   fglInternalFormat := GL_RGB5_A1;
3320   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3321 end;
3322
3323 constructor TfdRGBA8.Create;
3324 begin
3325   inherited Create;
3326   fFormat           := tfRGBA8;
3327   fWithAlpha        := tfRGBA8;
3328   fWithoutAlpha     := tfRGB8;
3329   fRGBInverted      := tfBGRA8;
3330   fglInternalFormat := GL_RGBA8;
3331 end;
3332
3333 constructor TfdRGB10A2.Create;
3334 begin
3335   inherited Create;
3336   fFormat           := tfRGB10A2;
3337   fWithAlpha        := tfRGB10A2;
3338   fWithoutAlpha     := tfRGB10;
3339   fRGBInverted      := tfBGR10A2;
3340   fRange.r          := $3FF;
3341   fRange.g          := $3FF;
3342   fRange.b          := $3FF;
3343   fRange.a          := $003;
3344   fShift.r          :=    0;
3345   fShift.g          :=   10;
3346   fShift.b          :=   20;
3347   fShift.a          :=   30;
3348   fglFormat         := GL_RGBA;
3349   fglInternalFormat := GL_RGB10_A2;
3350   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3351 end;
3352
3353 constructor TfdRGBA12.Create;
3354 begin
3355   inherited Create;
3356   fFormat           := tfRGBA12;
3357   fWithAlpha        := tfRGBA12;
3358   fWithoutAlpha     := tfRGB12;
3359   fRGBInverted      := tfBGRA12;
3360   fglInternalFormat := GL_RGBA12;
3361 end;
3362
3363 constructor TfdRGBA16.Create;
3364 begin
3365   inherited Create;
3366   fFormat           := tfRGBA16;
3367   fWithAlpha        := tfRGBA16;
3368   fWithoutAlpha     := tfRGB16;
3369   fRGBInverted      := tfBGRA16;
3370   fglInternalFormat := GL_RGBA16;
3371 end;
3372
3373 constructor TfdBGR4.Create;
3374 begin
3375   inherited Create;
3376   fPixelSize        := 2.0;
3377   fFormat           := tfBGR4;
3378   fWithAlpha        := tfBGRA4;
3379   fWithoutAlpha     := tfBGR4;
3380   fRGBInverted      := tfRGB4;
3381   fRange.r          := $F;
3382   fRange.g          := $F;
3383   fRange.b          := $F;
3384   fRange.a          := $0;
3385   fShift.r          :=  8;
3386   fShift.g          :=  4;
3387   fShift.b          :=  0;
3388   fShift.a          :=  0;
3389   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3390   fglInternalFormat := GL_RGB4;
3391   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3392 end;
3393
3394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3397 constructor TfdB5G6R5.Create;
3398 begin
3399   inherited Create;
3400   fFormat           := tfB5G6R5;
3401   fWithAlpha        := tfBGRA4;
3402   fWithoutAlpha     := tfB5G6R5;
3403   fRGBInverted      := tfR5G6B5;
3404   fRange.r          := $1F;
3405   fRange.g          := $3F;
3406   fRange.b          := $1F;
3407   fShift.r          :=  11;
3408   fShift.g          :=   5;
3409   fShift.b          :=   0;
3410   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3411   fglInternalFormat := GL_RGB8;
3412   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3413 end;
3414
3415 constructor TfdBGR5.Create;
3416 begin
3417   inherited Create;
3418   fPixelSize        := 2.0;
3419   fFormat           := tfBGR5;
3420   fWithAlpha        := tfBGR5A1;
3421   fWithoutAlpha     := tfBGR5;
3422   fRGBInverted      := tfRGB5;
3423   fRange.r          := $1F;
3424   fRange.g          := $1F;
3425   fRange.b          := $1F;
3426   fRange.a          := $00;
3427   fShift.r          :=  10;
3428   fShift.g          :=   5;
3429   fShift.b          :=   0;
3430   fShift.a          :=   0;
3431   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3432   fglInternalFormat := GL_RGB5;
3433   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3434 end;
3435
3436 constructor TfdBGR8.Create;
3437 begin
3438   inherited Create;
3439   fFormat           := tfBGR8;
3440   fWithAlpha        := tfBGRA8;
3441   fWithoutAlpha     := tfBGR8;
3442   fRGBInverted      := tfRGB8;
3443   fglInternalFormat := GL_RGB8;
3444 end;
3445
3446 constructor TfdBGR10.Create;
3447 begin
3448   inherited Create;
3449   fFormat           := tfBGR10;
3450   fWithAlpha        := tfBGR10A2;
3451   fWithoutAlpha     := tfBGR10;
3452   fRGBInverted      := tfRGB10;
3453   fRange.r          := $3FF;
3454   fRange.g          := $3FF;
3455   fRange.b          := $3FF;
3456   fRange.a          := $000;
3457   fShift.r          :=   20;
3458   fShift.g          :=   10;
3459   fShift.b          :=    0;
3460   fShift.a          :=    0;
3461   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3462   fglInternalFormat := GL_RGB10;
3463   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3464 end;
3465
3466 constructor TfdBGR12.Create;
3467 begin
3468   inherited Create;
3469   fFormat           := tfBGR12;
3470   fWithAlpha        := tfBGRA12;
3471   fWithoutAlpha     := tfBGR12;
3472   fRGBInverted      := tfRGB12;
3473   fglInternalFormat := GL_RGB12;
3474 end;
3475
3476 constructor TfdBGR16.Create;
3477 begin
3478   inherited Create;
3479   fFormat           := tfBGR16;
3480   fWithAlpha        := tfBGRA16;
3481   fWithoutAlpha     := tfBGR16;
3482   fRGBInverted      := tfRGB16;
3483   fglInternalFormat := GL_RGB16;
3484 end;
3485
3486 constructor TfdBGRA2.Create;
3487 begin
3488   inherited Create;
3489   fFormat           := tfBGRA2;
3490   fWithAlpha        := tfBGRA4;
3491   fWithoutAlpha     := tfBGR4;
3492   fRGBInverted      := tfRGBA2;
3493   fglInternalFormat := GL_RGBA2;
3494 end;
3495
3496 constructor TfdBGRA4.Create;
3497 begin
3498   inherited Create;
3499   fFormat           := tfBGRA4;
3500   fWithAlpha        := tfBGRA4;
3501   fWithoutAlpha     := tfBGR4;
3502   fRGBInverted      := tfRGBA4;
3503   fRange.r          := $F;
3504   fRange.g          := $F;
3505   fRange.b          := $F;
3506   fRange.a          := $F;
3507   fShift.r          :=  8;
3508   fShift.g          :=  4;
3509   fShift.b          :=  0;
3510   fShift.a          := 12;
3511   fglFormat         := GL_BGRA;
3512   fglInternalFormat := GL_RGBA4;
3513   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3514 end;
3515
3516 constructor TfdBGR5A1.Create;
3517 begin
3518   inherited Create;
3519   fFormat           := tfBGR5A1;
3520   fWithAlpha        := tfBGR5A1;
3521   fWithoutAlpha     := tfBGR5;
3522   fRGBInverted      := tfRGB5A1;
3523   fRange.r          := $1F;
3524   fRange.g          := $1F;
3525   fRange.b          := $1F;
3526   fRange.a          := $01;
3527   fShift.r          :=  10;
3528   fShift.g          :=   5;
3529   fShift.b          :=   0;
3530   fShift.a          :=  15;
3531   fglFormat         := GL_BGRA;
3532   fglInternalFormat := GL_RGB5_A1;
3533   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3534 end;
3535
3536 constructor TfdBGRA8.Create;
3537 begin
3538   inherited Create;
3539   fFormat           := tfBGRA8;
3540   fWithAlpha        := tfBGRA8;
3541   fWithoutAlpha     := tfBGR8;
3542   fRGBInverted      := tfRGBA8;
3543   fglInternalFormat := GL_RGBA8;
3544 end;
3545
3546 constructor TfdBGR10A2.Create;
3547 begin
3548   inherited Create;
3549   fFormat           := tfBGR10A2;
3550   fWithAlpha        := tfBGR10A2;
3551   fWithoutAlpha     := tfBGR10;
3552   fRGBInverted      := tfRGB10A2;
3553   fRange.r          := $3FF;
3554   fRange.g          := $3FF;
3555   fRange.b          := $3FF;
3556   fRange.a          := $003;
3557   fShift.r          :=   20;
3558   fShift.g          :=   10;
3559   fShift.b          :=    0;
3560   fShift.a          :=   30;
3561   fglFormat         := GL_BGRA;
3562   fglInternalFormat := GL_RGB10_A2;
3563   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3564 end;
3565
3566 constructor TfdBGRA12.Create;
3567 begin
3568   inherited Create;
3569   fFormat           := tfBGRA12;
3570   fWithAlpha        := tfBGRA12;
3571   fWithoutAlpha     := tfBGR12;
3572   fRGBInverted      := tfRGBA12;
3573   fglInternalFormat := GL_RGBA12;
3574 end;
3575
3576 constructor TfdBGRA16.Create;
3577 begin
3578   inherited Create;
3579   fFormat           := tfBGRA16;
3580   fWithAlpha        := tfBGRA16;
3581   fWithoutAlpha     := tfBGR16;
3582   fRGBInverted      := tfRGBA16;
3583   fglInternalFormat := GL_RGBA16;
3584 end;
3585
3586 constructor TfdDepth16.Create;
3587 begin
3588   inherited Create;
3589   fFormat           := tfDepth16;
3590   fWithAlpha        := tfEmpty;
3591   fWithoutAlpha     := tfDepth16;
3592   fglInternalFormat := GL_DEPTH_COMPONENT16;
3593 end;
3594
3595 constructor TfdDepth24.Create;
3596 begin
3597   inherited Create;
3598   fFormat           := tfDepth24;
3599   fWithAlpha        := tfEmpty;
3600   fWithoutAlpha     := tfDepth24;
3601   fglInternalFormat := GL_DEPTH_COMPONENT24;
3602 end;
3603
3604 constructor TfdDepth32.Create;
3605 begin
3606   inherited Create;
3607   fFormat           := tfDepth32;
3608   fWithAlpha        := tfEmpty;
3609   fWithoutAlpha     := tfDepth32;
3610   fglInternalFormat := GL_DEPTH_COMPONENT32;
3611 end;
3612
3613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3614 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3616 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3617 begin
3618   raise EglBitmap.Create('mapping for compressed formats is not supported');
3619 end;
3620
3621 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3622 begin
3623   raise EglBitmap.Create('mapping for compressed formats is not supported');
3624 end;
3625
3626 constructor TfdS3tcDtx1RGBA.Create;
3627 begin
3628   inherited Create;
3629   fFormat           := tfS3tcDtx1RGBA;
3630   fWithAlpha        := tfS3tcDtx1RGBA;
3631   fUncompressed     := tfRGB5A1;
3632   fPixelSize        := 0.5;
3633   fIsCompressed     := true;
3634   fglFormat         := GL_COMPRESSED_RGBA;
3635   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3636   fglDataFormat     := GL_UNSIGNED_BYTE;
3637 end;
3638
3639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3640 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3642 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3643 begin
3644   raise EglBitmap.Create('mapping for compressed formats is not supported');
3645 end;
3646
3647 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3648 begin
3649   raise EglBitmap.Create('mapping for compressed formats is not supported');
3650 end;
3651
3652 constructor TfdS3tcDtx3RGBA.Create;
3653 begin
3654   inherited Create;
3655   fFormat           := tfS3tcDtx3RGBA;
3656   fWithAlpha        := tfS3tcDtx3RGBA;
3657   fUncompressed     := tfRGBA8;
3658   fPixelSize        := 1.0;
3659   fIsCompressed     := true;
3660   fglFormat         := GL_COMPRESSED_RGBA;
3661   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3662   fglDataFormat     := GL_UNSIGNED_BYTE;
3663 end;
3664
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3668 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3669 begin
3670   raise EglBitmap.Create('mapping for compressed formats is not supported');
3671 end;
3672
3673 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3674 begin
3675   raise EglBitmap.Create('mapping for compressed formats is not supported');
3676 end;
3677
3678 constructor TfdS3tcDtx5RGBA.Create;
3679 begin
3680   inherited Create;
3681   fFormat           := tfS3tcDtx3RGBA;
3682   fWithAlpha        := tfS3tcDtx3RGBA;
3683   fUncompressed     := tfRGBA8;
3684   fPixelSize        := 1.0;
3685   fIsCompressed     := true;
3686   fglFormat         := GL_COMPRESSED_RGBA;
3687   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3688   fglDataFormat     := GL_UNSIGNED_BYTE;
3689 end;
3690
3691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3692 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3694 class procedure TFormatDescriptor.Init;
3695 begin
3696   if not Assigned(FormatDescriptorCS) then
3697     FormatDescriptorCS := TCriticalSection.Create;
3698 end;
3699
3700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3701 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3702 begin
3703   FormatDescriptorCS.Enter;
3704   try
3705     result := FormatDescriptors[aFormat];
3706     if not Assigned(result) then begin
3707       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3708       FormatDescriptors[aFormat] := result;
3709     end;
3710   finally
3711     FormatDescriptorCS.Leave;
3712   end;
3713 end;
3714
3715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3716 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3717 begin
3718   result := Get(Get(aFormat).WithAlpha);
3719 end;
3720
3721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3722 class procedure TFormatDescriptor.Clear;
3723 var
3724   f: TglBitmapFormat;
3725 begin
3726   FormatDescriptorCS.Enter;
3727   try
3728     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3729       FreeAndNil(FormatDescriptors[f]);
3730   finally
3731     FormatDescriptorCS.Leave;
3732   end;
3733 end;
3734
3735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3736 class procedure TFormatDescriptor.Finalize;
3737 begin
3738   Clear;
3739   FreeAndNil(FormatDescriptorCS);
3740 end;
3741
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3746 begin
3747   Update(aValue, fRange.r, fShift.r);
3748 end;
3749
3750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3751 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3752 begin
3753   Update(aValue, fRange.g, fShift.g);
3754 end;
3755
3756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3757 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3758 begin
3759   Update(aValue, fRange.b, fShift.b);
3760 end;
3761
3762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3763 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3764 begin
3765   Update(aValue, fRange.a, fShift.a);
3766 end;
3767
3768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3769 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3770   aShift: Byte);
3771 begin
3772   aShift := 0;
3773   aRange := 0;
3774   if (aMask = 0) then
3775     exit;
3776   while (aMask > 0) and ((aMask and 1) = 0) do begin
3777     inc(aShift);
3778     aMask := aMask shr 1;
3779   end;
3780   aRange := 1;
3781   while (aMask > 0) do begin
3782     aRange := aRange shl 1;
3783     aMask  := aMask  shr 1;
3784   end;
3785   dec(aRange);
3786
3787   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3788 end;
3789
3790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3791 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3792 var
3793   data: QWord;
3794   s: Integer;
3795 begin
3796   data :=
3797     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3798     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3799     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3800     ((aPixel.Data.a and fRange.a) shl fShift.a);
3801   s := Round(fPixelSize);
3802   case s of
3803     1:           aData^  := data;
3804     2:     PWord(aData)^ := data;
3805     4: PCardinal(aData)^ := data;
3806     8:    PQWord(aData)^ := data;
3807   else
3808     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3809   end;
3810   inc(aData, s);
3811 end;
3812
3813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3814 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3815 var
3816   data: QWord;
3817   s, i: Integer;
3818 begin
3819   s := Round(fPixelSize);
3820   case s of
3821     1: data :=           aData^;
3822     2: data :=     PWord(aData)^;
3823     4: data := PCardinal(aData)^;
3824     8: data :=    PQWord(aData)^;
3825   else
3826     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3827   end;
3828   for i := 0 to 3 do
3829     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3830   inc(aData, s);
3831 end;
3832
3833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3834 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3836 procedure TbmpColorTableFormat.CreateColorTable;
3837 var
3838   i: Integer;
3839 begin
3840   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3841     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3842
3843   if (Format = tfLuminance4) then
3844     SetLength(fColorTable, 16)
3845   else
3846     SetLength(fColorTable, 256);
3847
3848   case Format of
3849     tfLuminance4: begin
3850       for i := 0 to High(fColorTable) do begin
3851         fColorTable[i].r := 16 * i;
3852         fColorTable[i].g := 16 * i;
3853         fColorTable[i].b := 16 * i;
3854         fColorTable[i].a := 0;
3855       end;
3856     end;
3857
3858     tfLuminance8: begin
3859       for i := 0 to High(fColorTable) do begin
3860         fColorTable[i].r := i;
3861         fColorTable[i].g := i;
3862         fColorTable[i].b := i;
3863         fColorTable[i].a := 0;
3864       end;
3865     end;
3866
3867     tfR3G3B2: begin
3868       for i := 0 to High(fColorTable) do begin
3869         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3870         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3871         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3872         fColorTable[i].a := 0;
3873       end;
3874     end;
3875   end;
3876 end;
3877
3878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3879 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3880 var
3881   d: Byte;
3882 begin
3883   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3884     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3885
3886   case Format of
3887     tfLuminance4: begin
3888       if (aMapData = nil) then
3889         aData^ := 0;
3890       d := LuminanceWeight(aPixel) and Range.r;
3891       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3892       inc(PByte(aMapData), 4);
3893       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3894         inc(aData);
3895         aMapData := nil;
3896       end;
3897     end;
3898
3899     tfLuminance8: begin
3900       aData^ := LuminanceWeight(aPixel) and Range.r;
3901       inc(aData);
3902     end;
3903
3904     tfR3G3B2: begin
3905       aData^ := Round(
3906         ((aPixel.Data.r and Range.r) shl Shift.r) or
3907         ((aPixel.Data.g and Range.g) shl Shift.g) or
3908         ((aPixel.Data.b and Range.b) shl Shift.b));
3909       inc(aData);
3910     end;
3911   end;
3912 end;
3913
3914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3915 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3916 var
3917   idx: QWord;
3918   s: Integer;
3919   bits: Byte;
3920   f: Single;
3921 begin
3922   s    := Trunc(fPixelSize);
3923   f    := fPixelSize - s;
3924   bits := Round(8 * f);
3925   case s of
3926     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3927     1: idx :=           aData^;
3928     2: idx :=     PWord(aData)^;
3929     4: idx := PCardinal(aData)^;
3930     8: idx :=    PQWord(aData)^;
3931   else
3932     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3933   end;
3934   if (idx >= Length(fColorTable)) then
3935     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3936   with fColorTable[idx] do begin
3937     aPixel.Data.r := r;
3938     aPixel.Data.g := g;
3939     aPixel.Data.b := b;
3940     aPixel.Data.a := a;
3941   end;
3942   inc(PByte(aMapData), bits);
3943   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3944     inc(aData, 1);
3945     dec(PByte(aMapData), 8);
3946   end;
3947   inc(aData, s);
3948 end;
3949
3950 destructor TbmpColorTableFormat.Destroy;
3951 begin
3952   SetLength(fColorTable, 0);
3953   inherited Destroy;
3954 end;
3955
3956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3957 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3959 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3960 var
3961   i: Integer;
3962 begin
3963   for i := 0 to 3 do begin
3964     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3965       if (aSourceFD.Range.arr[i] > 0) then
3966         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3967       else
3968         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3969     end;
3970   end;
3971 end;
3972
3973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3974 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3975 begin
3976   with aFuncRec do begin
3977     if (Source.Range.r   > 0) then
3978       Dest.Data.r := Source.Data.r;
3979     if (Source.Range.g > 0) then
3980       Dest.Data.g := Source.Data.g;
3981     if (Source.Range.b  > 0) then
3982       Dest.Data.b := Source.Data.b;
3983     if (Source.Range.a > 0) then
3984       Dest.Data.a := Source.Data.a;
3985   end;
3986 end;
3987
3988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3990 var
3991   i: Integer;
3992 begin
3993   with aFuncRec do begin
3994     for i := 0 to 3 do
3995       if (Source.Range.arr[i] > 0) then
3996         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3997   end;
3998 end;
3999
4000 type
4001   TShiftData = packed record
4002     case Integer of
4003       0: (r, g, b, a: SmallInt);
4004       1: (arr: array[0..3] of SmallInt);
4005   end;
4006   PShiftData = ^TShiftData;
4007
4008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4009 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4010 var
4011   i: Integer;
4012 begin
4013   with aFuncRec do
4014     for i := 0 to 3 do
4015       if (Source.Range.arr[i] > 0) then
4016         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4017 end;
4018
4019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4020 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4021 begin
4022   with aFuncRec do begin
4023     Dest.Data := Source.Data;
4024     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4025       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4026       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4027       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4028     end;
4029     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4030       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4031     end;
4032   end;
4033 end;
4034
4035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4036 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4037 var
4038   i: Integer;
4039 begin
4040   with aFuncRec do begin
4041     for i := 0 to 3 do
4042       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4043   end;
4044 end;
4045
4046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4047 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4048 var
4049   Temp: Single;
4050 begin
4051   with FuncRec do begin
4052     if (FuncRec.Args = nil) then begin //source has no alpha
4053       Temp :=
4054         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4055         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4056         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4057       Dest.Data.a := Round(Dest.Range.a * Temp);
4058     end else
4059       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4060   end;
4061 end;
4062
4063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4064 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4065 type
4066   PglBitmapPixelData = ^TglBitmapPixelData;
4067 begin
4068   with FuncRec do begin
4069     Dest.Data.r := Source.Data.r;
4070     Dest.Data.g := Source.Data.g;
4071     Dest.Data.b := Source.Data.b;
4072
4073     with PglBitmapPixelData(Args)^ do
4074       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4075           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4076           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4077         Dest.Data.a := 0
4078       else
4079         Dest.Data.a := Dest.Range.a;
4080   end;
4081 end;
4082
4083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4084 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4085 begin
4086   with FuncRec do begin
4087     Dest.Data.r := Source.Data.r;
4088     Dest.Data.g := Source.Data.g;
4089     Dest.Data.b := Source.Data.b;
4090     Dest.Data.a := PCardinal(Args)^;
4091   end;
4092 end;
4093
4094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4095 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4096 type
4097   PRGBPix = ^TRGBPix;
4098   TRGBPix = array [0..2] of byte;
4099 var
4100   Temp: Byte;
4101 begin
4102   while aWidth > 0 do begin
4103     Temp := PRGBPix(aData)^[0];
4104     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4105     PRGBPix(aData)^[2] := Temp;
4106
4107     if aHasAlpha then
4108       Inc(aData, 4)
4109     else
4110       Inc(aData, 3);
4111     dec(aWidth);
4112   end;
4113 end;
4114
4115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4116 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4119 begin
4120   result := TFormatDescriptor.Get(Format);
4121 end;
4122
4123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4124 function TglBitmap.GetWidth: Integer;
4125 begin
4126   if (ffX in fDimension.Fields) then
4127     result := fDimension.X
4128   else
4129     result := -1;
4130 end;
4131
4132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4133 function TglBitmap.GetHeight: Integer;
4134 begin
4135   if (ffY in fDimension.Fields) then
4136     result := fDimension.Y
4137   else
4138     result := -1;
4139 end;
4140
4141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4142 function TglBitmap.GetFileWidth: Integer;
4143 begin
4144   result := Max(1, Width);
4145 end;
4146
4147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 function TglBitmap.GetFileHeight: Integer;
4149 begin
4150   result := Max(1, Height);
4151 end;
4152
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4155 begin
4156   if fCustomData = aValue then
4157     exit;
4158   fCustomData := aValue;
4159 end;
4160
4161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4162 procedure TglBitmap.SetCustomName(const aValue: String);
4163 begin
4164   if fCustomName = aValue then
4165     exit;
4166   fCustomName := aValue;
4167 end;
4168
4169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4170 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4171 begin
4172   if fCustomNameW = aValue then
4173     exit;
4174   fCustomNameW := aValue;
4175 end;
4176
4177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4178 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4179 begin
4180   if fDeleteTextureOnFree = aValue then
4181     exit;
4182   fDeleteTextureOnFree := aValue;
4183 end;
4184
4185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4186 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4187 begin
4188   if fFormat = aValue then
4189     exit;
4190   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4191     raise EglBitmapUnsupportedFormat.Create(Format);
4192   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4197 begin
4198   if fFreeDataAfterGenTexture = aValue then
4199     exit;
4200   fFreeDataAfterGenTexture := aValue;
4201 end;
4202
4203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4204 procedure TglBitmap.SetID(const aValue: Cardinal);
4205 begin
4206   if fID = aValue then
4207     exit;
4208   fID := aValue;
4209 end;
4210
4211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4212 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4213 begin
4214   if fMipMap = aValue then
4215     exit;
4216   fMipMap := aValue;
4217 end;
4218
4219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4220 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4221 begin
4222   if fTarget = aValue then
4223     exit;
4224   fTarget := aValue;
4225 end;
4226
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4229 var
4230   MaxAnisotropic: Integer;
4231 begin
4232   fAnisotropic := aValue;
4233   if (ID > 0) then begin
4234     if GL_EXT_texture_filter_anisotropic then begin
4235       if fAnisotropic > 0 then begin
4236         Bind(false);
4237         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4238         if aValue > MaxAnisotropic then
4239           fAnisotropic := MaxAnisotropic;
4240         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4241       end;
4242     end else begin
4243       fAnisotropic := 0;
4244     end;
4245   end;
4246 end;
4247
4248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4249 procedure TglBitmap.CreateID;
4250 begin
4251   if (ID <> 0) then
4252     glDeleteTextures(1, @fID);
4253   glGenTextures(1, @fID);
4254   Bind(false);
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4259 begin
4260   // Set Up Parameters
4261   SetWrap(fWrapS, fWrapT, fWrapR);
4262   SetFilter(fFilterMin, fFilterMag);
4263   SetAnisotropic(fAnisotropic);
4264   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4265
4266   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4267     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4268
4269   // Mip Maps Generation Mode
4270   aBuildWithGlu := false;
4271   if (MipMap = mmMipmap) then begin
4272     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4273       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4274     else
4275       aBuildWithGlu := true;
4276   end else if (MipMap = mmMipmapGlu) then
4277     aBuildWithGlu := true;
4278 end;
4279
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4282   const aWidth: Integer; const aHeight: Integer);
4283 var
4284   s: Single;
4285 begin
4286   if (Data <> aData) then begin
4287     if (Assigned(Data)) then
4288       FreeMem(Data);
4289     fData := aData;
4290   end;
4291
4292   if not Assigned(fData) then begin
4293     fPixelSize := 0;
4294     fRowSize   := 0;
4295   end else begin
4296     FillChar(fDimension, SizeOf(fDimension), 0);
4297     if aWidth <> -1 then begin
4298       fDimension.Fields := fDimension.Fields + [ffX];
4299       fDimension.X := aWidth;
4300     end;
4301
4302     if aHeight <> -1 then begin
4303       fDimension.Fields := fDimension.Fields + [ffY];
4304       fDimension.Y := aHeight;
4305     end;
4306
4307     s := TFormatDescriptor.Get(aFormat).PixelSize;
4308     fFormat    := aFormat;
4309     fPixelSize := Ceil(s);
4310     fRowSize   := Ceil(s * aWidth);
4311   end;
4312 end;
4313
4314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4315 function TglBitmap.FlipHorz: Boolean;
4316 begin
4317   result := false;
4318 end;
4319
4320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4321 function TglBitmap.FlipVert: Boolean;
4322 begin
4323   result := false;
4324 end;
4325
4326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4327 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4329 procedure TglBitmap.AfterConstruction;
4330 begin
4331   inherited AfterConstruction;
4332
4333   fID         := 0;
4334   fTarget     := 0;
4335   fIsResident := false;
4336
4337   fFormat                  := glBitmapGetDefaultFormat;
4338   fMipMap                  := glBitmapDefaultMipmap;
4339   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4340   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4341
4342   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4343   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4344   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 procedure TglBitmap.BeforeDestruction;
4349 var
4350   NewData: PByte;
4351 begin
4352   NewData := nil;
4353   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4354   if (fID > 0) and fDeleteTextureOnFree then
4355     glDeleteTextures(1, @fID);
4356   inherited BeforeDestruction;
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4361 var
4362   TempPos: Integer;
4363 begin
4364   if not Assigned(aResType) then begin
4365     TempPos   := Pos('.', aResource);
4366     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4367     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4368   end;
4369 end;
4370
4371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4372 procedure TglBitmap.LoadFromFile(const aFilename: String);
4373 var
4374   fs: TFileStream;
4375 begin
4376   if not FileExists(aFilename) then
4377     raise EglBitmap.Create('file does not exist: ' + aFilename);
4378   fFilename := aFilename;
4379   fs := TFileStream.Create(fFilename, fmOpenRead);
4380   try
4381     fs.Position := 0;
4382     LoadFromStream(fs);
4383   finally
4384     fs.Free;
4385   end;
4386 end;
4387
4388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4389 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4390 begin
4391   {$IFDEF GLB_SUPPORT_PNG_READ}
4392   if not LoadPNG(aStream) then
4393   {$ENDIF}
4394   {$IFDEF GLB_SUPPORT_JPEG_READ}
4395   if not LoadJPEG(aStream) then
4396   {$ENDIF}
4397   if not LoadDDS(aStream) then
4398   if not LoadTGA(aStream) then
4399   if not LoadBMP(aStream) then
4400     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4401 end;
4402
4403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4404 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4405   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4406 var
4407   tmpData: PByte;
4408   size: Integer;
4409 begin
4410   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4411   GetMem(tmpData, size);
4412   try
4413     FillChar(tmpData^, size, #$FF);
4414     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4415   except
4416     if Assigned(tmpData) then
4417       FreeMem(tmpData);
4418     raise;
4419   end;
4420   AddFunc(Self, aFunc, false, Format, aArgs);
4421 end;
4422
4423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4424 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4425 var
4426   rs: TResourceStream;
4427 begin
4428   PrepareResType(aResource, aResType);
4429   rs := TResourceStream.Create(aInstance, aResource, aResType);
4430   try
4431     LoadFromStream(rs);
4432   finally
4433     rs.Free;
4434   end;
4435 end;
4436
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4439 var
4440   rs: TResourceStream;
4441 begin
4442   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4443   try
4444     LoadFromStream(rs);
4445   finally
4446     rs.Free;
4447   end;
4448 end;
4449
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4452 var
4453   fs: TFileStream;
4454 begin
4455   fs := TFileStream.Create(aFileName, fmCreate);
4456   try
4457     fs.Position := 0;
4458     SaveToStream(fs, aFileType);
4459   finally
4460     fs.Free;
4461   end;
4462 end;
4463
4464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4465 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4466 begin
4467   case aFileType of
4468     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4469     ftPNG:  SavePNG(aStream);
4470     {$ENDIF}
4471     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4472     ftJPEG: SaveJPEG(aStream);
4473     {$ENDIF}
4474     ftDDS:  SaveDDS(aStream);
4475     ftTGA:  SaveTGA(aStream);
4476     ftBMP:  SaveBMP(aStream);
4477   end;
4478 end;
4479
4480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4481 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4482 begin
4483   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4488   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4489 var
4490   DestData, TmpData, SourceData: pByte;
4491   TempHeight, TempWidth: Integer;
4492   SourceFD, DestFD: TFormatDescriptor;
4493   SourceMD, DestMD: Pointer;
4494
4495   FuncRec: TglBitmapFunctionRec;
4496 begin
4497   Assert(Assigned(Data));
4498   Assert(Assigned(aSource));
4499   Assert(Assigned(aSource.Data));
4500
4501   result := false;
4502   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4503     SourceFD := TFormatDescriptor.Get(aSource.Format);
4504     DestFD   := TFormatDescriptor.Get(aFormat);
4505
4506     if (SourceFD.IsCompressed) then
4507       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4508     if (DestFD.IsCompressed) then
4509       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4510
4511     // inkompatible Formats so CreateTemp
4512     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4513       aCreateTemp := true;
4514
4515     // Values
4516     TempHeight := Max(1, aSource.Height);
4517     TempWidth  := Max(1, aSource.Width);
4518
4519     FuncRec.Sender := Self;
4520     FuncRec.Args   := aArgs;
4521
4522     TmpData := nil;
4523     if aCreateTemp then begin
4524       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4525       DestData := TmpData;
4526     end else
4527       DestData := Data;
4528
4529     try
4530       SourceFD.PreparePixel(FuncRec.Source);
4531       DestFD.PreparePixel  (FuncRec.Dest);
4532
4533       SourceMD := SourceFD.CreateMappingData;
4534       DestMD   := DestFD.CreateMappingData;
4535
4536       FuncRec.Size            := aSource.Dimension;
4537       FuncRec.Position.Fields := FuncRec.Size.Fields;
4538
4539       try
4540         SourceData := aSource.Data;
4541         FuncRec.Position.Y := 0;
4542         while FuncRec.Position.Y < TempHeight do begin
4543           FuncRec.Position.X := 0;
4544           while FuncRec.Position.X < TempWidth do begin
4545             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4546             aFunc(FuncRec);
4547             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4548             inc(FuncRec.Position.X);
4549           end;
4550           inc(FuncRec.Position.Y);
4551         end;
4552
4553         // Updating Image or InternalFormat
4554         if aCreateTemp then
4555           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4556         else if (aFormat <> fFormat) then
4557           Format := aFormat;
4558
4559         result := true;
4560       finally
4561         SourceFD.FreeMappingData(SourceMD);
4562         DestFD.FreeMappingData(DestMD);
4563       end;
4564     except
4565       if aCreateTemp and Assigned(TmpData) then
4566         FreeMem(TmpData);
4567       raise;
4568     end;
4569   end;
4570 end;
4571
4572 {$IFDEF GLB_SDL}
4573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4574 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4575 var
4576   Row, RowSize: Integer;
4577   SourceData, TmpData: PByte;
4578   TempDepth: Integer;
4579   FormatDesc: TFormatDescriptor;
4580
4581   function GetRowPointer(Row: Integer): pByte;
4582   begin
4583     result := aSurface.pixels;
4584     Inc(result, Row * RowSize);
4585   end;
4586
4587 begin
4588   result := false;
4589
4590   FormatDesc := TFormatDescriptor.Get(Format);
4591   if FormatDesc.IsCompressed then
4592     raise EglBitmapUnsupportedFormat.Create(Format);
4593
4594   if Assigned(Data) then begin
4595     case Trunc(FormatDesc.PixelSize) of
4596       1: TempDepth :=  8;
4597       2: TempDepth := 16;
4598       3: TempDepth := 24;
4599       4: TempDepth := 32;
4600     else
4601       raise EglBitmapUnsupportedFormat.Create(Format);
4602     end;
4603
4604     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4605       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4606     SourceData := Data;
4607     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4608
4609     for Row := 0 to FileHeight-1 do begin
4610       TmpData := GetRowPointer(Row);
4611       if Assigned(TmpData) then begin
4612         Move(SourceData^, TmpData^, RowSize);
4613         inc(SourceData, RowSize);
4614       end;
4615     end;
4616     result := true;
4617   end;
4618 end;
4619
4620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4621 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4622 var
4623   pSource, pData, pTempData: PByte;
4624   Row, RowSize, TempWidth, TempHeight: Integer;
4625   IntFormat: TglBitmapFormat;
4626   FormatDesc: TFormatDescriptor;
4627
4628   function GetRowPointer(Row: Integer): pByte;
4629   begin
4630     result := aSurface^.pixels;
4631     Inc(result, Row * RowSize);
4632   end;
4633
4634 begin
4635   result := false;
4636   if (Assigned(aSurface)) then begin
4637     with aSurface^.format^ do begin
4638       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4639         FormatDesc := TFormatDescriptor.Get(IntFormat);
4640         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4641           break;
4642       end;
4643       if (IntFormat = tfEmpty) then
4644         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4645     end;
4646
4647     TempWidth  := aSurface^.w;
4648     TempHeight := aSurface^.h;
4649     RowSize := FormatDesc.GetSize(TempWidth, 1);
4650     GetMem(pData, TempHeight * RowSize);
4651     try
4652       pTempData := pData;
4653       for Row := 0 to TempHeight -1 do begin
4654         pSource := GetRowPointer(Row);
4655         if (Assigned(pSource)) then begin
4656           Move(pSource^, pTempData^, RowSize);
4657           Inc(pTempData, RowSize);
4658         end;
4659       end;
4660       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4661       result := true;
4662     except
4663       if Assigned(pData) then
4664         FreeMem(pData);
4665       raise;
4666     end;
4667   end;
4668 end;
4669
4670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4671 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4672 var
4673   Row, Col, AlphaInterleave: Integer;
4674   pSource, pDest: PByte;
4675
4676   function GetRowPointer(Row: Integer): pByte;
4677   begin
4678     result := aSurface.pixels;
4679     Inc(result, Row * Width);
4680   end;
4681
4682 begin
4683   result := false;
4684   if Assigned(Data) then begin
4685     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4686       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4687
4688       AlphaInterleave := 0;
4689       case Format of
4690         tfLuminance8Alpha8:
4691           AlphaInterleave := 1;
4692         tfBGRA8, tfRGBA8:
4693           AlphaInterleave := 3;
4694       end;
4695
4696       pSource := Data;
4697       for Row := 0 to Height -1 do begin
4698         pDest := GetRowPointer(Row);
4699         if Assigned(pDest) then begin
4700           for Col := 0 to Width -1 do begin
4701             Inc(pSource, AlphaInterleave);
4702             pDest^ := pSource^;
4703             Inc(pDest);
4704             Inc(pSource);
4705           end;
4706         end;
4707       end;
4708       result := true;
4709     end;
4710   end;
4711 end;
4712
4713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4714 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4715 var
4716   bmp: TglBitmap2D;
4717 begin
4718   bmp := TglBitmap2D.Create;
4719   try
4720     bmp.AssignFromSurface(aSurface);
4721     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4722   finally
4723     bmp.Free;
4724   end;
4725 end;
4726 {$ENDIF}
4727
4728 {$IFDEF GLB_DELPHI}
4729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4730 function CreateGrayPalette: HPALETTE;
4731 var
4732   Idx: Integer;
4733   Pal: PLogPalette;
4734 begin
4735   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4736
4737   Pal.palVersion := $300;
4738   Pal.palNumEntries := 256;
4739
4740   for Idx := 0 to Pal.palNumEntries - 1 do begin
4741     Pal.palPalEntry[Idx].peRed   := Idx;
4742     Pal.palPalEntry[Idx].peGreen := Idx;
4743     Pal.palPalEntry[Idx].peBlue  := Idx;
4744     Pal.palPalEntry[Idx].peFlags := 0;
4745   end;
4746   Result := CreatePalette(Pal^);
4747   FreeMem(Pal);
4748 end;
4749
4750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4751 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4752 var
4753   Row: Integer;
4754   pSource, pData: PByte;
4755 begin
4756   result := false;
4757   if Assigned(Data) then begin
4758     if Assigned(aBitmap) then begin
4759       aBitmap.Width  := Width;
4760       aBitmap.Height := Height;
4761
4762       case Format of
4763         tfAlpha8, tfLuminance8: begin
4764           aBitmap.PixelFormat := pf8bit;
4765           aBitmap.Palette     := CreateGrayPalette;
4766         end;
4767         tfRGB5A1:
4768           aBitmap.PixelFormat := pf15bit;
4769         tfR5G6B5:
4770           aBitmap.PixelFormat := pf16bit;
4771         tfRGB8, tfBGR8:
4772           aBitmap.PixelFormat := pf24bit;
4773         tfRGBA8, tfBGRA8:
4774           aBitmap.PixelFormat := pf32bit;
4775       else
4776         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
4777       end;
4778
4779       pSource := Data;
4780       for Row := 0 to FileHeight -1 do begin
4781         pData := aBitmap.Scanline[Row];
4782         Move(pSource^, pData^, fRowSize);
4783         Inc(pSource, fRowSize);
4784         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4785           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4786       end;
4787       result := true;
4788     end;
4789   end;
4790 end;
4791
4792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4793 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4794 var
4795   pSource, pData, pTempData: PByte;
4796   Row, RowSize, TempWidth, TempHeight: Integer;
4797   IntFormat: TglBitmapFormat;
4798 begin
4799   result := false;
4800
4801   if (Assigned(aBitmap)) then begin
4802     case aBitmap.PixelFormat of
4803       pf8bit:
4804         IntFormat := tfLuminance8;
4805       pf15bit:
4806         IntFormat := tfRGB5A1;
4807       pf16bit:
4808         IntFormat := tfR5G6B5;
4809       pf24bit:
4810         IntFormat := tfBGR8;
4811       pf32bit:
4812         IntFormat := tfBGRA8;
4813     else
4814       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
4815     end;
4816
4817     TempWidth  := aBitmap.Width;
4818     TempHeight := aBitmap.Height;
4819     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4820     GetMem(pData, TempHeight * RowSize);
4821     try
4822       pTempData := pData;
4823       for Row := 0 to TempHeight -1 do begin
4824         pSource := aBitmap.Scanline[Row];
4825         if (Assigned(pSource)) then begin
4826           Move(pSource^, pTempData^, RowSize);
4827           Inc(pTempData, RowSize);
4828         end;
4829       end;
4830       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4831       result := true;
4832     except
4833       if Assigned(pData) then
4834         FreeMem(pData);
4835       raise;
4836     end;
4837   end;
4838 end;
4839
4840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4841 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4842 var
4843   Row, Col, AlphaInterleave: Integer;
4844   pSource, pDest: PByte;
4845 begin
4846   result := false;
4847
4848   if Assigned(Data) then begin
4849     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4850       if Assigned(aBitmap) then begin
4851         aBitmap.PixelFormat := pf8bit;
4852         aBitmap.Palette     := CreateGrayPalette;
4853         aBitmap.Width       := Width;
4854         aBitmap.Height      := Height;
4855
4856         case Format of
4857           tfLuminance8Alpha8:
4858             AlphaInterleave := 1;
4859           tfRGBA8, tfBGRA8:
4860             AlphaInterleave := 3;
4861           else
4862             AlphaInterleave := 0;
4863         end;
4864
4865         // Copy Data
4866         pSource := Data;
4867
4868         for Row := 0 to Height -1 do begin
4869           pDest := aBitmap.Scanline[Row];
4870           if Assigned(pDest) then begin
4871             for Col := 0 to Width -1 do begin
4872               Inc(pSource, AlphaInterleave);
4873               pDest^ := pSource^;
4874               Inc(pDest);
4875               Inc(pSource);
4876             end;
4877           end;
4878         end;
4879         result := true;
4880       end;
4881     end;
4882   end;
4883 end;
4884
4885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4886 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4887 var
4888   tex: TglBitmap2D;
4889 begin
4890   tex := TglBitmap2D.Create;
4891   try
4892     tex.AssignFromBitmap(ABitmap);
4893     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4894   finally
4895     tex.Free;
4896   end;
4897 end;
4898 {$ENDIF}
4899
4900 {$IFDEF GLB_LAZARUS}
4901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4902 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4903 var
4904   rid: TRawImageDescription;
4905   FormatDesc: TFormatDescriptor;
4906 begin
4907   result := false;
4908   if not Assigned(aImage) or (Format = tfEmpty) then
4909     exit;
4910   FormatDesc := TFormatDescriptor.Get(Format);
4911   if FormatDesc.IsCompressed then
4912     exit;
4913
4914   FillChar(rid{%H-}, SizeOf(rid), 0);
4915   if (Format in [
4916        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4917        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4918        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4919     rid.Format := ricfGray
4920   else
4921     rid.Format := ricfRGBA;
4922
4923   rid.Width        := Width;
4924   rid.Height       := Height;
4925   rid.Depth        := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
4926   rid.BitOrder     := riboBitsInOrder;
4927   rid.ByteOrder    := riboLSBFirst;
4928   rid.LineOrder    := riloTopToBottom;
4929   rid.LineEnd      := rileTight;
4930   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4931   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4932   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4933   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4934   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4935   rid.RedShift     := FormatDesc.Shift.r;
4936   rid.GreenShift   := FormatDesc.Shift.g;
4937   rid.BlueShift    := FormatDesc.Shift.b;
4938   rid.AlphaShift   := FormatDesc.Shift.a;
4939
4940   rid.MaskBitsPerPixel  := 0;
4941   rid.PaletteColorCount := 0;
4942
4943   aImage.DataDescription := rid;
4944   aImage.CreateData;
4945
4946   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4947
4948   result := true;
4949 end;
4950
4951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4952 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4953 var
4954   f: TglBitmapFormat;
4955   FormatDesc: TFormatDescriptor;
4956   ImageData: PByte;
4957   ImageSize: Integer;
4958 begin
4959   result := false;
4960   if not Assigned(aImage) then
4961     exit;
4962   for f := High(f) downto Low(f) do begin
4963     FormatDesc := TFormatDescriptor.Get(f);
4964     with aImage.DataDescription do
4965       if FormatDesc.MaskMatch(
4966         (QWord(1 shl RedPrec  )-1) shl RedShift,
4967         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4968         (QWord(1 shl BluePrec )-1) shl BlueShift,
4969         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4970         break;
4971   end;
4972
4973   if (f = tfEmpty) then
4974     exit;
4975
4976   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4977   ImageData := GetMem(ImageSize);
4978   try
4979     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4980     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4981   except
4982     if Assigned(ImageData) then
4983       FreeMem(ImageData);
4984     raise;
4985   end;
4986
4987   result := true;
4988 end;
4989
4990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4991 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4992 var
4993   rid: TRawImageDescription;
4994   FormatDesc: TFormatDescriptor;
4995   Pixel: TglBitmapPixelData;
4996   x, y: Integer;
4997   srcMD: Pointer;
4998   src, dst: PByte;
4999 begin
5000   result := false;
5001   if not Assigned(aImage) or (Format = tfEmpty) then
5002     exit;
5003   FormatDesc := TFormatDescriptor.Get(Format);
5004   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5005     exit;
5006
5007   FillChar(rid{%H-}, SizeOf(rid), 0);
5008   rid.Format       := ricfGray;
5009   rid.Width        := Width;
5010   rid.Height       := Height;
5011   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5012   rid.BitOrder     := riboBitsInOrder;
5013   rid.ByteOrder    := riboLSBFirst;
5014   rid.LineOrder    := riloTopToBottom;
5015   rid.LineEnd      := rileTight;
5016   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5017   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5018   rid.GreenPrec    := 0;
5019   rid.BluePrec     := 0;
5020   rid.AlphaPrec    := 0;
5021   rid.RedShift     := 0;
5022   rid.GreenShift   := 0;
5023   rid.BlueShift    := 0;
5024   rid.AlphaShift   := 0;
5025
5026   rid.MaskBitsPerPixel  := 0;
5027   rid.PaletteColorCount := 0;
5028
5029   aImage.DataDescription := rid;
5030   aImage.CreateData;
5031
5032   srcMD := FormatDesc.CreateMappingData;
5033   try
5034     FormatDesc.PreparePixel(Pixel);
5035     src := Data;
5036     dst := aImage.PixelData;
5037     for y := 0 to Height-1 do
5038       for x := 0 to Width-1 do begin
5039         FormatDesc.Unmap(src, Pixel, srcMD);
5040         case rid.BitsPerPixel of
5041            8: begin
5042             dst^ := Pixel.Data.a;
5043             inc(dst);
5044           end;
5045           16: begin
5046             PWord(dst)^ := Pixel.Data.a;
5047             inc(dst, 2);
5048           end;
5049           24: begin
5050             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5051             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5052             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5053             inc(dst, 3);
5054           end;
5055           32: begin
5056             PCardinal(dst)^ := Pixel.Data.a;
5057             inc(dst, 4);
5058           end;
5059         else
5060           raise EglBitmapUnsupportedFormat.Create(Format);
5061         end;
5062       end;
5063   finally
5064     FormatDesc.FreeMappingData(srcMD);
5065   end;
5066   result := true;
5067 end;
5068
5069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5070 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5071 var
5072   tex: TglBitmap2D;
5073 begin
5074   tex := TglBitmap2D.Create;
5075   try
5076     tex.AssignFromLazIntfImage(aImage);
5077     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5078   finally
5079     tex.Free;
5080   end;
5081 end;
5082 {$ENDIF}
5083
5084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5085 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5086   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5087 var
5088   rs: TResourceStream;
5089 begin
5090   PrepareResType(aResource, aResType);
5091   rs := TResourceStream.Create(aInstance, aResource, aResType);
5092   try
5093     result := AddAlphaFromStream(rs, aFunc, aArgs);
5094   finally
5095     rs.Free;
5096   end;
5097 end;
5098
5099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5100 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5101   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5102 var
5103   rs: TResourceStream;
5104 begin
5105   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5106   try
5107     result := AddAlphaFromStream(rs, aFunc, aArgs);
5108   finally
5109     rs.Free;
5110   end;
5111 end;
5112
5113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5114 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5115 begin
5116   if TFormatDescriptor.Get(Format).IsCompressed then
5117     raise EglBitmapUnsupportedFormat.Create(Format);
5118   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5119 end;
5120
5121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5122 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5123 var
5124   FS: TFileStream;
5125 begin
5126   FS := TFileStream.Create(aFileName, fmOpenRead);
5127   try
5128     result := AddAlphaFromStream(FS, aFunc, aArgs);
5129   finally
5130     FS.Free;
5131   end;
5132 end;
5133
5134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5135 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5136 var
5137   tex: TglBitmap2D;
5138 begin
5139   tex := TglBitmap2D.Create(aStream);
5140   try
5141     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5142   finally
5143     tex.Free;
5144   end;
5145 end;
5146
5147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5148 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5149 var
5150   DestData, DestData2, SourceData: pByte;
5151   TempHeight, TempWidth: Integer;
5152   SourceFD, DestFD: TFormatDescriptor;
5153   SourceMD, DestMD, DestMD2: Pointer;
5154
5155   FuncRec: TglBitmapFunctionRec;
5156 begin
5157   result := false;
5158
5159   Assert(Assigned(Data));
5160   Assert(Assigned(aBitmap));
5161   Assert(Assigned(aBitmap.Data));
5162
5163   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5164     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5165
5166     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5167     DestFD   := TFormatDescriptor.Get(Format);
5168
5169     if not Assigned(aFunc) then begin
5170       aFunc        := glBitmapAlphaFunc;
5171       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5172     end else
5173       FuncRec.Args := aArgs;
5174
5175     // Values
5176     TempHeight := aBitmap.FileHeight;
5177     TempWidth  := aBitmap.FileWidth;
5178
5179     FuncRec.Sender          := Self;
5180     FuncRec.Size            := Dimension;
5181     FuncRec.Position.Fields := FuncRec.Size.Fields;
5182
5183     DestData   := Data;
5184     DestData2  := Data;
5185     SourceData := aBitmap.Data;
5186
5187     // Mapping
5188     SourceFD.PreparePixel(FuncRec.Source);
5189     DestFD.PreparePixel  (FuncRec.Dest);
5190
5191     SourceMD := SourceFD.CreateMappingData;
5192     DestMD   := DestFD.CreateMappingData;
5193     DestMD2  := DestFD.CreateMappingData;
5194     try
5195       FuncRec.Position.Y := 0;
5196       while FuncRec.Position.Y < TempHeight do begin
5197         FuncRec.Position.X := 0;
5198         while FuncRec.Position.X < TempWidth do begin
5199           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5200           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5201           aFunc(FuncRec);
5202           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5203           inc(FuncRec.Position.X);
5204         end;
5205         inc(FuncRec.Position.Y);
5206       end;
5207     finally
5208       SourceFD.FreeMappingData(SourceMD);
5209       DestFD.FreeMappingData(DestMD);
5210       DestFD.FreeMappingData(DestMD2);
5211     end;
5212   end;
5213 end;
5214
5215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5216 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5217 begin
5218   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5219 end;
5220
5221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5222 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5223 var
5224   PixelData: TglBitmapPixelData;
5225 begin
5226   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5227   result := AddAlphaFromColorKeyFloat(
5228     aRed   / PixelData.Range.r,
5229     aGreen / PixelData.Range.g,
5230     aBlue  / PixelData.Range.b,
5231     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5232 end;
5233
5234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5235 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5236 var
5237   values: array[0..2] of Single;
5238   tmp: Cardinal;
5239   i: Integer;
5240   PixelData: TglBitmapPixelData;
5241 begin
5242   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5243   with PixelData do begin
5244     values[0] := aRed;
5245     values[1] := aGreen;
5246     values[2] := aBlue;
5247
5248     for i := 0 to 2 do begin
5249       tmp          := Trunc(Range.arr[i] * aDeviation);
5250       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5251       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5252     end;
5253     Data.a  := 0;
5254     Range.a := 0;
5255   end;
5256   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5257 end;
5258
5259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5260 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5261 begin
5262   result := AddAlphaFromValueFloat(aAlpha / $FF);
5263 end;
5264
5265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5266 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5267 var
5268   PixelData: TglBitmapPixelData;
5269 begin
5270   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5271   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5272 end;
5273
5274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5275 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5276 var
5277   PixelData: TglBitmapPixelData;
5278 begin
5279   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5280   with PixelData do
5281     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5282   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5283 end;
5284
5285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5286 function TglBitmap.RemoveAlpha: Boolean;
5287 var
5288   FormatDesc: TFormatDescriptor;
5289 begin
5290   result := false;
5291   FormatDesc := TFormatDescriptor.Get(Format);
5292   if Assigned(Data) then begin
5293     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5294       raise EglBitmapUnsupportedFormat.Create(Format);
5295     result := ConvertTo(FormatDesc.WithoutAlpha);
5296   end;
5297 end;
5298
5299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5300 function TglBitmap.Clone: TglBitmap;
5301 var
5302   Temp: TglBitmap;
5303   TempPtr: PByte;
5304   Size: Integer;
5305 begin
5306   result := nil;
5307   Temp := (ClassType.Create as TglBitmap);
5308   try
5309     // copy texture data if assigned
5310     if Assigned(Data) then begin
5311       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5312       GetMem(TempPtr, Size);
5313       try
5314         Move(Data^, TempPtr^, Size);
5315         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5316       except
5317         if Assigned(TempPtr) then
5318           FreeMem(TempPtr);
5319         raise;
5320       end;
5321     end else begin
5322       TempPtr := nil;
5323       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5324     end;
5325
5326         // copy properties
5327     Temp.fID                      := ID;
5328     Temp.fTarget                  := Target;
5329     Temp.fFormat                  := Format;
5330     Temp.fMipMap                  := MipMap;
5331     Temp.fAnisotropic             := Anisotropic;
5332     Temp.fBorderColor             := fBorderColor;
5333     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5334     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5335     Temp.fFilterMin               := fFilterMin;
5336     Temp.fFilterMag               := fFilterMag;
5337     Temp.fWrapS                   := fWrapS;
5338     Temp.fWrapT                   := fWrapT;
5339     Temp.fWrapR                   := fWrapR;
5340     Temp.fFilename                := fFilename;
5341     Temp.fCustomName              := fCustomName;
5342     Temp.fCustomNameW             := fCustomNameW;
5343     Temp.fCustomData              := fCustomData;
5344
5345     result := Temp;
5346   except
5347     FreeAndNil(Temp);
5348     raise;
5349   end;
5350 end;
5351
5352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5353 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5354 var
5355   SourceFD, DestFD: TFormatDescriptor;
5356   SourcePD, DestPD: TglBitmapPixelData;
5357   ShiftData: TShiftData;
5358
5359   function CanCopyDirect: Boolean;
5360   begin
5361     result :=
5362       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5363       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5364       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5365       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5366   end;
5367
5368   function CanShift: Boolean;
5369   begin
5370     result :=
5371       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5372       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5373       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5374       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5375   end;
5376
5377   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5378   begin
5379     result := 0;
5380     while (aSource > aDest) and (aSource > 0) do begin
5381       inc(result);
5382       aSource := aSource shr 1;
5383     end;
5384   end;
5385
5386 begin
5387   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5388     SourceFD := TFormatDescriptor.Get(Format);
5389     DestFD   := TFormatDescriptor.Get(aFormat);
5390
5391     SourceFD.PreparePixel(SourcePD);
5392     DestFD.PreparePixel  (DestPD);
5393
5394     if CanCopyDirect then
5395       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5396     else if CanShift then begin
5397       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5398       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5399       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5400       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5401       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5402     end else
5403       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5404   end else
5405     result := true;
5406 end;
5407
5408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5409 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5410 begin
5411   if aUseRGB or aUseAlpha then
5412     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5413       ((Byte(aUseAlpha) and 1) shl 1) or
5414        (Byte(aUseRGB)   and 1)      ));
5415 end;
5416
5417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5418 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5419 begin
5420   fBorderColor[0] := aRed;
5421   fBorderColor[1] := aGreen;
5422   fBorderColor[2] := aBlue;
5423   fBorderColor[3] := aAlpha;
5424   if (ID > 0) then begin
5425     Bind(false);
5426     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5427   end;
5428 end;
5429
5430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5431 procedure TglBitmap.FreeData;
5432 var
5433   TempPtr: PByte;
5434 begin
5435   TempPtr := nil;
5436   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5437 end;
5438
5439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5440 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5441   const aAlpha: Byte);
5442 begin
5443   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5444 end;
5445
5446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5447 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5448 var
5449   PixelData: TglBitmapPixelData;
5450 begin
5451   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5452   FillWithColorFloat(
5453     aRed   / PixelData.Range.r,
5454     aGreen / PixelData.Range.g,
5455     aBlue  / PixelData.Range.b,
5456     aAlpha / PixelData.Range.a);
5457 end;
5458
5459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5460 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5461 var
5462   PixelData: TglBitmapPixelData;
5463 begin
5464   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5465   with PixelData do begin
5466     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5467     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5468     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5469     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5470   end;
5471   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5472 end;
5473
5474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5475 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5476 begin
5477   //check MIN filter
5478   case aMin of
5479     GL_NEAREST:
5480       fFilterMin := GL_NEAREST;
5481     GL_LINEAR:
5482       fFilterMin := GL_LINEAR;
5483     GL_NEAREST_MIPMAP_NEAREST:
5484       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5485     GL_LINEAR_MIPMAP_NEAREST:
5486       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5487     GL_NEAREST_MIPMAP_LINEAR:
5488       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5489     GL_LINEAR_MIPMAP_LINEAR:
5490       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5491     else
5492       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5493   end;
5494
5495   //check MAG filter
5496   case aMag of
5497     GL_NEAREST:
5498       fFilterMag := GL_NEAREST;
5499     GL_LINEAR:
5500       fFilterMag := GL_LINEAR;
5501     else
5502       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5503   end;
5504
5505   //apply filter
5506   if (ID > 0) then begin
5507     Bind(false);
5508     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5509
5510     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5511       case fFilterMin of
5512         GL_NEAREST, GL_LINEAR:
5513           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5514         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5515           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5516         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5517           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5518       end;
5519     end else
5520       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5521   end;
5522 end;
5523
5524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5525 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5526
5527   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5528   begin
5529     case aValue of
5530       GL_CLAMP:
5531         aTarget := GL_CLAMP;
5532
5533       GL_REPEAT:
5534         aTarget := GL_REPEAT;
5535
5536       GL_CLAMP_TO_EDGE: begin
5537         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5538           aTarget := GL_CLAMP_TO_EDGE
5539         else
5540           aTarget := GL_CLAMP;
5541       end;
5542
5543       GL_CLAMP_TO_BORDER: begin
5544         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5545           aTarget := GL_CLAMP_TO_BORDER
5546         else
5547           aTarget := GL_CLAMP;
5548       end;
5549
5550       GL_MIRRORED_REPEAT: begin
5551         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5552           aTarget := GL_MIRRORED_REPEAT
5553         else
5554           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5555       end;
5556     else
5557       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5558     end;
5559   end;
5560
5561 begin
5562   CheckAndSetWrap(S, fWrapS);
5563   CheckAndSetWrap(T, fWrapT);
5564   CheckAndSetWrap(R, fWrapR);
5565
5566   if (ID > 0) then begin
5567     Bind(false);
5568     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5569     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5570     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5571   end;
5572 end;
5573
5574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5575 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5576
5577   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5578   begin
5579     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5580        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5581       fSwizzle[aIndex] := aValue
5582     else
5583       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5584   end;
5585
5586 begin
5587   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5588     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5589   CheckAndSetValue(r, 0);
5590   CheckAndSetValue(g, 1);
5591   CheckAndSetValue(b, 2);
5592   CheckAndSetValue(a, 3);
5593
5594   if (ID > 0) then begin
5595     Bind(false);
5596     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
5597   end;
5598 end;
5599
5600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5601 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5602 begin
5603   if aEnableTextureUnit then
5604     glEnable(Target);
5605   if (ID > 0) then
5606     glBindTexture(Target, ID);
5607 end;
5608
5609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5610 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5611 begin
5612   if aDisableTextureUnit then
5613     glDisable(Target);
5614   glBindTexture(Target, 0);
5615 end;
5616
5617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5618 constructor TglBitmap.Create;
5619 begin
5620   if (ClassType = TglBitmap) then
5621     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5622 {$IFDEF GLB_NATIVE_OGL}
5623   glbReadOpenGLExtensions;
5624 {$ENDIF}
5625   inherited Create;
5626 end;
5627
5628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5629 constructor TglBitmap.Create(const aFileName: String);
5630 begin
5631   Create;
5632   LoadFromFile(aFileName);
5633 end;
5634
5635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5636 constructor TglBitmap.Create(const aStream: TStream);
5637 begin
5638   Create;
5639   LoadFromStream(aStream);
5640 end;
5641
5642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5643 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5644 var
5645   Image: PByte;
5646   ImageSize: Integer;
5647 begin
5648   Create;
5649   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5650   GetMem(Image, ImageSize);
5651   try
5652     FillChar(Image^, ImageSize, #$FF);
5653     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5654   except
5655     if Assigned(Image) then
5656       FreeMem(Image);
5657     raise;
5658   end;
5659 end;
5660
5661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5662 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5663   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5664 begin
5665   Create;
5666   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5667 end;
5668
5669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5670 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5671 begin
5672   Create;
5673   LoadFromResource(aInstance, aResource, aResType);
5674 end;
5675
5676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5677 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5678 begin
5679   Create;
5680   LoadFromResourceID(aInstance, aResourceID, aResType);
5681 end;
5682
5683 {$IFDEF GLB_SUPPORT_PNG_READ}
5684 {$IF DEFINED(GLB_LAZ_PNG)}
5685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5686 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5688 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5689 const
5690   MAGIC_LEN = 8;
5691   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
5692 var
5693   png: TPortableNetworkGraphic;
5694   intf: TLazIntfImage;
5695   StreamPos: Int64;
5696   magic: String[MAGIC_LEN];
5697 begin
5698   result := true;
5699   StreamPos := aStream.Position;
5700
5701   SetLength(magic, MAGIC_LEN);
5702   aStream.Read(magic[1], MAGIC_LEN);
5703   aStream.Position := StreamPos;
5704   if (magic <> PNG_MAGIC) then begin
5705     result := false;
5706     exit;
5707   end;
5708
5709   png := TPortableNetworkGraphic.Create;
5710   try try
5711     png.LoadFromStream(aStream);
5712     intf := png.CreateIntfImage;
5713     try try
5714       AssignFromLazIntfImage(intf);
5715     except
5716       result := false;
5717       aStream.Position := StreamPos;
5718       exit;
5719     end;
5720     finally
5721       intf.Free;
5722     end;
5723   except
5724     result := false;
5725     aStream.Position := StreamPos;
5726     exit;
5727   end;
5728   finally
5729     png.Free;
5730   end;
5731 end;
5732
5733 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5735 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5736 var
5737   Surface: PSDL_Surface;
5738   RWops: PSDL_RWops;
5739 begin
5740   result := false;
5741   RWops := glBitmapCreateRWops(aStream);
5742   try
5743     if IMG_isPNG(RWops) > 0 then begin
5744       Surface := IMG_LoadPNG_RW(RWops);
5745       try
5746         AssignFromSurface(Surface);
5747         result := true;
5748       finally
5749         SDL_FreeSurface(Surface);
5750       end;
5751     end;
5752   finally
5753     SDL_FreeRW(RWops);
5754   end;
5755 end;
5756
5757 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5759 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5760 begin
5761   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5762 end;
5763
5764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5765 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5766 var
5767   StreamPos: Int64;
5768   signature: array [0..7] of byte;
5769   png: png_structp;
5770   png_info: png_infop;
5771
5772   TempHeight, TempWidth: Integer;
5773   Format: TglBitmapFormat;
5774
5775   png_data: pByte;
5776   png_rows: array of pByte;
5777   Row, LineSize: Integer;
5778 begin
5779   result := false;
5780
5781   if not init_libPNG then
5782     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5783
5784   try
5785     // signature
5786     StreamPos := aStream.Position;
5787     aStream.Read(signature{%H-}, 8);
5788     aStream.Position := StreamPos;
5789
5790     if png_check_sig(@signature, 8) <> 0 then begin
5791       // png read struct
5792       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5793       if png = nil then
5794         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5795
5796       // png info
5797       png_info := png_create_info_struct(png);
5798       if png_info = nil then begin
5799         png_destroy_read_struct(@png, nil, nil);
5800         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5801       end;
5802
5803       // set read callback
5804       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5805
5806       // read informations
5807       png_read_info(png, png_info);
5808
5809       // size
5810       TempHeight := png_get_image_height(png, png_info);
5811       TempWidth := png_get_image_width(png, png_info);
5812
5813       // format
5814       case png_get_color_type(png, png_info) of
5815         PNG_COLOR_TYPE_GRAY:
5816           Format := tfLuminance8;
5817         PNG_COLOR_TYPE_GRAY_ALPHA:
5818           Format := tfLuminance8Alpha8;
5819         PNG_COLOR_TYPE_RGB:
5820           Format := tfRGB8;
5821         PNG_COLOR_TYPE_RGB_ALPHA:
5822           Format := tfRGBA8;
5823         else
5824           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5825       end;
5826
5827       // cut upper 8 bit from 16 bit formats
5828       if png_get_bit_depth(png, png_info) > 8 then
5829         png_set_strip_16(png);
5830
5831       // expand bitdepth smaller than 8
5832       if png_get_bit_depth(png, png_info) < 8 then
5833         png_set_expand(png);
5834
5835       // allocating mem for scanlines
5836       LineSize := png_get_rowbytes(png, png_info);
5837       GetMem(png_data, TempHeight * LineSize);
5838       try
5839         SetLength(png_rows, TempHeight);
5840         for Row := Low(png_rows) to High(png_rows) do begin
5841           png_rows[Row] := png_data;
5842           Inc(png_rows[Row], Row * LineSize);
5843         end;
5844
5845         // read complete image into scanlines
5846         png_read_image(png, @png_rows[0]);
5847
5848         // read end
5849         png_read_end(png, png_info);
5850
5851         // destroy read struct
5852         png_destroy_read_struct(@png, @png_info, nil);
5853
5854         SetLength(png_rows, 0);
5855
5856         // set new data
5857         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5858
5859         result := true;
5860       except
5861         if Assigned(png_data) then
5862           FreeMem(png_data);
5863         raise;
5864       end;
5865     end;
5866   finally
5867     quit_libPNG;
5868   end;
5869 end;
5870
5871 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5873 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5874 var
5875   StreamPos: Int64;
5876   Png: TPNGObject;
5877   Header: String[8];
5878   Row, Col, PixSize, LineSize: Integer;
5879   NewImage, pSource, pDest, pAlpha: pByte;
5880   PngFormat: TglBitmapFormat;
5881   FormatDesc: TFormatDescriptor;
5882
5883 const
5884   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5885
5886 begin
5887   result := false;
5888
5889   StreamPos := aStream.Position;
5890   aStream.Read(Header[0], SizeOf(Header));
5891   aStream.Position := StreamPos;
5892
5893   {Test if the header matches}
5894   if Header = PngHeader then begin
5895     Png := TPNGObject.Create;
5896     try
5897       Png.LoadFromStream(aStream);
5898
5899       case Png.Header.ColorType of
5900         COLOR_GRAYSCALE:
5901           PngFormat := tfLuminance8;
5902         COLOR_GRAYSCALEALPHA:
5903           PngFormat := tfLuminance8Alpha8;
5904         COLOR_RGB:
5905           PngFormat := tfBGR8;
5906         COLOR_RGBALPHA:
5907           PngFormat := tfBGRA8;
5908         else
5909           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5910       end;
5911
5912       FormatDesc := TFormatDescriptor.Get(PngFormat);
5913       PixSize    := Round(FormatDesc.PixelSize);
5914       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5915
5916       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5917       try
5918         pDest := NewImage;
5919
5920         case Png.Header.ColorType of
5921           COLOR_RGB, COLOR_GRAYSCALE:
5922             begin
5923               for Row := 0 to Png.Height -1 do begin
5924                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5925                 Inc(pDest, LineSize);
5926               end;
5927             end;
5928           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5929             begin
5930               PixSize := PixSize -1;
5931
5932               for Row := 0 to Png.Height -1 do begin
5933                 pSource := Png.Scanline[Row];
5934                 pAlpha := pByte(Png.AlphaScanline[Row]);
5935
5936                 for Col := 0 to Png.Width -1 do begin
5937                   Move (pSource^, pDest^, PixSize);
5938                   Inc(pSource, PixSize);
5939                   Inc(pDest, PixSize);
5940
5941                   pDest^ := pAlpha^;
5942                   inc(pAlpha);
5943                   Inc(pDest);
5944                 end;
5945               end;
5946             end;
5947           else
5948             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5949         end;
5950
5951         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5952
5953         result := true;
5954       except
5955         if Assigned(NewImage) then
5956           FreeMem(NewImage);
5957         raise;
5958       end;
5959     finally
5960       Png.Free;
5961     end;
5962   end;
5963 end;
5964 {$IFEND}
5965 {$ENDIF}
5966
5967 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5968 {$IFDEF GLB_LIB_PNG}
5969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5970 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5971 begin
5972   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5973 end;
5974 {$ENDIF}
5975
5976 {$IF DEFINED(GLB_LAZ_PNG)}
5977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5978 procedure TglBitmap.SavePNG(const aStream: TStream);
5979 var
5980   png: TPortableNetworkGraphic;
5981   intf: TLazIntfImage;
5982   raw: TRawImage;
5983 begin
5984   png  := TPortableNetworkGraphic.Create;
5985   intf := TLazIntfImage.Create(0, 0);
5986   try
5987     if not AssignToLazIntfImage(intf) then
5988       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5989     intf.GetRawImage(raw);
5990     png.LoadFromRawImage(raw, false);
5991     png.SaveToStream(aStream);
5992   finally
5993     png.Free;
5994     intf.Free;
5995   end;
5996 end;
5997
5998 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6000 procedure TglBitmap.SavePNG(const aStream: TStream);
6001 var
6002   png: png_structp;
6003   png_info: png_infop;
6004   png_rows: array of pByte;
6005   LineSize: Integer;
6006   ColorType: Integer;
6007   Row: Integer;
6008   FormatDesc: TFormatDescriptor;
6009 begin
6010   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6011     raise EglBitmapUnsupportedFormat.Create(Format);
6012
6013   if not init_libPNG then
6014     raise Exception.Create('unable to initialize libPNG.');
6015
6016   try
6017     case Format of
6018       tfAlpha8, tfLuminance8:
6019         ColorType := PNG_COLOR_TYPE_GRAY;
6020       tfLuminance8Alpha8:
6021         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6022       tfBGR8, tfRGB8:
6023         ColorType := PNG_COLOR_TYPE_RGB;
6024       tfBGRA8, tfRGBA8:
6025         ColorType := PNG_COLOR_TYPE_RGBA;
6026       else
6027         raise EglBitmapUnsupportedFormat.Create(Format);
6028     end;
6029
6030     FormatDesc := TFormatDescriptor.Get(Format);
6031     LineSize := FormatDesc.GetSize(Width, 1);
6032
6033     // creating array for scanline
6034     SetLength(png_rows, Height);
6035     try
6036       for Row := 0 to Height - 1 do begin
6037         png_rows[Row] := Data;
6038         Inc(png_rows[Row], Row * LineSize)
6039       end;
6040
6041       // write struct
6042       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6043       if png = nil then
6044         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6045
6046       // create png info
6047       png_info := png_create_info_struct(png);
6048       if png_info = nil then begin
6049         png_destroy_write_struct(@png, nil);
6050         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6051       end;
6052
6053       // set read callback
6054       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6055
6056       // set compression
6057       png_set_compression_level(png, 6);
6058
6059       if Format in [tfBGR8, tfBGRA8] then
6060         png_set_bgr(png);
6061
6062       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6063       png_write_info(png, png_info);
6064       png_write_image(png, @png_rows[0]);
6065       png_write_end(png, png_info);
6066       png_destroy_write_struct(@png, @png_info);
6067     finally
6068       SetLength(png_rows, 0);
6069     end;
6070   finally
6071     quit_libPNG;
6072   end;
6073 end;
6074
6075 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6077 procedure TglBitmap.SavePNG(const aStream: TStream);
6078 var
6079   Png: TPNGObject;
6080
6081   pSource, pDest: pByte;
6082   X, Y, PixSize: Integer;
6083   ColorType: Cardinal;
6084   Alpha: Boolean;
6085
6086   pTemp: pByte;
6087   Temp: Byte;
6088 begin
6089   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6090     raise EglBitmapUnsupportedFormat.Create(Format);
6091
6092   case Format of
6093     tfAlpha8, tfLuminance8: begin
6094       ColorType := COLOR_GRAYSCALE;
6095       PixSize   := 1;
6096       Alpha     := false;
6097     end;
6098     tfLuminance8Alpha8: begin
6099       ColorType := COLOR_GRAYSCALEALPHA;
6100       PixSize   := 1;
6101       Alpha     := true;
6102     end;
6103     tfBGR8, tfRGB8: begin
6104       ColorType := COLOR_RGB;
6105       PixSize   := 3;
6106       Alpha     := false;
6107     end;
6108     tfBGRA8, tfRGBA8: begin
6109       ColorType := COLOR_RGBALPHA;
6110       PixSize   := 3;
6111       Alpha     := true
6112     end;
6113   else
6114     raise EglBitmapUnsupportedFormat.Create(Format);
6115   end;
6116
6117   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6118   try
6119     // Copy ImageData
6120     pSource := Data;
6121     for Y := 0 to Height -1 do begin
6122       pDest := png.ScanLine[Y];
6123       for X := 0 to Width -1 do begin
6124         Move(pSource^, pDest^, PixSize);
6125         Inc(pDest, PixSize);
6126         Inc(pSource, PixSize);
6127         if Alpha then begin
6128           png.AlphaScanline[Y]^[X] := pSource^;
6129           Inc(pSource);
6130         end;
6131       end;
6132
6133       // convert RGB line to BGR
6134       if Format in [tfRGB8, tfRGBA8] then begin
6135         pTemp := png.ScanLine[Y];
6136         for X := 0 to Width -1 do begin
6137           Temp := pByteArray(pTemp)^[0];
6138           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6139           pByteArray(pTemp)^[2] := Temp;
6140           Inc(pTemp, 3);
6141         end;
6142       end;
6143     end;
6144
6145     // Save to Stream
6146     Png.CompressionLevel := 6;
6147     Png.SaveToStream(aStream);
6148   finally
6149     FreeAndNil(Png);
6150   end;
6151 end;
6152 {$IFEND}
6153 {$ENDIF}
6154
6155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6156 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6158 {$IFDEF GLB_LIB_JPEG}
6159 type
6160   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6161   glBitmap_libJPEG_source_mgr = record
6162     pub: jpeg_source_mgr;
6163
6164     SrcStream: TStream;
6165     SrcBuffer: array [1..4096] of byte;
6166   end;
6167
6168   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6169   glBitmap_libJPEG_dest_mgr = record
6170     pub: jpeg_destination_mgr;
6171
6172     DestStream: TStream;
6173     DestBuffer: array [1..4096] of byte;
6174   end;
6175
6176 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6177 begin
6178   //DUMMY
6179 end;
6180
6181
6182 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6183 begin
6184   //DUMMY
6185 end;
6186
6187
6188 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6189 begin
6190   //DUMMY
6191 end;
6192
6193 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6194 begin
6195   //DUMMY
6196 end;
6197
6198
6199 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6200 begin
6201   //DUMMY
6202 end;
6203
6204
6205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6206 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6207 var
6208   src: glBitmap_libJPEG_source_mgr_ptr;
6209   bytes: integer;
6210 begin
6211   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6212
6213   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6214         if (bytes <= 0) then begin
6215                 src^.SrcBuffer[1] := $FF;
6216                 src^.SrcBuffer[2] := JPEG_EOI;
6217                 bytes := 2;
6218         end;
6219
6220         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6221         src^.pub.bytes_in_buffer := bytes;
6222
6223   result := true;
6224 end;
6225
6226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6227 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6228 var
6229   src: glBitmap_libJPEG_source_mgr_ptr;
6230 begin
6231   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6232
6233   if num_bytes > 0 then begin
6234     // wanted byte isn't in buffer so set stream position and read buffer
6235     if num_bytes > src^.pub.bytes_in_buffer then begin
6236       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6237       src^.pub.fill_input_buffer(cinfo);
6238     end else begin
6239       // wanted byte is in buffer so only skip
6240                 inc(src^.pub.next_input_byte, num_bytes);
6241                 dec(src^.pub.bytes_in_buffer, num_bytes);
6242     end;
6243   end;
6244 end;
6245
6246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6247 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6248 var
6249   dest: glBitmap_libJPEG_dest_mgr_ptr;
6250 begin
6251   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6252
6253   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6254     // write complete buffer
6255     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6256
6257     // reset buffer
6258     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6259     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6260   end;
6261
6262   result := true;
6263 end;
6264
6265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6266 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6267 var
6268   Idx: Integer;
6269   dest: glBitmap_libJPEG_dest_mgr_ptr;
6270 begin
6271   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6272
6273   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6274     // check for endblock
6275     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6276       // write endblock
6277       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6278
6279       // leave
6280       break;
6281     end else
6282       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6283   end;
6284 end;
6285 {$ENDIF}
6286
6287 {$IFDEF GLB_SUPPORT_JPEG_READ}
6288 {$IF DEFINED(GLB_LAZ_JPEG)}
6289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6290 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6291 const
6292   MAGIC_LEN = 2;
6293   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6294 var
6295   jpeg: TJPEGImage;
6296   intf: TLazIntfImage;
6297   StreamPos: Int64;
6298   magic: String[MAGIC_LEN];
6299 begin
6300   result := true;
6301   StreamPos := aStream.Position;
6302
6303   SetLength(magic, MAGIC_LEN);
6304   aStream.Read(magic[1], MAGIC_LEN);
6305   aStream.Position := StreamPos;
6306   if (magic <> JPEG_MAGIC) then begin
6307     result := false;
6308     exit;
6309   end;
6310
6311   jpeg := TJPEGImage.Create;
6312   try try
6313     jpeg.LoadFromStream(aStream);
6314     intf := TLazIntfImage.Create(0, 0);
6315     try try
6316       intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
6317       AssignFromLazIntfImage(intf);
6318     except
6319       result := false;
6320       aStream.Position := StreamPos;
6321       exit;
6322     end;
6323     finally
6324       intf.Free;
6325     end;
6326   except
6327     result := false;
6328     aStream.Position := StreamPos;
6329     exit;
6330   end;
6331   finally
6332     jpeg.Free;
6333   end;
6334 end;
6335
6336 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6337 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6338 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6339 var
6340   Surface: PSDL_Surface;
6341   RWops: PSDL_RWops;
6342 begin
6343   result := false;
6344
6345   RWops := glBitmapCreateRWops(aStream);
6346   try
6347     if IMG_isJPG(RWops) > 0 then begin
6348       Surface := IMG_LoadJPG_RW(RWops);
6349       try
6350         AssignFromSurface(Surface);
6351         result := true;
6352       finally
6353         SDL_FreeSurface(Surface);
6354       end;
6355     end;
6356   finally
6357     SDL_FreeRW(RWops);
6358   end;
6359 end;
6360
6361 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6363 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6364 var
6365   StreamPos: Int64;
6366   Temp: array[0..1]of Byte;
6367
6368   jpeg: jpeg_decompress_struct;
6369   jpeg_err: jpeg_error_mgr;
6370
6371   IntFormat: TglBitmapFormat;
6372   pImage: pByte;
6373   TempHeight, TempWidth: Integer;
6374
6375   pTemp: pByte;
6376   Row: Integer;
6377
6378   FormatDesc: TFormatDescriptor;
6379 begin
6380   result := false;
6381
6382   if not init_libJPEG then
6383     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6384
6385   try
6386     // reading first two bytes to test file and set cursor back to begin
6387     StreamPos := aStream.Position;
6388     aStream.Read({%H-}Temp[0], 2);
6389     aStream.Position := StreamPos;
6390
6391     // if Bitmap then read file.
6392     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6393       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6394       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6395
6396       // error managment
6397       jpeg.err := jpeg_std_error(@jpeg_err);
6398       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6399       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6400
6401       // decompression struct
6402       jpeg_create_decompress(@jpeg);
6403
6404       // allocation space for streaming methods
6405       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6406
6407       // seeting up custom functions
6408       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6409         pub.init_source       := glBitmap_libJPEG_init_source;
6410         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6411         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6412         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6413         pub.term_source       := glBitmap_libJPEG_term_source;
6414
6415         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6416         pub.next_input_byte := nil;   // until buffer loaded
6417
6418         SrcStream := aStream;
6419       end;
6420
6421       // set global decoding state
6422       jpeg.global_state := DSTATE_START;
6423
6424       // read header of jpeg
6425       jpeg_read_header(@jpeg, false);
6426
6427       // setting output parameter
6428       case jpeg.jpeg_color_space of
6429         JCS_GRAYSCALE:
6430           begin
6431             jpeg.out_color_space := JCS_GRAYSCALE;
6432             IntFormat := tfLuminance8;
6433           end;
6434         else
6435           jpeg.out_color_space := JCS_RGB;
6436           IntFormat := tfRGB8;
6437       end;
6438
6439       // reading image
6440       jpeg_start_decompress(@jpeg);
6441
6442       TempHeight := jpeg.output_height;
6443       TempWidth := jpeg.output_width;
6444
6445       FormatDesc := TFormatDescriptor.Get(IntFormat);
6446
6447       // creating new image
6448       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6449       try
6450         pTemp := pImage;
6451
6452         for Row := 0 to TempHeight -1 do begin
6453           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6454           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6455         end;
6456
6457         // finish decompression
6458         jpeg_finish_decompress(@jpeg);
6459
6460         // destroy decompression
6461         jpeg_destroy_decompress(@jpeg);
6462
6463         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6464
6465         result := true;
6466       except
6467         if Assigned(pImage) then
6468           FreeMem(pImage);
6469         raise;
6470       end;
6471     end;
6472   finally
6473     quit_libJPEG;
6474   end;
6475 end;
6476
6477 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6479 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6480 var
6481   bmp: TBitmap;
6482   jpg: TJPEGImage;
6483   StreamPos: Int64;
6484   Temp: array[0..1]of Byte;
6485 begin
6486   result := false;
6487
6488   // reading first two bytes to test file and set cursor back to begin
6489   StreamPos := aStream.Position;
6490   aStream.Read(Temp[0], 2);
6491   aStream.Position := StreamPos;
6492
6493   // if Bitmap then read file.
6494   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6495     bmp := TBitmap.Create;
6496     try
6497       jpg := TJPEGImage.Create;
6498       try
6499         jpg.LoadFromStream(aStream);
6500         bmp.Assign(jpg);
6501         result := AssignFromBitmap(bmp);
6502       finally
6503         jpg.Free;
6504       end;
6505     finally
6506       bmp.Free;
6507     end;
6508   end;
6509 end;
6510 {$IFEND}
6511 {$ENDIF}
6512
6513 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6514 {$IF DEFINED(GLB_LAZ_JPEG)}
6515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6516 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6517 var
6518   jpeg: TJPEGImage;
6519   intf: TLazIntfImage;
6520   raw: TRawImage;
6521 begin
6522   jpeg := TJPEGImage.Create;
6523   intf := TLazIntfImage.Create(0, 0);
6524   try
6525     if not AssignToLazIntfImage(intf) then
6526       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6527     intf.GetRawImage(raw);
6528     jpeg.LoadFromRawImage(raw, false);
6529     jpeg.SaveToStream(aStream);
6530   finally
6531     intf.Free;
6532     jpeg.Free;
6533   end;
6534 end;
6535
6536 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6538 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6539 var
6540   jpeg: jpeg_compress_struct;
6541   jpeg_err: jpeg_error_mgr;
6542   Row: Integer;
6543   pTemp, pTemp2: pByte;
6544
6545   procedure CopyRow(pDest, pSource: pByte);
6546   var
6547     X: Integer;
6548   begin
6549     for X := 0 to Width - 1 do begin
6550       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6551       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6552       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6553       Inc(pDest, 3);
6554       Inc(pSource, 3);
6555     end;
6556   end;
6557
6558 begin
6559   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6560     raise EglBitmapUnsupportedFormat.Create(Format);
6561
6562   if not init_libJPEG then
6563     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6564
6565   try
6566     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6567     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6568
6569     // error managment
6570     jpeg.err := jpeg_std_error(@jpeg_err);
6571     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6572     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6573
6574     // compression struct
6575     jpeg_create_compress(@jpeg);
6576
6577     // allocation space for streaming methods
6578     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6579
6580     // seeting up custom functions
6581     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6582       pub.init_destination    := glBitmap_libJPEG_init_destination;
6583       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6584       pub.term_destination    := glBitmap_libJPEG_term_destination;
6585
6586       pub.next_output_byte  := @DestBuffer[1];
6587       pub.free_in_buffer    := Length(DestBuffer);
6588
6589       DestStream := aStream;
6590     end;
6591
6592     // very important state
6593     jpeg.global_state := CSTATE_START;
6594     jpeg.image_width  := Width;
6595     jpeg.image_height := Height;
6596     case Format of
6597       tfAlpha8, tfLuminance8: begin
6598         jpeg.input_components := 1;
6599         jpeg.in_color_space   := JCS_GRAYSCALE;
6600       end;
6601       tfRGB8, tfBGR8: begin
6602         jpeg.input_components := 3;
6603         jpeg.in_color_space   := JCS_RGB;
6604       end;
6605     end;
6606
6607     jpeg_set_defaults(@jpeg);
6608     jpeg_set_quality(@jpeg, 95, true);
6609     jpeg_start_compress(@jpeg, true);
6610     pTemp := Data;
6611
6612     if Format = tfBGR8 then
6613       GetMem(pTemp2, fRowSize)
6614     else
6615       pTemp2 := pTemp;
6616
6617     try
6618       for Row := 0 to jpeg.image_height -1 do begin
6619         // prepare row
6620         if Format = tfBGR8 then
6621           CopyRow(pTemp2, pTemp)
6622         else
6623           pTemp2 := pTemp;
6624
6625         // write row
6626         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6627         inc(pTemp, fRowSize);
6628       end;
6629     finally
6630       // free memory
6631       if Format = tfBGR8 then
6632         FreeMem(pTemp2);
6633     end;
6634     jpeg_finish_compress(@jpeg);
6635     jpeg_destroy_compress(@jpeg);
6636   finally
6637     quit_libJPEG;
6638   end;
6639 end;
6640
6641 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6643 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6644 var
6645   Bmp: TBitmap;
6646   Jpg: TJPEGImage;
6647 begin
6648   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6649     raise EglBitmapUnsupportedFormat.Create(Format);
6650
6651   Bmp := TBitmap.Create;
6652   try
6653     Jpg := TJPEGImage.Create;
6654     try
6655       AssignToBitmap(Bmp);
6656       if (Format in [tfAlpha8, tfLuminance8]) then begin
6657         Jpg.Grayscale   := true;
6658         Jpg.PixelFormat := jf8Bit;
6659       end;
6660       Jpg.Assign(Bmp);
6661       Jpg.SaveToStream(aStream);
6662     finally
6663       FreeAndNil(Jpg);
6664     end;
6665   finally
6666     FreeAndNil(Bmp);
6667   end;
6668 end;
6669 {$IFEND}
6670 {$ENDIF}
6671
6672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6673 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6675 const
6676   BMP_MAGIC          = $4D42;
6677
6678   BMP_COMP_RGB       = 0;
6679   BMP_COMP_RLE8      = 1;
6680   BMP_COMP_RLE4      = 2;
6681   BMP_COMP_BITFIELDS = 3;
6682
6683 type
6684   TBMPHeader = packed record
6685     bfType: Word;
6686     bfSize: Cardinal;
6687     bfReserved1: Word;
6688     bfReserved2: Word;
6689     bfOffBits: Cardinal;
6690   end;
6691
6692   TBMPInfo = packed record
6693     biSize: Cardinal;
6694     biWidth: Longint;
6695     biHeight: Longint;
6696     biPlanes: Word;
6697     biBitCount: Word;
6698     biCompression: Cardinal;
6699     biSizeImage: Cardinal;
6700     biXPelsPerMeter: Longint;
6701     biYPelsPerMeter: Longint;
6702     biClrUsed: Cardinal;
6703     biClrImportant: Cardinal;
6704   end;
6705
6706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6707 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6708
6709   //////////////////////////////////////////////////////////////////////////////////////////////////
6710   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6711   begin
6712     result := tfEmpty;
6713     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6714     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6715
6716     //Read Compression
6717     case aInfo.biCompression of
6718       BMP_COMP_RLE4,
6719       BMP_COMP_RLE8: begin
6720         raise EglBitmap.Create('RLE compression is not supported');
6721       end;
6722       BMP_COMP_BITFIELDS: begin
6723         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6724           aStream.Read(aMask.r, SizeOf(aMask.r));
6725           aStream.Read(aMask.g, SizeOf(aMask.g));
6726           aStream.Read(aMask.b, SizeOf(aMask.b));
6727           aStream.Read(aMask.a, SizeOf(aMask.a));
6728         end else
6729           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
6730       end;
6731     end;
6732
6733     //get suitable format
6734     case aInfo.biBitCount of
6735        8: result := tfLuminance8;
6736       16: result := tfBGR5;
6737       24: result := tfBGR8;
6738       32: result := tfBGRA8;
6739     end;
6740   end;
6741
6742   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6743   var
6744     i, c: Integer;
6745     ColorTable: TbmpColorTable;
6746   begin
6747     result := nil;
6748     if (aInfo.biBitCount >= 16) then
6749       exit;
6750     aFormat := tfLuminance8;
6751     c := aInfo.biClrUsed;
6752     if (c = 0) then
6753       c := 1 shl aInfo.biBitCount;
6754     SetLength(ColorTable, c);
6755     for i := 0 to c-1 do begin
6756       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6757       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6758         aFormat := tfRGB8;
6759     end;
6760
6761     result := TbmpColorTableFormat.Create;
6762     result.PixelSize  := aInfo.biBitCount / 8;
6763     result.ColorTable := ColorTable;
6764     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6765   end;
6766
6767   //////////////////////////////////////////////////////////////////////////////////////////////////
6768   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6769     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6770   var
6771     TmpFormat: TglBitmapFormat;
6772     FormatDesc: TFormatDescriptor;
6773   begin
6774     result := nil;
6775     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6776       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6777         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6778         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6779           aFormat := FormatDesc.Format;
6780           exit;
6781         end;
6782       end;
6783
6784       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6785         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6786       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6787         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6788
6789       result := TbmpBitfieldFormat.Create;
6790       result.PixelSize := aInfo.biBitCount / 8;
6791       result.RedMask   := aMask.r;
6792       result.GreenMask := aMask.g;
6793       result.BlueMask  := aMask.b;
6794       result.AlphaMask := aMask.a;
6795     end;
6796   end;
6797
6798 var
6799   //simple types
6800   StartPos: Int64;
6801   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6802   PaddingBuff: Cardinal;
6803   LineBuf, ImageData, TmpData: PByte;
6804   SourceMD, DestMD: Pointer;
6805   BmpFormat: TglBitmapFormat;
6806
6807   //records
6808   Mask: TglBitmapColorRec;
6809   Header: TBMPHeader;
6810   Info: TBMPInfo;
6811
6812   //classes
6813   SpecialFormat: TFormatDescriptor;
6814   FormatDesc: TFormatDescriptor;
6815
6816   //////////////////////////////////////////////////////////////////////////////////////////////////
6817   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6818   var
6819     i: Integer;
6820     Pixel: TglBitmapPixelData;
6821   begin
6822     aStream.Read(aLineBuf^, rbLineSize);
6823     SpecialFormat.PreparePixel(Pixel);
6824     for i := 0 to Info.biWidth-1 do begin
6825       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6826       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6827       FormatDesc.Map(Pixel, aData, DestMD);
6828     end;
6829   end;
6830
6831 begin
6832   result        := false;
6833   BmpFormat     := tfEmpty;
6834   SpecialFormat := nil;
6835   LineBuf       := nil;
6836   SourceMD      := nil;
6837   DestMD        := nil;
6838
6839   // Header
6840   StartPos := aStream.Position;
6841   aStream.Read(Header{%H-}, SizeOf(Header));
6842
6843   if Header.bfType = BMP_MAGIC then begin
6844     try try
6845       BmpFormat        := ReadInfo(Info, Mask);
6846       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6847       if not Assigned(SpecialFormat) then
6848         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6849       aStream.Position := StartPos + Header.bfOffBits;
6850
6851       if (BmpFormat <> tfEmpty) then begin
6852         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6853         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6854         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6855         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6856
6857         //get Memory
6858         DestMD    := FormatDesc.CreateMappingData;
6859         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6860         GetMem(ImageData, ImageSize);
6861         if Assigned(SpecialFormat) then begin
6862           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6863           SourceMD := SpecialFormat.CreateMappingData;
6864         end;
6865
6866         //read Data
6867         try try
6868           FillChar(ImageData^, ImageSize, $FF);
6869           TmpData := ImageData;
6870           if (Info.biHeight > 0) then
6871             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6872           for i := 0 to Abs(Info.biHeight)-1 do begin
6873             if Assigned(SpecialFormat) then
6874               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6875             else
6876               aStream.Read(TmpData^, wbLineSize);   //else only read data
6877             if (Info.biHeight > 0) then
6878               dec(TmpData, wbLineSize)
6879             else
6880               inc(TmpData, wbLineSize);
6881             aStream.Read(PaddingBuff{%H-}, Padding);
6882           end;
6883           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6884           result := true;
6885         finally
6886           if Assigned(LineBuf) then
6887             FreeMem(LineBuf);
6888           if Assigned(SourceMD) then
6889             SpecialFormat.FreeMappingData(SourceMD);
6890           FormatDesc.FreeMappingData(DestMD);
6891         end;
6892         except
6893           if Assigned(ImageData) then
6894             FreeMem(ImageData);
6895           raise;
6896         end;
6897       end else
6898         raise EglBitmap.Create('LoadBMP - No suitable format found');
6899     except
6900       aStream.Position := StartPos;
6901       raise;
6902     end;
6903     finally
6904       FreeAndNil(SpecialFormat);
6905     end;
6906   end
6907     else aStream.Position := StartPos;
6908 end;
6909
6910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6911 procedure TglBitmap.SaveBMP(const aStream: TStream);
6912 var
6913   Header: TBMPHeader;
6914   Info: TBMPInfo;
6915   Converter: TFormatDescriptor;
6916   FormatDesc: TFormatDescriptor;
6917   SourceFD, DestFD: Pointer;
6918   pData, srcData, dstData, ConvertBuffer: pByte;
6919
6920   Pixel: TglBitmapPixelData;
6921   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6922   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6923
6924   PaddingBuff: Cardinal;
6925
6926   function GetLineWidth : Integer;
6927   begin
6928     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6929   end;
6930
6931 begin
6932   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6933     raise EglBitmapUnsupportedFormat.Create(Format);
6934
6935   Converter  := nil;
6936   FormatDesc := TFormatDescriptor.Get(Format);
6937   ImageSize  := FormatDesc.GetSize(Dimension);
6938
6939   FillChar(Header{%H-}, SizeOf(Header), 0);
6940   Header.bfType      := BMP_MAGIC;
6941   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6942   Header.bfReserved1 := 0;
6943   Header.bfReserved2 := 0;
6944   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6945
6946   FillChar(Info{%H-}, SizeOf(Info), 0);
6947   Info.biSize        := SizeOf(Info);
6948   Info.biWidth       := Width;
6949   Info.biHeight      := Height;
6950   Info.biPlanes      := 1;
6951   Info.biCompression := BMP_COMP_RGB;
6952   Info.biSizeImage   := ImageSize;
6953
6954   try
6955     case Format of
6956       tfLuminance4: begin
6957         Info.biBitCount  := 4;
6958         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6959         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6960         Converter := TbmpColorTableFormat.Create;
6961         with (Converter as TbmpColorTableFormat) do begin
6962           PixelSize := 0.5;
6963           Format    := Format;
6964           Range     := glBitmapColorRec($F, $F, $F, $0);
6965           CreateColorTable;
6966         end;
6967       end;
6968
6969       tfR3G3B2, tfLuminance8: begin
6970         Info.biBitCount  :=  8;
6971         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6972         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6973         Converter := TbmpColorTableFormat.Create;
6974         with (Converter as TbmpColorTableFormat) do begin
6975           PixelSize := 1;
6976           Format    := Format;
6977           if (Format = tfR3G3B2) then begin
6978             Range := glBitmapColorRec($7, $7, $3, $0);
6979             Shift := glBitmapShiftRec(0, 3, 6, 0);
6980           end else
6981             Range := glBitmapColorRec($FF, $FF, $FF, $0);
6982           CreateColorTable;
6983         end;
6984       end;
6985
6986       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6987       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6988         Info.biBitCount    := 16;
6989         Info.biCompression := BMP_COMP_BITFIELDS;
6990       end;
6991
6992       tfBGR8, tfRGB8: begin
6993         Info.biBitCount := 24;
6994         if (Format = tfRGB8) then
6995           Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
6996       end;
6997
6998       tfRGB10, tfRGB10A2, tfRGBA8,
6999       tfBGR10, tfBGR10A2, tfBGRA8: begin
7000         Info.biBitCount    := 32;
7001         Info.biCompression := BMP_COMP_BITFIELDS;
7002       end;
7003     else
7004       raise EglBitmapUnsupportedFormat.Create(Format);
7005     end;
7006     Info.biXPelsPerMeter := 2835;
7007     Info.biYPelsPerMeter := 2835;
7008
7009     // prepare bitmasks
7010     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7011       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7012       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7013
7014       RedMask    := FormatDesc.RedMask;
7015       GreenMask  := FormatDesc.GreenMask;
7016       BlueMask   := FormatDesc.BlueMask;
7017       AlphaMask  := FormatDesc.AlphaMask;
7018     end;
7019
7020     // headers
7021     aStream.Write(Header, SizeOf(Header));
7022     aStream.Write(Info, SizeOf(Info));
7023
7024     // colortable
7025     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7026       with (Converter as TbmpColorTableFormat) do
7027         aStream.Write(ColorTable[0].b,
7028           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7029
7030     // bitmasks
7031     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7032       aStream.Write(RedMask,   SizeOf(Cardinal));
7033       aStream.Write(GreenMask, SizeOf(Cardinal));
7034       aStream.Write(BlueMask,  SizeOf(Cardinal));
7035       aStream.Write(AlphaMask, SizeOf(Cardinal));
7036     end;
7037
7038     // image data
7039     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
7040     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7041     Padding     := GetLineWidth - wbLineSize;
7042     PaddingBuff := 0;
7043
7044     pData := Data;
7045     inc(pData, (Height-1) * rbLineSize);
7046
7047     // prepare row buffer. But only for RGB because RGBA supports color masks
7048     // so it's possible to change color within the image.
7049     if Assigned(Converter) then begin
7050       FormatDesc.PreparePixel(Pixel);
7051       GetMem(ConvertBuffer, wbLineSize);
7052       SourceFD := FormatDesc.CreateMappingData;
7053       DestFD   := Converter.CreateMappingData;
7054     end else
7055       ConvertBuffer := nil;
7056
7057     try
7058       for LineIdx := 0 to Height - 1 do begin
7059         // preparing row
7060         if Assigned(Converter) then begin
7061           srcData := pData;
7062           dstData := ConvertBuffer;
7063           for PixelIdx := 0 to Info.biWidth-1 do begin
7064             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7065             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7066             Converter.Map(Pixel, dstData, DestFD);
7067           end;
7068           aStream.Write(ConvertBuffer^, wbLineSize);
7069         end else begin
7070           aStream.Write(pData^, rbLineSize);
7071         end;
7072         dec(pData, rbLineSize);
7073         if (Padding > 0) then
7074           aStream.Write(PaddingBuff, Padding);
7075       end;
7076     finally
7077       // destroy row buffer
7078       if Assigned(ConvertBuffer) then begin
7079         FormatDesc.FreeMappingData(SourceFD);
7080         Converter.FreeMappingData(DestFD);
7081         FreeMem(ConvertBuffer);
7082       end;
7083     end;
7084   finally
7085     if Assigned(Converter) then
7086       Converter.Free;
7087   end;
7088 end;
7089
7090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7091 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7093 type
7094   TTGAHeader = packed record
7095     ImageID: Byte;
7096     ColorMapType: Byte;
7097     ImageType: Byte;
7098     //ColorMapSpec: Array[0..4] of Byte;
7099     ColorMapStart: Word;
7100     ColorMapLength: Word;
7101     ColorMapEntrySize: Byte;
7102     OrigX: Word;
7103     OrigY: Word;
7104     Width: Word;
7105     Height: Word;
7106     Bpp: Byte;
7107     ImageDesc: Byte;
7108   end;
7109
7110 const
7111   TGA_UNCOMPRESSED_RGB  =  2;
7112   TGA_UNCOMPRESSED_GRAY =  3;
7113   TGA_COMPRESSED_RGB    = 10;
7114   TGA_COMPRESSED_GRAY   = 11;
7115
7116   TGA_NONE_COLOR_TABLE  = 0;
7117
7118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7119 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7120 var
7121   Header: TTGAHeader;
7122   ImageData: System.PByte;
7123   StartPosition: Int64;
7124   PixelSize, LineSize: Integer;
7125   tgaFormat: TglBitmapFormat;
7126   FormatDesc: TFormatDescriptor;
7127   Counter: packed record
7128     X, Y: packed record
7129       low, high, dir: Integer;
7130     end;
7131   end;
7132
7133 const
7134   CACHE_SIZE = $4000;
7135
7136   ////////////////////////////////////////////////////////////////////////////////////////
7137   procedure ReadUncompressed;
7138   var
7139     i, j: Integer;
7140     buf, tmp1, tmp2: System.PByte;
7141   begin
7142     buf := nil;
7143     if (Counter.X.dir < 0) then
7144       GetMem(buf, LineSize);
7145     try
7146       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7147         tmp1 := ImageData;
7148         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7149         if (Counter.X.dir < 0) then begin               //flip X
7150           aStream.Read(buf^, LineSize);
7151           tmp2 := buf;
7152           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7153           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7154             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7155               tmp1^ := tmp2^;
7156               inc(tmp1);
7157               inc(tmp2);
7158             end;
7159             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7160           end;
7161         end else
7162           aStream.Read(tmp1^, LineSize);
7163         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7164       end;
7165     finally
7166       if Assigned(buf) then
7167         FreeMem(buf);
7168     end;
7169   end;
7170
7171   ////////////////////////////////////////////////////////////////////////////////////////
7172   procedure ReadCompressed;
7173
7174     /////////////////////////////////////////////////////////////////
7175     var
7176       TmpData: System.PByte;
7177       LinePixelsRead: Integer;
7178     procedure CheckLine;
7179     begin
7180       if (LinePixelsRead >= Header.Width) then begin
7181         LinePixelsRead := 0;
7182         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7183         TmpData := ImageData;
7184         inc(TmpData, Counter.Y.low * LineSize);           //set line
7185         if (Counter.X.dir < 0) then                       //if x flipped then
7186           inc(TmpData, LineSize - PixelSize);             //set last pixel
7187       end;
7188     end;
7189
7190     /////////////////////////////////////////////////////////////////
7191     var
7192       Cache: PByte;
7193       CacheSize, CachePos: Integer;
7194     procedure CachedRead(out Buffer; Count: Integer);
7195     var
7196       BytesRead: Integer;
7197     begin
7198       if (CachePos + Count > CacheSize) then begin
7199         //if buffer overflow save non read bytes
7200         BytesRead := 0;
7201         if (CacheSize - CachePos > 0) then begin
7202           BytesRead := CacheSize - CachePos;
7203           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7204           inc(CachePos, BytesRead);
7205         end;
7206
7207         //load cache from file
7208         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7209         aStream.Read(Cache^, CacheSize);
7210         CachePos := 0;
7211
7212         //read rest of requested bytes
7213         if (Count - BytesRead > 0) then begin
7214           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7215           inc(CachePos, Count - BytesRead);
7216         end;
7217       end else begin
7218         //if no buffer overflow just read the data
7219         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7220         inc(CachePos, Count);
7221       end;
7222     end;
7223
7224     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7225     begin
7226       case PixelSize of
7227         1: begin
7228           aBuffer^ := aData^;
7229           inc(aBuffer, Counter.X.dir);
7230         end;
7231         2: begin
7232           PWord(aBuffer)^ := PWord(aData)^;
7233           inc(aBuffer, 2 * Counter.X.dir);
7234         end;
7235         3: begin
7236           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7237           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7238           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7239           inc(aBuffer, 3 * Counter.X.dir);
7240         end;
7241         4: begin
7242           PCardinal(aBuffer)^ := PCardinal(aData)^;
7243           inc(aBuffer, 4 * Counter.X.dir);
7244         end;
7245       end;
7246     end;
7247
7248   var
7249     TotalPixelsToRead, TotalPixelsRead: Integer;
7250     Temp: Byte;
7251     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7252     PixelRepeat: Boolean;
7253     PixelsToRead, PixelCount: Integer;
7254   begin
7255     CacheSize := 0;
7256     CachePos  := 0;
7257
7258     TotalPixelsToRead := Header.Width * Header.Height;
7259     TotalPixelsRead   := 0;
7260     LinePixelsRead    := 0;
7261
7262     GetMem(Cache, CACHE_SIZE);
7263     try
7264       TmpData := ImageData;
7265       inc(TmpData, Counter.Y.low * LineSize);           //set line
7266       if (Counter.X.dir < 0) then                       //if x flipped then
7267         inc(TmpData, LineSize - PixelSize);             //set last pixel
7268
7269       repeat
7270         //read CommandByte
7271         CachedRead(Temp, 1);
7272         PixelRepeat  := (Temp and $80) > 0;
7273         PixelsToRead := (Temp and $7F) + 1;
7274         inc(TotalPixelsRead, PixelsToRead);
7275
7276         if PixelRepeat then
7277           CachedRead(buf[0], PixelSize);
7278         while (PixelsToRead > 0) do begin
7279           CheckLine;
7280           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7281           while (PixelCount > 0) do begin
7282             if not PixelRepeat then
7283               CachedRead(buf[0], PixelSize);
7284             PixelToBuffer(@buf[0], TmpData);
7285             inc(LinePixelsRead);
7286             dec(PixelsToRead);
7287             dec(PixelCount);
7288           end;
7289         end;
7290       until (TotalPixelsRead >= TotalPixelsToRead);
7291     finally
7292       FreeMem(Cache);
7293     end;
7294   end;
7295
7296   function IsGrayFormat: Boolean;
7297   begin
7298     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7299   end;
7300
7301 begin
7302   result := false;
7303
7304   // reading header to test file and set cursor back to begin
7305   StartPosition := aStream.Position;
7306   aStream.Read(Header{%H-}, SizeOf(Header));
7307
7308   // no colormapped files
7309   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7310     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7311   begin
7312     try
7313       if Header.ImageID <> 0 then       // skip image ID
7314         aStream.Position := aStream.Position + Header.ImageID;
7315
7316       tgaFormat := tfEmpty;
7317       case Header.Bpp of
7318          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7319                0: tgaFormat := tfLuminance8;
7320                8: tgaFormat := tfAlpha8;
7321             end;
7322
7323         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7324                0: tgaFormat := tfLuminance16;
7325                8: tgaFormat := tfLuminance8Alpha8;
7326             end else case (Header.ImageDesc and $F) of
7327                0: tgaFormat := tfBGR5;
7328                1: tgaFormat := tfBGR5A1;
7329                4: tgaFormat := tfBGRA4;
7330             end;
7331
7332         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7333                0: tgaFormat := tfBGR8;
7334             end;
7335
7336         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7337                2: tgaFormat := tfBGR10A2;
7338                8: tgaFormat := tfBGRA8;
7339             end;
7340       end;
7341
7342       if (tgaFormat = tfEmpty) then
7343         raise EglBitmap.Create('LoadTga - unsupported format');
7344
7345       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7346       PixelSize  := FormatDesc.GetSize(1, 1);
7347       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7348
7349       GetMem(ImageData, LineSize * Header.Height);
7350       try
7351         //column direction
7352         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7353           Counter.X.low  := Header.Height-1;;
7354           Counter.X.high := 0;
7355           Counter.X.dir  := -1;
7356         end else begin
7357           Counter.X.low  := 0;
7358           Counter.X.high := Header.Height-1;
7359           Counter.X.dir  := 1;
7360         end;
7361
7362         // Row direction
7363         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7364           Counter.Y.low  := 0;
7365           Counter.Y.high := Header.Height-1;
7366           Counter.Y.dir  := 1;
7367         end else begin
7368           Counter.Y.low  := Header.Height-1;;
7369           Counter.Y.high := 0;
7370           Counter.Y.dir  := -1;
7371         end;
7372
7373         // Read Image
7374         case Header.ImageType of
7375           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7376             ReadUncompressed;
7377           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7378             ReadCompressed;
7379         end;
7380
7381         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7382         result := true;
7383       except
7384         if Assigned(ImageData) then
7385           FreeMem(ImageData);
7386         raise;
7387       end;
7388     finally
7389       aStream.Position := StartPosition;
7390     end;
7391   end
7392     else aStream.Position := StartPosition;
7393 end;
7394
7395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7396 procedure TglBitmap.SaveTGA(const aStream: TStream);
7397 var
7398   Header: TTGAHeader;
7399   LineSize, Size, x, y: Integer;
7400   Pixel: TglBitmapPixelData;
7401   LineBuf, SourceData, DestData: PByte;
7402   SourceMD, DestMD: Pointer;
7403   FormatDesc: TFormatDescriptor;
7404   Converter: TFormatDescriptor;
7405 begin
7406   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7407     raise EglBitmapUnsupportedFormat.Create(Format);
7408
7409   //prepare header
7410   FillChar(Header{%H-}, SizeOf(Header), 0);
7411
7412   //set ImageType
7413   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7414                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7415     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7416   else
7417     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7418
7419   //set BitsPerPixel
7420   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7421     Header.Bpp := 8
7422   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7423                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7424     Header.Bpp := 16
7425   else if (Format in [tfBGR8, tfRGB8]) then
7426     Header.Bpp := 24
7427   else
7428     Header.Bpp := 32;
7429
7430   //set AlphaBitCount
7431   case Format of
7432     tfRGB5A1, tfBGR5A1:
7433       Header.ImageDesc := 1 and $F;
7434     tfRGB10A2, tfBGR10A2:
7435       Header.ImageDesc := 2 and $F;
7436     tfRGBA4, tfBGRA4:
7437       Header.ImageDesc := 4 and $F;
7438     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7439       Header.ImageDesc := 8 and $F;
7440   end;
7441
7442   Header.Width     := Width;
7443   Header.Height    := Height;
7444   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7445   aStream.Write(Header, SizeOf(Header));
7446
7447   // convert RGB(A) to BGR(A)
7448   Converter  := nil;
7449   FormatDesc := TFormatDescriptor.Get(Format);
7450   Size       := FormatDesc.GetSize(Dimension);
7451   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7452     if (FormatDesc.RGBInverted = tfEmpty) then
7453       raise EglBitmap.Create('inverted RGB format is empty');
7454     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7455     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7456        (Converter.PixelSize <> FormatDesc.PixelSize) then
7457       raise EglBitmap.Create('invalid inverted RGB format');
7458   end;
7459
7460   if Assigned(Converter) then begin
7461     LineSize := FormatDesc.GetSize(Width, 1);
7462     GetMem(LineBuf, LineSize);
7463     SourceMD := FormatDesc.CreateMappingData;
7464     DestMD   := Converter.CreateMappingData;
7465     try
7466       SourceData := Data;
7467       for y := 0 to Height-1 do begin
7468         DestData := LineBuf;
7469         for x := 0 to Width-1 do begin
7470           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7471           Converter.Map(Pixel, DestData, DestMD);
7472         end;
7473         aStream.Write(LineBuf^, LineSize);
7474       end;
7475     finally
7476       FreeMem(LineBuf);
7477       FormatDesc.FreeMappingData(SourceMD);
7478       FormatDesc.FreeMappingData(DestMD);
7479     end;
7480   end else
7481     aStream.Write(Data^, Size);
7482 end;
7483
7484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7485 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7487 const
7488   DDS_MAGIC: Cardinal         = $20534444;
7489
7490   // DDS_header.dwFlags
7491   DDSD_CAPS                   = $00000001;
7492   DDSD_HEIGHT                 = $00000002;
7493   DDSD_WIDTH                  = $00000004;
7494   DDSD_PIXELFORMAT            = $00001000;
7495
7496   // DDS_header.sPixelFormat.dwFlags
7497   DDPF_ALPHAPIXELS            = $00000001;
7498   DDPF_ALPHA                  = $00000002;
7499   DDPF_FOURCC                 = $00000004;
7500   DDPF_RGB                    = $00000040;
7501   DDPF_LUMINANCE              = $00020000;
7502
7503   // DDS_header.sCaps.dwCaps1
7504   DDSCAPS_TEXTURE             = $00001000;
7505
7506   // DDS_header.sCaps.dwCaps2
7507   DDSCAPS2_CUBEMAP            = $00000200;
7508
7509   D3DFMT_DXT1                 = $31545844;
7510   D3DFMT_DXT3                 = $33545844;
7511   D3DFMT_DXT5                 = $35545844;
7512
7513 type
7514   TDDSPixelFormat = packed record
7515     dwSize: Cardinal;
7516     dwFlags: Cardinal;
7517     dwFourCC: Cardinal;
7518     dwRGBBitCount: Cardinal;
7519     dwRBitMask: Cardinal;
7520     dwGBitMask: Cardinal;
7521     dwBBitMask: Cardinal;
7522     dwABitMask: Cardinal;
7523   end;
7524
7525   TDDSCaps = packed record
7526     dwCaps1: Cardinal;
7527     dwCaps2: Cardinal;
7528     dwDDSX: Cardinal;
7529     dwReserved: Cardinal;
7530   end;
7531
7532   TDDSHeader = packed record
7533     dwSize: Cardinal;
7534     dwFlags: Cardinal;
7535     dwHeight: Cardinal;
7536     dwWidth: Cardinal;
7537     dwPitchOrLinearSize: Cardinal;
7538     dwDepth: Cardinal;
7539     dwMipMapCount: Cardinal;
7540     dwReserved: array[0..10] of Cardinal;
7541     PixelFormat: TDDSPixelFormat;
7542     Caps: TDDSCaps;
7543     dwReserved2: Cardinal;
7544   end;
7545
7546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7547 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7548 var
7549   Header: TDDSHeader;
7550   Converter: TbmpBitfieldFormat;
7551
7552   function GetDDSFormat: TglBitmapFormat;
7553   var
7554     fd: TFormatDescriptor;
7555     i: Integer;
7556     Range: TglBitmapColorRec;
7557     match: Boolean;
7558   begin
7559     result := tfEmpty;
7560     with Header.PixelFormat do begin
7561       // Compresses
7562       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7563         case Header.PixelFormat.dwFourCC of
7564           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7565           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7566           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7567         end;
7568       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7569
7570         //find matching format
7571         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7572           fd := TFormatDescriptor.Get(result);
7573           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7574              (8 * fd.PixelSize = dwRGBBitCount) then
7575             exit;
7576         end;
7577
7578         //find format with same Range
7579         Range.r := dwRBitMask;
7580         Range.g := dwGBitMask;
7581         Range.b := dwBBitMask;
7582         Range.a := dwABitMask;
7583         for i := 0 to 3 do begin
7584           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7585             Range.arr[i] := Range.arr[i] shr 1;
7586         end;
7587         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7588           fd := TFormatDescriptor.Get(result);
7589           match := true;
7590           for i := 0 to 3 do
7591             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7592               match := false;
7593               break;
7594             end;
7595           if match then
7596             break;
7597         end;
7598
7599         //no format with same range found -> use default
7600         if (result = tfEmpty) then begin
7601           if (dwABitMask > 0) then
7602             result := tfBGRA8
7603           else
7604             result := tfBGR8;
7605         end;
7606
7607         Converter := TbmpBitfieldFormat.Create;
7608         Converter.RedMask   := dwRBitMask;
7609         Converter.GreenMask := dwGBitMask;
7610         Converter.BlueMask  := dwBBitMask;
7611         Converter.AlphaMask := dwABitMask;
7612         Converter.PixelSize := dwRGBBitCount / 8;
7613       end;
7614     end;
7615   end;
7616
7617 var
7618   StreamPos: Int64;
7619   x, y, LineSize, RowSize, Magic: Cardinal;
7620   NewImage, TmpData, RowData, SrcData: System.PByte;
7621   SourceMD, DestMD: Pointer;
7622   Pixel: TglBitmapPixelData;
7623   ddsFormat: TglBitmapFormat;
7624   FormatDesc: TFormatDescriptor;
7625
7626 begin
7627   result    := false;
7628   Converter := nil;
7629   StreamPos := aStream.Position;
7630
7631   // Magic
7632   aStream.Read(Magic{%H-}, sizeof(Magic));
7633   if (Magic <> DDS_MAGIC) then begin
7634     aStream.Position := StreamPos;
7635     exit;
7636   end;
7637
7638   //Header
7639   aStream.Read(Header{%H-}, sizeof(Header));
7640   if (Header.dwSize <> SizeOf(Header)) or
7641      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7642         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7643   begin
7644     aStream.Position := StreamPos;
7645     exit;
7646   end;
7647
7648   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7649     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7650
7651   ddsFormat := GetDDSFormat;
7652   try
7653     if (ddsFormat = tfEmpty) then
7654       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7655
7656     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7657     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7658     GetMem(NewImage, Header.dwHeight * LineSize);
7659     try
7660       TmpData := NewImage;
7661
7662       //Converter needed
7663       if Assigned(Converter) then begin
7664         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7665         GetMem(RowData, RowSize);
7666         SourceMD := Converter.CreateMappingData;
7667         DestMD   := FormatDesc.CreateMappingData;
7668         try
7669           for y := 0 to Header.dwHeight-1 do begin
7670             TmpData := NewImage;
7671             inc(TmpData, y * LineSize);
7672             SrcData := RowData;
7673             aStream.Read(SrcData^, RowSize);
7674             for x := 0 to Header.dwWidth-1 do begin
7675               Converter.Unmap(SrcData, Pixel, SourceMD);
7676               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7677               FormatDesc.Map(Pixel, TmpData, DestMD);
7678             end;
7679           end;
7680         finally
7681           Converter.FreeMappingData(SourceMD);
7682           FormatDesc.FreeMappingData(DestMD);
7683           FreeMem(RowData);
7684         end;
7685       end else
7686
7687       // Compressed
7688       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7689         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7690         for Y := 0 to Header.dwHeight-1 do begin
7691           aStream.Read(TmpData^, RowSize);
7692           Inc(TmpData, LineSize);
7693         end;
7694       end else
7695
7696       // Uncompressed
7697       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7698         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7699         for Y := 0 to Header.dwHeight-1 do begin
7700           aStream.Read(TmpData^, RowSize);
7701           Inc(TmpData, LineSize);
7702         end;
7703       end else
7704         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7705
7706       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7707       result := true;
7708     except
7709       if Assigned(NewImage) then
7710         FreeMem(NewImage);
7711       raise;
7712     end;
7713   finally
7714     FreeAndNil(Converter);
7715   end;
7716 end;
7717
7718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7719 procedure TglBitmap.SaveDDS(const aStream: TStream);
7720 var
7721   Header: TDDSHeader;
7722   FormatDesc: TFormatDescriptor;
7723 begin
7724   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7725     raise EglBitmapUnsupportedFormat.Create(Format);
7726
7727   FormatDesc := TFormatDescriptor.Get(Format);
7728
7729   // Generell
7730   FillChar(Header{%H-}, SizeOf(Header), 0);
7731   Header.dwSize  := SizeOf(Header);
7732   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7733
7734   Header.dwWidth  := Max(1, Width);
7735   Header.dwHeight := Max(1, Height);
7736
7737   // Caps
7738   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7739
7740   // Pixelformat
7741   Header.PixelFormat.dwSize := sizeof(Header);
7742   if (FormatDesc.IsCompressed) then begin
7743     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7744     case Format of
7745       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7746       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7747       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7748     end;
7749   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7750     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7751     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7752     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7753   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7754     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7755     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7756     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7757     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7758   end else begin
7759     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7760     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7761     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7762     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7763     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7764     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7765   end;
7766
7767   if (FormatDesc.HasAlpha) then
7768     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7769
7770   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7771   aStream.Write(Header, SizeOf(Header));
7772   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7773 end;
7774
7775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7776 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7778 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7779   const aWidth: Integer; const aHeight: Integer);
7780 var
7781   pTemp: pByte;
7782   Size: Integer;
7783 begin
7784   if (aHeight > 1) then begin
7785     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7786     GetMem(pTemp, Size);
7787     try
7788       Move(aData^, pTemp^, Size);
7789       FreeMem(aData);
7790       aData := nil;
7791     except
7792       FreeMem(pTemp);
7793       raise;
7794     end;
7795   end else
7796     pTemp := aData;
7797   inherited SetDataPointer(pTemp, aFormat, aWidth);
7798 end;
7799
7800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7801 function TglBitmap1D.FlipHorz: Boolean;
7802 var
7803   Col: Integer;
7804   pTempDest, pDest, pSource: PByte;
7805 begin
7806   result := inherited FlipHorz;
7807   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7808     pSource := Data;
7809     GetMem(pDest, fRowSize);
7810     try
7811       pTempDest := pDest;
7812       Inc(pTempDest, fRowSize);
7813       for Col := 0 to Width-1 do begin
7814         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7815         Move(pSource^, pTempDest^, fPixelSize);
7816         Inc(pSource, fPixelSize);
7817       end;
7818       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7819       result := true;
7820     except
7821       if Assigned(pDest) then
7822         FreeMem(pDest);
7823       raise;
7824     end;
7825   end;
7826 end;
7827
7828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7829 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7830 var
7831   FormatDesc: TFormatDescriptor;
7832 begin
7833   // Upload data
7834   FormatDesc := TFormatDescriptor.Get(Format);
7835   if FormatDesc.IsCompressed then begin
7836     if not Assigned(glCompressedTexImage1D) then
7837       raise EglBitmap.Create('compressed formats not supported by video adapter');
7838     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7839   end else if aBuildWithGlu then
7840     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7841   else
7842     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7843
7844   // Free Data
7845   if (FreeDataAfterGenTexture) then
7846     FreeData;
7847 end;
7848
7849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7850 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7851 var
7852   BuildWithGlu, TexRec: Boolean;
7853   TexSize: Integer;
7854 begin
7855   if Assigned(Data) then begin
7856     // Check Texture Size
7857     if (aTestTextureSize) then begin
7858       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7859
7860       if (Width > TexSize) then
7861         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7862
7863       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7864                 (Target = GL_TEXTURE_RECTANGLE);
7865       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7866         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7867     end;
7868
7869     CreateId;
7870     SetupParameters(BuildWithGlu);
7871     UploadData(BuildWithGlu);
7872     glAreTexturesResident(1, @fID, @fIsResident);
7873   end;
7874 end;
7875
7876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7877 procedure TglBitmap1D.AfterConstruction;
7878 begin
7879   inherited;
7880   Target := GL_TEXTURE_1D;
7881 end;
7882
7883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7884 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7886 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7887 begin
7888   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7889     result := fLines[aIndex]
7890   else
7891     result := nil;
7892 end;
7893
7894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7895 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7896   const aWidth: Integer; const aHeight: Integer);
7897 var
7898   Idx, LineWidth: Integer;
7899 begin
7900   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7901
7902   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7903     // Assigning Data
7904     if Assigned(Data) then begin
7905       SetLength(fLines, GetHeight);
7906       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7907
7908       for Idx := 0 to GetHeight-1 do begin
7909         fLines[Idx] := Data;
7910         Inc(fLines[Idx], Idx * LineWidth);
7911       end;
7912     end
7913       else SetLength(fLines, 0);
7914   end else begin
7915     SetLength(fLines, 0);
7916   end;
7917 end;
7918
7919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7920 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7921 var
7922   FormatDesc: TFormatDescriptor;
7923 begin
7924   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7925
7926   FormatDesc := TFormatDescriptor.Get(Format);
7927   if FormatDesc.IsCompressed then begin
7928     if not Assigned(glCompressedTexImage2D) then
7929       raise EglBitmap.Create('compressed formats not supported by video adapter');
7930     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7931   end else if aBuildWithGlu then begin
7932     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7933       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7934   end else begin
7935     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7936       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7937   end;
7938
7939   // Freigeben
7940   if (FreeDataAfterGenTexture) then
7941     FreeData;
7942 end;
7943
7944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7945 procedure TglBitmap2D.AfterConstruction;
7946 begin
7947   inherited;
7948   Target := GL_TEXTURE_2D;
7949 end;
7950
7951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7952 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7953 var
7954   Temp: pByte;
7955   Size, w, h: Integer;
7956   FormatDesc: TFormatDescriptor;
7957 begin
7958   FormatDesc := TFormatDescriptor.Get(aFormat);
7959   if FormatDesc.IsCompressed then
7960     raise EglBitmapUnsupportedFormat.Create(aFormat);
7961
7962   w    := aRight  - aLeft;
7963   h    := aBottom - aTop;
7964   Size := FormatDesc.GetSize(w, h);
7965   GetMem(Temp, Size);
7966   try
7967     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7968     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7969     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
7970     FlipVert;
7971   except
7972     if Assigned(Temp) then
7973       FreeMem(Temp);
7974     raise;
7975   end;
7976 end;
7977
7978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7979 procedure TglBitmap2D.GetDataFromTexture;
7980 var
7981   Temp: PByte;
7982   TempWidth, TempHeight: Integer;
7983   TempIntFormat: Cardinal;
7984   IntFormat, f: TglBitmapFormat;
7985   FormatDesc: TFormatDescriptor;
7986 begin
7987   Bind;
7988
7989   // Request Data
7990   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7991   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7992   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7993
7994   IntFormat := tfEmpty;
7995   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7996     FormatDesc := TFormatDescriptor.Get(f);
7997     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7998       IntFormat := FormatDesc.Format;
7999       break;
8000     end;
8001   end;
8002
8003   // Getting data from OpenGL
8004   FormatDesc := TFormatDescriptor.Get(IntFormat);
8005   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8006   try
8007     if FormatDesc.IsCompressed then begin
8008       if not Assigned(glGetCompressedTexImage) then
8009         raise EglBitmap.Create('compressed formats not supported by video adapter');
8010       glGetCompressedTexImage(Target, 0, Temp)
8011     end else
8012       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8013     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8014   except
8015     if Assigned(Temp) then
8016       FreeMem(Temp);
8017     raise;
8018   end;
8019 end;
8020
8021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8022 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8023 var
8024   BuildWithGlu, PotTex, TexRec: Boolean;
8025   TexSize: Integer;
8026 begin
8027   if Assigned(Data) then begin
8028     // Check Texture Size
8029     if (aTestTextureSize) then begin
8030       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8031
8032       if ((Height > TexSize) or (Width > TexSize)) then
8033         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8034
8035       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8036       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8037       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8038         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8039     end;
8040
8041     CreateId;
8042     SetupParameters(BuildWithGlu);
8043     UploadData(Target, BuildWithGlu);
8044     glAreTexturesResident(1, @fID, @fIsResident);
8045   end;
8046 end;
8047
8048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8049 function TglBitmap2D.FlipHorz: Boolean;
8050 var
8051   Col, Row: Integer;
8052   TempDestData, DestData, SourceData: PByte;
8053   ImgSize: Integer;
8054 begin
8055   result := inherited FlipHorz;
8056   if Assigned(Data) then begin
8057     SourceData := Data;
8058     ImgSize := Height * fRowSize;
8059     GetMem(DestData, ImgSize);
8060     try
8061       TempDestData := DestData;
8062       Dec(TempDestData, fRowSize + fPixelSize);
8063       for Row := 0 to Height -1 do begin
8064         Inc(TempDestData, fRowSize * 2);
8065         for Col := 0 to Width -1 do begin
8066           Move(SourceData^, TempDestData^, fPixelSize);
8067           Inc(SourceData, fPixelSize);
8068           Dec(TempDestData, fPixelSize);
8069         end;
8070       end;
8071       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8072       result := true;
8073     except
8074       if Assigned(DestData) then
8075         FreeMem(DestData);
8076       raise;
8077     end;
8078   end;
8079 end;
8080
8081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8082 function TglBitmap2D.FlipVert: Boolean;
8083 var
8084   Row: Integer;
8085   TempDestData, DestData, SourceData: PByte;
8086 begin
8087   result := inherited FlipVert;
8088   if Assigned(Data) then begin
8089     SourceData := Data;
8090     GetMem(DestData, Height * fRowSize);
8091     try
8092       TempDestData := DestData;
8093       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8094       for Row := 0 to Height -1 do begin
8095         Move(SourceData^, TempDestData^, fRowSize);
8096         Dec(TempDestData, fRowSize);
8097         Inc(SourceData, fRowSize);
8098       end;
8099       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
8100       result := true;
8101     except
8102       if Assigned(DestData) then
8103         FreeMem(DestData);
8104       raise;
8105     end;
8106   end;
8107 end;
8108
8109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8110 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8112 type
8113   TMatrixItem = record
8114     X, Y: Integer;
8115     W: Single;
8116   end;
8117
8118   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8119   TglBitmapToNormalMapRec = Record
8120     Scale: Single;
8121     Heights: array of Single;
8122     MatrixU : array of TMatrixItem;
8123     MatrixV : array of TMatrixItem;
8124   end;
8125
8126 const
8127   ONE_OVER_255 = 1 / 255;
8128
8129   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8130 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8131 var
8132   Val: Single;
8133 begin
8134   with FuncRec do begin
8135     Val :=
8136       Source.Data.r * LUMINANCE_WEIGHT_R +
8137       Source.Data.g * LUMINANCE_WEIGHT_G +
8138       Source.Data.b * LUMINANCE_WEIGHT_B;
8139     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8140   end;
8141 end;
8142
8143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8144 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8145 begin
8146   with FuncRec do
8147     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8148 end;
8149
8150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8151 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8152 type
8153   TVec = Array[0..2] of Single;
8154 var
8155   Idx: Integer;
8156   du, dv: Double;
8157   Len: Single;
8158   Vec: TVec;
8159
8160   function GetHeight(X, Y: Integer): Single;
8161   begin
8162     with FuncRec do begin
8163       X := Max(0, Min(Size.X -1, X));
8164       Y := Max(0, Min(Size.Y -1, Y));
8165       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8166     end;
8167   end;
8168
8169 begin
8170   with FuncRec do begin
8171     with PglBitmapToNormalMapRec(Args)^ do begin
8172       du := 0;
8173       for Idx := Low(MatrixU) to High(MatrixU) do
8174         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8175
8176       dv := 0;
8177       for Idx := Low(MatrixU) to High(MatrixU) do
8178         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8179
8180       Vec[0] := -du * Scale;
8181       Vec[1] := -dv * Scale;
8182       Vec[2] := 1;
8183     end;
8184
8185     // Normalize
8186     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8187     if Len <> 0 then begin
8188       Vec[0] := Vec[0] * Len;
8189       Vec[1] := Vec[1] * Len;
8190       Vec[2] := Vec[2] * Len;
8191     end;
8192
8193     // Farbe zuweisem
8194     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8195     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8196     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8197   end;
8198 end;
8199
8200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8201 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8202 var
8203   Rec: TglBitmapToNormalMapRec;
8204
8205   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8206   begin
8207     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8208       Matrix[Index].X := X;
8209       Matrix[Index].Y := Y;
8210       Matrix[Index].W := W;
8211     end;
8212   end;
8213
8214 begin
8215   if TFormatDescriptor.Get(Format).IsCompressed then
8216     raise EglBitmapUnsupportedFormat.Create(Format);
8217
8218   if aScale > 100 then
8219     Rec.Scale := 100
8220   else if aScale < -100 then
8221     Rec.Scale := -100
8222   else
8223     Rec.Scale := aScale;
8224
8225   SetLength(Rec.Heights, Width * Height);
8226   try
8227     case aFunc of
8228       nm4Samples: begin
8229         SetLength(Rec.MatrixU, 2);
8230         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8231         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8232
8233         SetLength(Rec.MatrixV, 2);
8234         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8235         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8236       end;
8237
8238       nmSobel: begin
8239         SetLength(Rec.MatrixU, 6);
8240         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8241         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8242         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8243         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8244         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8245         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8246
8247         SetLength(Rec.MatrixV, 6);
8248         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8249         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8250         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8251         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8252         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8253         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8254       end;
8255
8256       nm3x3: begin
8257         SetLength(Rec.MatrixU, 6);
8258         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8259         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8260         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8261         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8262         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8263         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8264
8265         SetLength(Rec.MatrixV, 6);
8266         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8267         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8268         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8269         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8270         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8271         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8272       end;
8273
8274       nm5x5: begin
8275         SetLength(Rec.MatrixU, 20);
8276         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8277         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8278         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8279         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8280         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8281         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8282         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8283         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8284         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8285         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8286         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8287         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8288         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8289         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8290         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8291         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8292         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8293         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8294         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8295         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8296
8297         SetLength(Rec.MatrixV, 20);
8298         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8299         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8300         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8301         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8302         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8303         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8304         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8305         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8306         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8307         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8308         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8309         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8310         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8311         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8312         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8313         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8314         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8315         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8316         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8317         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8318       end;
8319     end;
8320
8321     // Daten Sammeln
8322     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8323       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8324     else
8325       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
8326     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
8327   finally
8328     SetLength(Rec.Heights, 0);
8329   end;
8330 end;
8331
8332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8333 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8335 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8336 begin
8337   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8338 end;
8339
8340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8341 procedure TglBitmapCubeMap.AfterConstruction;
8342 begin
8343   inherited;
8344
8345   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8346     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8347
8348   SetWrap;
8349   Target   := GL_TEXTURE_CUBE_MAP;
8350   fGenMode := GL_REFLECTION_MAP;
8351 end;
8352
8353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8354 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8355 var
8356   BuildWithGlu: Boolean;
8357   TexSize: Integer;
8358 begin
8359   if (aTestTextureSize) then begin
8360     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8361
8362     if (Height > TexSize) or (Width > TexSize) then
8363       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8364
8365     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8366       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8367   end;
8368
8369   if (ID = 0) then
8370     CreateID;
8371   SetupParameters(BuildWithGlu);
8372   UploadData(aCubeTarget, BuildWithGlu);
8373 end;
8374
8375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8376 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8377 begin
8378   inherited Bind (aEnableTextureUnit);
8379   if aEnableTexCoordsGen then begin
8380     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8381     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8382     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8383     glEnable(GL_TEXTURE_GEN_S);
8384     glEnable(GL_TEXTURE_GEN_T);
8385     glEnable(GL_TEXTURE_GEN_R);
8386   end;
8387 end;
8388
8389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8390 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8391 begin
8392   inherited Unbind(aDisableTextureUnit);
8393   if aDisableTexCoordsGen then begin
8394     glDisable(GL_TEXTURE_GEN_S);
8395     glDisable(GL_TEXTURE_GEN_T);
8396     glDisable(GL_TEXTURE_GEN_R);
8397   end;
8398 end;
8399
8400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8401 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8403 type
8404   TVec = Array[0..2] of Single;
8405   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8406
8407   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8408   TglBitmapNormalMapRec = record
8409     HalfSize : Integer;
8410     Func: TglBitmapNormalMapGetVectorFunc;
8411   end;
8412
8413   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8414 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8415 begin
8416   aVec[0] := aHalfSize;
8417   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8418   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8419 end;
8420
8421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8422 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8423 begin
8424   aVec[0] := - aHalfSize;
8425   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8426   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8427 end;
8428
8429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8430 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8431 begin
8432   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8433   aVec[1] := aHalfSize;
8434   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8435 end;
8436
8437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8438 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8439 begin
8440   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8441   aVec[1] := - aHalfSize;
8442   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8443 end;
8444
8445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8446 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8447 begin
8448   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8449   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8450   aVec[2] := aHalfSize;
8451 end;
8452
8453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8454 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8455 begin
8456   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8457   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8458   aVec[2] := - aHalfSize;
8459 end;
8460
8461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8463 var
8464   i: Integer;
8465   Vec: TVec;
8466   Len: Single;
8467 begin
8468   with FuncRec do begin
8469     with PglBitmapNormalMapRec(Args)^ do begin
8470       Func(Vec, Position, HalfSize);
8471
8472       // Normalize
8473       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8474       if Len <> 0 then begin
8475         Vec[0] := Vec[0] * Len;
8476         Vec[1] := Vec[1] * Len;
8477         Vec[2] := Vec[2] * Len;
8478       end;
8479
8480       // Scale Vector and AddVectro
8481       Vec[0] := Vec[0] * 0.5 + 0.5;
8482       Vec[1] := Vec[1] * 0.5 + 0.5;
8483       Vec[2] := Vec[2] * 0.5 + 0.5;
8484     end;
8485
8486     // Set Color
8487     for i := 0 to 2 do
8488       Dest.Data.arr[i] := Round(Vec[i] * 255);
8489   end;
8490 end;
8491
8492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8493 procedure TglBitmapNormalMap.AfterConstruction;
8494 begin
8495   inherited;
8496   fGenMode := GL_NORMAL_MAP;
8497 end;
8498
8499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8500 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8501 var
8502   Rec: TglBitmapNormalMapRec;
8503   SizeRec: TglBitmapPixelPosition;
8504 begin
8505   Rec.HalfSize := aSize div 2;
8506   FreeDataAfterGenTexture := false;
8507
8508   SizeRec.Fields := [ffX, ffY];
8509   SizeRec.X := aSize;
8510   SizeRec.Y := aSize;
8511
8512   // Positive X
8513   Rec.Func := glBitmapNormalMapPosX;
8514   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8515   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8516
8517   // Negative X
8518   Rec.Func := glBitmapNormalMapNegX;
8519   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8520   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8521
8522   // Positive Y
8523   Rec.Func := glBitmapNormalMapPosY;
8524   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8525   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8526
8527   // Negative Y
8528   Rec.Func := glBitmapNormalMapNegY;
8529   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8530   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8531
8532   // Positive Z
8533   Rec.Func := glBitmapNormalMapPosZ;
8534   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8535   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8536
8537   // Negative Z
8538   Rec.Func := glBitmapNormalMapNegZ;
8539   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8540   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8541 end;
8542
8543
8544 initialization
8545   glBitmapSetDefaultFormat (tfEmpty);
8546   glBitmapSetDefaultMipmap (mmMipmap);
8547   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8548   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8549   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8550
8551   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8552   glBitmapSetDefaultDeleteTextureOnFree    (true);
8553
8554   TFormatDescriptor.Init;
8555
8556 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8557   OpenGLInitialized := false;
8558   InitOpenGLCS := TCriticalSection.Create;
8559 {$ENDIF}
8560
8561 finalization
8562   TFormatDescriptor.Finalize;
8563
8564 {$IFDEF GLB_NATIVE_OGL}
8565   if Assigned(GL_LibHandle) then
8566     glbFreeLibrary(GL_LibHandle);
8567
8568 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8569   if Assigned(GLU_LibHandle) then
8570     glbFreeLibrary(GLU_LibHandle);
8571   FreeAndNil(InitOpenGLCS);
8572 {$ENDIF}
8573 {$ENDIF}
8574
8575 end.