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/)
   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 2.0.3
  15 ------------------------------------------------------------
  16 History
  17 21-03-2010
  18 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19   then it's your problem if that isn't true. This prevents the unit for incompatibility
  20   with newer versions of Delphi.
  21 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23 10-08-2008
  24 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25 - Additional Datapointer for functioninterface now has the name CustomData
  26 24-07-2008
  27 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28 - If you load an texture from an file the property Filename will be set to the name of the file
  29 - Three new properties to attach custom data to the Texture objects
  30   - CustomName  (free for use string)
  31   - CustomNameW (free for use widestring)
  32   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33 27-05-2008
  34 - RLE TGAs loaded much faster
  35 26-05-2008
  36 - fixed some problem with reading RLE TGAs.
  37 21-05-2008
  38 - function clone now only copys data if it's assigned and now it also copies the ID
  39 - it seems that lazarus dont like comments in comments.
  40 01-05-2008
  41 - It's possible to set the id of the texture
  42 - define GLB_NO_NATIVE_GL deactivated by default
  43 27-04-2008
  44 - Now supports the following libraries
  45   - SDL and SDL_image
  46   - libPNG
  47   - libJPEG
  48 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49 - BMPs now loaded manuel
  50 - Large restructuring
  51 - Property DataPtr now has the name Data
  52 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53 - Unused Depth removed
  54 - Function FreeData to freeing image data added
  55 24-10-2007
  56 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57 15-11-2006
  58 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60 - Function ReadOpenGLExtension is now only intern
  61 29-06-2006
  62 - pngimage now disabled by default like all other versions.
  63 26-06-2006
  64 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65 22-06-2006
  66 - Fixed some Problem with Delphi 5
  67 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68 22-03-2006
  69 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70 09-03-2006
  71 - Internal Format ifDepth8 added
  72 - function GrabScreen now supports all uncompressed formats
  73 31-01-2006
  74 - AddAlphaFromglBitmap implemented
  75 29-12-2005
  76 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77 28-12-2005
  78 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79   property Width, Height, Depth are still existing and new property Dimension are avail
  80 11-12-2005
  81 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82 19-10-2005
  83 - Added function GrabScreen to class TglBitmap2D
  84 18-10-2005
  85 - Added support to Save images
  86 - Added function Clone to Clone Instance
  87 11-10-2005
  88 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89   Usefull for Future
  90 - Several speed optimizations
  91 09-10-2005
  92 - Internal structure change. Loading of TGA, PNG and DDS improved.
  93   Data, format and size will now set directly with SetDataPtr.
  94 - AddFunc now works with all Types of Images and Formats
  95 - Some Funtions moved to Baseclass TglBitmap
  96 06-10-2005
  97 - Added Support to decompress DXT3 and DXT5 compressed Images.
  98 - Added Mapping to convert data from one format into an other.
  99 05-10-2005
 100 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 101   supported Input format (supported by GetPixel) into any uncompresed Format
 102 - Added Support to decompress DXT1 compressed Images.
 103 - SwapColors replaced by ConvertTo
 104 04-10-2005
 105 - Added Support for compressed DDSs
 106 - Added new internal formats (DXT1, DXT3, DXT5)
 107 29-09-2005
 108 - Parameter Components renamed to InternalFormat
 109 23-09-2005
 110 - Some AllocMem replaced with GetMem (little speed change)
 111 - better exception handling. Better protection from memory leaks.
 112 22-09-2005
 113 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 114 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 115 07-09-2005
 116 - Added support for Grayscale textures
 117 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 118 10-07-2005
 119 - Added support for GL_VERSION_2_0
 120 - Added support for GL_EXT_texture_filter_anisotropic
 121 04-07-2005
 122 - Function FillWithColor fills the Image with one Color
 123 - Function LoadNormalMap added
 124 30-06-2005
 125 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 126 - ToNormalMap now supports Sobel (nmSobel) function.
 127 29-06-2005
 128 - support for RLE Compressed RGB TGAs added
 129 28-06-2005
 130 - Class TglBitmapNormalMap added to support Normalmap generation
 131 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 132   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 133 16-06-2005
 134 - Method LoadCubeMapClass removed
 135 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 136 - virtual abstract method GenTexture in class TglBitmap now is protected
 137 12-06-2005
 138 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 139 10-06-2005
 140 - little enhancement for IsPowerOfTwo
 141 - TglBitmap1D.GenTexture now tests NPOT Textures
 142 06-06-2005
 143 - some little name changes. All properties or function with Texture in name are
 144   now without texture in name. We have allways texture so we dosn't name it.
 145 03-06-2005
 146 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 147   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 148 02-06-2005
 149 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 150 25-04-2005
 151 - Function Unbind added
 152 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 153 21-04-2005
 154 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 155 29-03-2005
 156 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 157   To Enable png's use the define pngimage
 158 22-03-2005
 159 - New Functioninterface added
 160 - Function GetPixel added
 161 27-11-2004
 162 - Property BuildMipMaps renamed to MipMap
 163 21-11-2004
 164 - property Name removed.
 165 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 166 22-05-2004
 167 - property name added. Only used in glForms!
 168 26-11-2003
 169 - property FreeDataAfterGenTexture is now available as default (default = true)
 170 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 171 - function MoveMemory replaced with function Move (little speed change)
 172 - several calculations stored in variables (little speed change)
 173 29-09-2003
 174 - property BuildMipsMaps added (default = true)
 175   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 176 - property FreeDataAfterGenTexture added (default = true)
 177   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 178 - parameter DisableOtherTextureUnits of Bind removed
 179 - parameter FreeDataAfterGeneration of GenTextures removed
 180 12-09-2003
 181 - TglBitmap dosn't delete data if class was destroyed (fixed)
 182 09-09-2003
 183 - Bind now enables TextureUnits (by params)
 184 - GenTextures can leave data (by param)
 185 - LoadTextures now optimal
 186 03-09-2003
 187 - Performance optimization in AddFunc
 188 - procedure Bind moved to subclasses
 189 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 190 19-08-2003
 191 - Texturefilter and texturewrap now also as defaults
 192   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 193   Magfilter = GL_LINEAR
 194   Wrap(str) = GL_CLAMP_TO_EDGE
 195 - Added new format tfCompressed to create a compressed texture.
 196 - propertys IsCompressed, TextureSize and IsResident added
 197   IsCompressed and TextureSize only contains data from level 0
 198 18-08-2003
 199 - Added function AddFunc to add PerPixelEffects to Image
 200 - LoadFromFunc now based on AddFunc
 201 - Invert now based on AddFunc
 202 - SwapColors now based on AddFunc
 203 16-08-2003
 204 - Added function FlipHorz
 205 15-08-2003
 206 - Added function LaodFromFunc to create images with function
 207 - Added function FlipVert
 208 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 209 29-07-2003
 210 - Added Alphafunctions to calculate alpha per function
 211 - Added Alpha from ColorKey using alphafunctions
 212 28-07-2003
 213 - First full functionally Version of glBitmap
 214 - Support for 24Bit and 32Bit TGA Pictures added
 215 25-07-2003
 216 - begin of programming
 217 ***********************************************************}
 218 unit glBitmap;
 219
 220 // Please uncomment the defines below to configure the glBitmap to your preferences.
 221 // If you have configured the unit you can uncomment the warning above.
 222 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 223
 224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 225 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // activate to enable build-in OpenGL support with statically linked methods
 228 // use dglOpenGL.pas if not enabled
 229 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 230
 231 // activate to enable build-in OpenGL support with dynamically linked methods
 232 // use dglOpenGL.pas if not enabled
 233 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 234
 235
 236 // activate to enable the support for SDL_surfaces
 237 {.$DEFINE GLB_SDL}
 238
 239 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 240 {.$DEFINE GLB_DELPHI}
 241
 242 // activate to enable the support for TLazIntfImage from Lazarus
 243 {$DEFINE GLB_LAZARUS}
 244
 245
 246
 247 // activate to enable the support of SDL_image to load files. (READ ONLY)
 248 // If you enable SDL_image all other libraries will be ignored!
 249 {.$DEFINE GLB_SDL_IMAGE}
 250
 251
 252
 253 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 254 // if you enable pngimage the libPNG will be ignored
 255 {.$DEFINE GLB_PNGIMAGE}
 256
 257 // activate to use the libPNG -> http://www.libpng.org/
 258 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 259 {.$DEFINE GLB_LIB_PNG}
 260
 261
 262
 263 // if you enable delphi jpegs the libJPEG will be ignored
 264 {.$DEFINE GLB_DELPHI_JPEG}
 265
 266 // activate to use the libJPEG -> http://www.ijg.org/
 267 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 268 {.$DEFINE GLB_LIB_JPEG}
 269
 270
 271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 272 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 274 // Delphi Versions
 275 {$IFDEF fpc}
 276   {$MODE Delphi}
 277
 278   {$IFDEF CPUI386}
 279     {$DEFINE CPU386}
 280     {$ASMMODE INTEL}
 281   {$ENDIF}
 282
 283   {$IFNDEF WINDOWS}
 284     {$linklib c}
 285   {$ENDIF}
 286 {$ENDIF}
 287
 288 // Operation System
 289 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 290   {$DEFINE GLB_WIN}
 291 {$ELSEIF DEFINED(LINUX)}
 292   {$DEFINE GLB_LINUX}
 293 {$IFEND}
 294
 295 // native OpenGL Support
 296 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 297   {$DEFINE GLB_NATIVE_OGL}
 298 {$IFEND}
 299
 300 // checking define combinations
 301 //SDL Image
 302 {$IFDEF GLB_SDL_IMAGE}
 303   {$IFNDEF GLB_SDL}
 304     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 305     {$DEFINE GLB_SDL}
 306   {$ENDIF}
 307   {$IFDEF GLB_PNGIMAGE}
 308     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 309     {$undef GLB_PNGIMAGE}
 310   {$ENDIF}
 311   {$IFDEF GLB_DELPHI_JPEG}
 312     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 313     {$undef GLB_DELPHI_JPEG}
 314   {$ENDIF}
 315   {$IFDEF GLB_LIB_PNG}
 316     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 317     {$undef GLB_LIB_PNG}
 318   {$ENDIF}
 319   {$IFDEF GLB_LIB_JPEG}
 320     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 321     {$undef GLB_LIB_JPEG}
 322   {$ENDIF}
 323
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_JPEG_READ}
 326 {$ENDIF}
 327
 328 // PNG Image
 329 {$IFDEF GLB_PNGIMAGE}
 330   {$IFDEF GLB_LIB_PNG}
 331     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 332     {$undef GLB_LIB_PNG}
 333   {$ENDIF}
 334
 335   {$DEFINE GLB_SUPPORT_PNG_READ}
 336   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 337 {$ENDIF}
 338
 339 // libPNG
 340 {$IFDEF GLB_LIB_PNG}
 341   {$DEFINE GLB_SUPPORT_PNG_READ}
 342   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 343 {$ENDIF}
 344
 345 // JPEG Image
 346 {$IFDEF GLB_DELPHI_JPEG}
 347   {$IFDEF GLB_LIB_JPEG}
 348     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 349     {$undef GLB_LIB_JPEG}
 350   {$ENDIF}
 351
 352   {$DEFINE GLB_SUPPORT_JPEG_READ}
 353   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 354 {$ENDIF}
 355
 356 // libJPEG
 357 {$IFDEF GLB_LIB_JPEG}
 358   {$DEFINE GLB_SUPPORT_JPEG_READ}
 359   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 360 {$ENDIF}
 361
 362 // native OpenGL
 363 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 364   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 365 {$IFEND}
 366
 367 // general options
 368 {$EXTENDEDSYNTAX ON}
 369 {$LONGSTRINGS ON}
 370 {$ALIGN ON}
 371 {$IFNDEF FPC}
 372   {$OPTIMIZATION ON}
 373 {$ENDIF}
 374
 375 interface
 376
 377 uses
 378   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,          {$ENDIF}
 379   {$IF DEFINED(GLB_WIN) AND
 380        DEFINED(GLB_NATIVE_OGL)} windows,            {$IFEND}
 381
 382   {$IFDEF GLB_SDL}              SDL,                {$ENDIF}
 383   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,       {$ENDIF}
 384   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,  {$ENDIF}
 385
 386   {$IFDEF GLB_SDL_IMAGE}        SDL_image,          {$ENDIF}
 387
 388   {$IFDEF GLB_PNGIMAGE}         pngimage,           {$ENDIF}
 389   {$IFDEF GLB_LIB_PNG}          libPNG,             {$ENDIF}
 390
 391   {$IFDEF GLB_DELPHI_JPEG}      JPEG,               {$ENDIF}
 392   {$IFDEF GLB_LIB_JPEG}         libJPEG,            {$ENDIF}
 393
 394   Classes, SysUtils;
 395
 396 {$IFDEF GLB_NATIVE_OGL}
 397 const
 398   GL_TRUE   = 1;
 399   GL_FALSE  = 0;
 400
 401   GL_VERSION    = $1F02;
 402   GL_EXTENSIONS = $1F03;
 403
 404   GL_TEXTURE_1D         = $0DE0;
 405   GL_TEXTURE_2D         = $0DE1;
 406   GL_TEXTURE_RECTANGLE  = $84F5;
 407
 408   GL_TEXTURE_WIDTH            = $1000;
 409   GL_TEXTURE_HEIGHT           = $1001;
 410   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 411
 412   GL_ALPHA    = $1906;
 413   GL_ALPHA4   = $803B;
 414   GL_ALPHA8   = $803C;
 415   GL_ALPHA12  = $803D;
 416   GL_ALPHA16  = $803E;
 417
 418   GL_LUMINANCE    = $1909;
 419   GL_LUMINANCE4   = $803F;
 420   GL_LUMINANCE8   = $8040;
 421   GL_LUMINANCE12  = $8041;
 422   GL_LUMINANCE16  = $8042;
 423
 424   GL_LUMINANCE_ALPHA      = $190A;
 425   GL_LUMINANCE4_ALPHA4    = $8043;
 426   GL_LUMINANCE6_ALPHA2    = $8044;
 427   GL_LUMINANCE8_ALPHA8    = $8045;
 428   GL_LUMINANCE12_ALPHA4   = $8046;
 429   GL_LUMINANCE12_ALPHA12  = $8047;
 430   GL_LUMINANCE16_ALPHA16  = $8048;
 431
 432   GL_RGB      = $1907;
 433   GL_BGR      = $80E0;
 434   GL_R3_G3_B2 = $2A10;
 435   GL_RGB4     = $804F;
 436   GL_RGB5     = $8050;
 437   GL_RGB565   = $8D62;
 438   GL_RGB8     = $8051;
 439   GL_RGB10    = $8052;
 440   GL_RGB12    = $8053;
 441   GL_RGB16    = $8054;
 442
 443   GL_RGBA     = $1908;
 444   GL_BGRA     = $80E1;
 445   GL_RGBA2    = $8055;
 446   GL_RGBA4    = $8056;
 447   GL_RGB5_A1  = $8057;
 448   GL_RGBA8    = $8058;
 449   GL_RGB10_A2 = $8059;
 450   GL_RGBA12   = $805A;
 451   GL_RGBA16   = $805B;
 452
 453   GL_DEPTH_COMPONENT    = $1902;
 454   GL_DEPTH_COMPONENT16  = $81A5;
 455   GL_DEPTH_COMPONENT24  = $81A6;
 456   GL_DEPTH_COMPONENT32  = $81A7;
 457
 458   GL_COMPRESSED_RGB                 = $84ED;
 459   GL_COMPRESSED_RGBA                = $84EE;
 460   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 461   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 462   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 463   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 464
 465   GL_UNSIGNED_BYTE            = $1401;
 466   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 467   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 468
 469   GL_UNSIGNED_SHORT             = $1403;
 470   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 471   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 472   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 473   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 474   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 475   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 476
 477   GL_UNSIGNED_INT                 = $1405;
 478   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 479   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 480   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 481   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 482
 483   { Texture Filter }
 484   GL_TEXTURE_MAG_FILTER     = $2800;
 485   GL_TEXTURE_MIN_FILTER     = $2801;
 486   GL_NEAREST                = $2600;
 487   GL_NEAREST_MIPMAP_NEAREST = $2700;
 488   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 489   GL_LINEAR                 = $2601;
 490   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 491   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 492
 493   { Texture Wrap }
 494   GL_TEXTURE_WRAP_S   = $2802;
 495   GL_TEXTURE_WRAP_T   = $2803;
 496   GL_TEXTURE_WRAP_R   = $8072;
 497   GL_CLAMP            = $2900;
 498   GL_REPEAT           = $2901;
 499   GL_CLAMP_TO_EDGE    = $812F;
 500   GL_CLAMP_TO_BORDER  = $812D;
 501   GL_MIRRORED_REPEAT  = $8370;
 502
 503   { Other }
 504   GL_GENERATE_MIPMAP      = $8191;
 505   GL_TEXTURE_BORDER_COLOR = $1004;
 506   GL_MAX_TEXTURE_SIZE     = $0D33;
 507   GL_PACK_ALIGNMENT       = $0D05;
 508   GL_UNPACK_ALIGNMENT     = $0CF5;
 509
 510   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 511   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 512
 513 {$IF DEFINED(GLB_WIN)}
 514   libglu    = 'glu32.dll';
 515   libopengl = 'opengl32.dll';
 516 {$ELSEIF DEFINED(GLB_LINUX)}
 517   libglu    = 'libGLU.so.1';
 518   libopengl = 'libGL.so.1';
 519 {$IFEND}
 520
 521 type
 522   GLboolean = BYTEBOOL;
 523   GLint     = Integer;
 524   GLsizei   = Integer;
 525   GLuint    = Cardinal;
 526   GLfloat   = Single;
 527   GLenum    = Cardinal;
 528
 529   PGLvoid    = Pointer;
 530   PGLboolean = ^GLboolean;
 531   PGLint     = ^GLint;
 532   PGLuint    = ^GLuint;
 533   PGLfloat   = ^GLfloat;
 534
 535   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 536   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}
 537   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 538
 539 {$IF DEFINED(GLB_WIN)}
 540   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 541 {$ELSEIF DEFINED(GLB_LINUX)}
 542   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 543   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 544 {$IFEND}
 545
 546 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 547   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 548   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549
 550   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 551   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552
 553   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 554   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 557   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559
 560   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 561   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563
 564   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 565   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 567
 568   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}
 569   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}
 570   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 571
 572   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 573   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 574
 575 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 576   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 577   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 578
 579   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 580   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 581
 582   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 583   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 585   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 586   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588
 589   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 592
 593   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   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;
 595   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 596
 597   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;
 598   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;
 599   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 600
 601   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 602   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 603 {$IFEND}
 604
 605 var
 606   GL_VERSION_1_2,
 607   GL_VERSION_1_3,
 608   GL_VERSION_1_4,
 609   GL_VERSION_2_0,
 610
 611   GL_SGIS_generate_mipmap,
 612
 613   GL_ARB_texture_border_clamp,
 614   GL_ARB_texture_mirrored_repeat,
 615   GL_ARB_texture_rectangle,
 616   GL_ARB_texture_non_power_of_two,
 617
 618   GL_IBM_texture_mirrored_repeat,
 619
 620   GL_NV_texture_rectangle,
 621
 622   GL_EXT_texture_edge_clamp,
 623   GL_EXT_texture_rectangle,
 624   GL_EXT_texture_filter_anisotropic: Boolean;
 625
 626   glCompressedTexImage1D: TglCompressedTexImage1D;
 627   glCompressedTexImage2D: TglCompressedTexImage2D;
 628   glGetCompressedTexImage: TglGetCompressedTexImage;
 629
 630 {$IF DEFINED(GLB_WIN)}
 631   wglGetProcAddress: TwglGetProcAddress;
 632 {$ELSEIF DEFINED(GLB_LINUX)}
 633   glXGetProcAddress: TglXGetProcAddress;
 634   glXGetProcAddressARB: TglXGetProcAddress;
 635 {$IFEND}
 636
 637 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 638   glEnable: TglEnable;
 639   glDisable: TglDisable;
 640
 641   glGetString: TglGetString;
 642   glGetIntegerv: TglGetIntegerv;
 643
 644   glTexParameteri: TglTexParameteri;
 645   glTexParameterfv: TglTexParameterfv;
 646   glGetTexParameteriv: TglGetTexParameteriv;
 647   glGetTexParameterfv: TglGetTexParameterfv;
 648   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 649   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 650
 651   glGenTextures: TglGenTextures;
 652   glBindTexture: TglBindTexture;
 653   glDeleteTextures: TglDeleteTextures;
 654
 655   glAreTexturesResident: TglAreTexturesResident;
 656   glReadPixels: TglReadPixels;
 657   glPixelStorei: TglPixelStorei;
 658
 659   glTexImage1D: TglTexImage1D;
 660   glTexImage2D: TglTexImage2D;
 661   glGetTexImage: TglGetTexImage;
 662
 663   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 664   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 665 {$ENDIF}
 666 {$ENDIF}
 667
 668 type
 669 ////////////////////////////////////////////////////////////////////////////////////////////////////
 670   TglBitmapFormat = (
 671     tfEmpty = 0, //must be smallest value!
 672
 673     tfAlpha4,
 674     tfAlpha8,
 675     tfAlpha12,
 676     tfAlpha16,
 677
 678     tfLuminance4,
 679     tfLuminance8,
 680     tfLuminance12,
 681     tfLuminance16,
 682
 683     tfLuminance4Alpha4,
 684     tfLuminance6Alpha2,
 685     tfLuminance8Alpha8,
 686     tfLuminance12Alpha4,
 687     tfLuminance12Alpha12,
 688     tfLuminance16Alpha16,
 689
 690     tfR3G3B2,
 691     tfRGB4,
 692     tfR5G6B5,
 693     tfRGB5,
 694     tfRGB8,
 695     tfRGB10,
 696     tfRGB12,
 697     tfRGB16,
 698
 699     tfRGBA2,
 700     tfRGBA4,
 701     tfRGB5A1,
 702     tfRGBA8,
 703     tfRGB10A2,
 704     tfRGBA12,
 705     tfRGBA16,
 706
 707     tfBGR4,
 708     tfB5G6R5,
 709     tfBGR5,
 710     tfBGR8,
 711     tfBGR10,
 712     tfBGR12,
 713     tfBGR16,
 714
 715     tfBGRA2,
 716     tfBGRA4,
 717     tfBGR5A1,
 718     tfBGRA8,
 719     tfBGR10A2,
 720     tfBGRA12,
 721     tfBGRA16,
 722
 723     tfDepth16,
 724     tfDepth24,
 725     tfDepth32,
 726
 727     tfS3tcDtx1RGBA,
 728     tfS3tcDtx3RGBA,
 729     tfS3tcDtx5RGBA
 730   );
 731
 732   TglBitmapFileType = (
 733      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 734      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 735      ftDDS,
 736      ftTGA,
 737      ftBMP);
 738    TglBitmapFileTypes = set of TglBitmapFileType;
 739
 740    TglBitmapMipMap = (
 741      mmNone,
 742      mmMipmap,
 743      mmMipmapGlu);
 744
 745    TglBitmapNormalMapFunc = (
 746      nm4Samples,
 747      nmSobel,
 748      nm3x3,
 749      nm5x5);
 750
 751  ////////////////////////////////////////////////////////////////////////////////////////////////////
 752    EglBitmapException               = class(Exception);
 753    EglBitmapSizeToLargeException    = class(EglBitmapException);
 754    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 755    EglBitmapUnsupportedFormat       = class(EglBitmapException)
 756      constructor Create(const aFormat: TglBitmapFormat); overload;
 757      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 758    end;
 759
 760 ////////////////////////////////////////////////////////////////////////////////////////////////////
 761   TglBitmapColorRec = packed record
 762   case Integer of
 763     0: (r, g, b, a: Cardinal);
 764     1: (arr: array[0..3] of Cardinal);
 765   end;
 766
 767   TglBitmapPixelData = packed record
 768     Data, Range: TglBitmapColorRec;
 769     Format: TglBitmapFormat;
 770   end;
 771   PglBitmapPixelData = ^TglBitmapPixelData;
 772
 773 ////////////////////////////////////////////////////////////////////////////////////////////////////
 774   TglBitmapPixelPositionFields = set of (ffX, ffY);
 775   TglBitmapPixelPosition = record
 776     Fields : TglBitmapPixelPositionFields;
 777     X : Word;
 778     Y : Word;
 779   end;
 780
 781 ////////////////////////////////////////////////////////////////////////////////////////////////////
 782   TglBitmap = class;
 783   TglBitmapFunctionRec = record
 784     Sender:   TglBitmap;
 785     Size:     TglBitmapPixelPosition;
 786     Position: TglBitmapPixelPosition;
 787     Source:   TglBitmapPixelData;
 788     Dest:     TglBitmapPixelData;
 789     Args:     Pointer;
 790   end;
 791   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 792
 793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 794   TglBitmap = class
 795   protected
 796     fID: GLuint;
 797     fTarget: GLuint;
 798     fAnisotropic: Integer;
 799     fDeleteTextureOnFree: Boolean;
 800     fFreeDataAfterGenTexture: Boolean;
 801     fData: PByte;
 802     fIsResident: Boolean;
 803     fBorderColor: array[0..3] of Single;
 804
 805     fDimension: TglBitmapPixelPosition;
 806     fMipMap: TglBitmapMipMap;
 807     fFormat: TglBitmapFormat;
 808
 809     // Mapping
 810     fPixelSize: Integer;
 811     fRowSize: Integer;
 812
 813     // Filtering
 814     fFilterMin: Cardinal;
 815     fFilterMag: Cardinal;
 816
 817     // TexturWarp
 818     fWrapS: Cardinal;
 819     fWrapT: Cardinal;
 820     fWrapR: Cardinal;
 821
 822     // CustomData
 823     fFilename: String;
 824     fCustomName: String;
 825     fCustomNameW: WideString;
 826     fCustomData: Pointer;
 827
 828     //Getter
 829     function GetWidth:  Integer; virtual;
 830     function GetHeight: Integer; virtual;
 831
 832     function GetFileWidth:  Integer; virtual;
 833     function GetFileHeight: Integer; virtual;
 834
 835     //Setter
 836     procedure SetCustomData(const aValue: Pointer);
 837     procedure SetCustomName(const aValue: String);
 838     procedure SetCustomNameW(const aValue: WideString);
 839     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 840     procedure SetFormat(const aValue: TglBitmapFormat);
 841     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 842     procedure SetID(const aValue: Cardinal);
 843     procedure SetMipMap(const aValue: TglBitmapMipMap);
 844     procedure SetTarget(const aValue: Cardinal);
 845     procedure SetAnisotropic(const aValue: Integer);
 846
 847     procedure CreateID;
 848     procedure SetupParameters(out aBuildWithGlu: Boolean);
 849     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 850       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 851     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 852
 853     function FlipHorz: Boolean; virtual;
 854     function FlipVert: Boolean; virtual;
 855
 856     property Width:  Integer read GetWidth;
 857     property Height: Integer read GetHeight;
 858
 859     property FileWidth:  Integer read GetFileWidth;
 860     property FileHeight: Integer read GetFileHeight;
 861   public
 862     //Properties
 863     property ID:           Cardinal        read fID          write SetID;
 864     property Target:       Cardinal        read fTarget      write SetTarget;
 865     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 866     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 867     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 868
 869     property Filename:    String     read fFilename;
 870     property CustomName:  String     read fCustomName  write SetCustomName;
 871     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 872     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 873
 874     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 875     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 876
 877     property Dimension:  TglBitmapPixelPosition  read fDimension;
 878     property Data:       PByte                   read fData;
 879     property IsResident: Boolean                 read fIsResident;
 880
 881     procedure AfterConstruction; override;
 882     procedure BeforeDestruction; override;
 883
 884     procedure PrepareResType(var aResource: String; var aResType: PChar);
 885
 886     //Load
 887     procedure LoadFromFile(const aFilename: String);
 888     procedure LoadFromStream(const aStream: TStream); virtual;
 889     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 890       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 891     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 892     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 893
 894     //Save
 895     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 896     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 897
 898     //Convert
 899     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 900     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 901       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 902   public
 903     //Alpha & Co
 904     {$IFDEF GLB_SDL}
 905     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 906     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 907     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 908     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 909       const aArgs: Pointer = nil): Boolean;
 910     {$ENDIF}
 911
 912     {$IFDEF GLB_DELPHI}
 913     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 914     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 915     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 916     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 917       const aArgs: Pointer = nil): Boolean;
 918     {$ENDIF}
 919
 920     {$IFDEF GLB_LAZARUS}
 921     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 922     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 923     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 924     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 925       const aArgs: Pointer = nil): Boolean;
 926     {$ENDIF}
 927
 928     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 929       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 930     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 931       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 932
 933     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 934     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 935     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 936     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 937
 938     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 939     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 940     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 941
 942     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 943     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 944     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 945
 946     function RemoveAlpha: Boolean; virtual;
 947   public
 948     //Common
 949     function Clone: TglBitmap;
 950     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 951     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 952     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 953     procedure FreeData;
 954
 955     //ColorFill
 956     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 957     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 958     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 959
 960     //TexParameters
 961     procedure SetFilter(const aMin, aMag: Cardinal);
 962     procedure SetWrap(
 963       const S: Cardinal = GL_CLAMP_TO_EDGE;
 964       const T: Cardinal = GL_CLAMP_TO_EDGE;
 965       const R: Cardinal = GL_CLAMP_TO_EDGE);
 966
 967     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 968     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 969
 970     //Constructors
 971     constructor Create; overload;
 972     constructor Create(const aFileName: String); overload;
 973     constructor Create(const aStream: TStream); overload;
 974     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 975     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 976     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 977     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 978   private
 979     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 980     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
 981
 982     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 983     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
 984
 985     function LoadBMP(const aStream: TStream): Boolean; virtual;
 986     procedure SaveBMP(const aStream: TStream); virtual;
 987
 988     function LoadTGA(const aStream: TStream): Boolean; virtual;
 989     procedure SaveTGA(const aStream: TStream); virtual;
 990
 991     function LoadDDS(const aStream: TStream): Boolean; virtual;
 992     procedure SaveDDS(const aStream: TStream); virtual;
 993   end;
 994
 995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 996   TglBitmap1D = class(TglBitmap)
 997   protected
 998     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 999       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1000     procedure UploadData(const aBuildWithGlu: Boolean);
1001   public
1002     property Width;
1003     procedure AfterConstruction; override;
1004     function FlipHorz: Boolean; override;
1005     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1006   end;
1007
1008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1009   TglBitmap2D = class(TglBitmap)
1010   protected
1011     // Bildeinstellungen
1012     fLines: array of PByte;
1013
1014     function GetScanline(const aIndex: Integer): Pointer;
1015     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1016       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1017     procedure UploadData(const aBuildWithGlu: Boolean);
1018   public
1019     property Width;
1020     property Height;
1021     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1022
1023     procedure AfterConstruction; override;
1024
1025     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1026     procedure GetDataFromTexture;
1027     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1028
1029     function FlipHorz: Boolean; override;
1030     function FlipVert: Boolean; override;
1031
1032     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1033       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1034   end;
1035
1036 (* TODO
1037   TglBitmapCubeMap = class(TglBitmap2D)
1038   protected
1039     fGenMode: Integer;
1040
1041     // Hide GenTexture
1042     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1043   public
1044     procedure AfterConstruction; override;
1045
1046     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1047
1048     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1049     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1050   end;
1051
1052
1053   TglBitmapNormalMap = class(TglBitmapCubeMap)
1054   public
1055     procedure AfterConstruction; override;
1056
1057     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1058   end;
1059
1060
1061
1062 *)
1063
1064 const
1065   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1066
1067 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1068 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1069 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1070 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1071 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1072 procedure glBitmapSetDefaultWrap(
1073   const S: Cardinal = GL_CLAMP_TO_EDGE;
1074   const T: Cardinal = GL_CLAMP_TO_EDGE;
1075   const R: Cardinal = GL_CLAMP_TO_EDGE);
1076
1077 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1078 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1079 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1080 function glBitmapGetDefaultFormat: TglBitmapFormat;
1081 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1082 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1083
1084 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1085 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1086 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1087
1088 var
1089   glBitmapDefaultDeleteTextureOnFree: Boolean;
1090   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1091   glBitmapDefaultFormat: TglBitmapFormat;
1092   glBitmapDefaultMipmap: TglBitmapMipMap;
1093   glBitmapDefaultFilterMin: Cardinal;
1094   glBitmapDefaultFilterMag: Cardinal;
1095   glBitmapDefaultWrapS: Cardinal;
1096   glBitmapDefaultWrapT: Cardinal;
1097   glBitmapDefaultWrapR: Cardinal;
1098
1099 {$IFDEF GLB_DELPHI}
1100 function CreateGrayPalette: HPALETTE;
1101 {$ENDIF}
1102
1103 implementation
1104
1105 uses
1106   Math, syncobjs, typinfo;
1107
1108 type
1109 {$IFNDEF fpc}
1110   QWord   = System.UInt64;
1111   PQWord  = ^QWord;
1112
1113   PtrInt  = Longint;
1114   PtrUInt = DWord;
1115 {$ENDIF}
1116
1117 ////////////////////////////////////////////////////////////////////////////////////////////////////
1118   TShiftRec = packed record
1119   case Integer of
1120     0: (r, g, b, a: Byte);
1121     1: (arr: array[0..3] of Byte);
1122   end;
1123
1124   TFormatDescriptor = class(TObject)
1125   private
1126     function GetRedMask: QWord;
1127     function GetGreenMask: QWord;
1128     function GetBlueMask: QWord;
1129     function GetAlphaMask: QWord;
1130   protected
1131     fFormat: TglBitmapFormat;
1132     fWithAlpha: TglBitmapFormat;
1133     fWithoutAlpha: TglBitmapFormat;
1134     fRGBInverted: TglBitmapFormat;
1135     fUncompressed: TglBitmapFormat;
1136     fPixelSize: Single;
1137     fIsCompressed: Boolean;
1138
1139     fRange: TglBitmapColorRec;
1140     fShift: TShiftRec;
1141
1142     fglFormat:         Cardinal;
1143     fglInternalFormat: Cardinal;
1144     fglDataFormat:     Cardinal;
1145
1146     function GetComponents: Integer; virtual;
1147   public
1148     property Format:       TglBitmapFormat read fFormat;
1149     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1150     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1151     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1152     property Components:   Integer         read GetComponents;
1153     property PixelSize:    Single          read fPixelSize;
1154     property IsCompressed: Boolean         read fIsCompressed;
1155
1156     property glFormat:         Cardinal read fglFormat;
1157     property glInternalFormat: Cardinal read fglInternalFormat;
1158     property glDataFormat:     Cardinal read fglDataFormat;
1159
1160     property Range: TglBitmapColorRec read fRange;
1161     property Shift: TShiftRec         read fShift;
1162
1163     property RedMask:   QWord read GetRedMask;
1164     property GreenMask: QWord read GetGreenMask;
1165     property BlueMask:  QWord read GetBlueMask;
1166     property AlphaMask: QWord read GetAlphaMask;
1167
1168     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1169     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1170
1171     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1172     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1173
1174     function CreateMappingData: Pointer; virtual;
1175     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1176
1177     function IsEmpty:  Boolean; virtual;
1178     function HasAlpha: Boolean; virtual;
1179     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1180
1181     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1182
1183     constructor Create; virtual;
1184   public
1185     class procedure Init;
1186     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1187     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1188     class procedure Clear;
1189     class procedure Finalize;
1190   end;
1191   TFormatDescriptorClass = class of TFormatDescriptor;
1192
1193   TfdEmpty = class(TFormatDescriptor);
1194
1195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1196   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1197     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1198     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1199     constructor Create; override;
1200   end;
1201
1202   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1203     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1204     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1205     constructor Create; override;
1206   end;
1207
1208   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1209     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1210     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1211     constructor Create; override;
1212   end;
1213
1214   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1215     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1216     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1217     constructor Create; override;
1218   end;
1219
1220   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1221     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1222     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1223     constructor Create; override;
1224   end;
1225
1226   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1227     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1228     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1229     constructor Create; override;
1230   end;
1231
1232   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1233     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1234     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1235     constructor Create; override;
1236   end;
1237
1238   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1239     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1240     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1241     constructor Create; override;
1242   end;
1243
1244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1245   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1246     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1247     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1248     constructor Create; override;
1249   end;
1250
1251   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1252     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1253     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1254     constructor Create; override;
1255   end;
1256
1257   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1258     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1259     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1260     constructor Create; override;
1261   end;
1262
1263   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1264     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1265     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1266     constructor Create; override;
1267   end;
1268
1269   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1270     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1271     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1272     constructor Create; override;
1273   end;
1274
1275   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1276     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1277     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1278     constructor Create; override;
1279   end;
1280
1281   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1282     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1283     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1284     constructor Create; override;
1285   end;
1286
1287   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1288     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1289     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1290     constructor Create; override;
1291   end;
1292
1293   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1294     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1295     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1296     constructor Create; override;
1297   end;
1298
1299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1300   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1301     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1302     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1303     constructor Create; override;
1304   end;
1305
1306   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1307     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1308     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1309     constructor Create; override;
1310   end;
1311
1312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1313   TfdAlpha4 = class(TfdAlpha_UB1)
1314     constructor Create; override;
1315   end;
1316
1317   TfdAlpha8 = class(TfdAlpha_UB1)
1318     constructor Create; override;
1319   end;
1320
1321   TfdAlpha12 = class(TfdAlpha_US1)
1322     constructor Create; override;
1323   end;
1324
1325   TfdAlpha16 = class(TfdAlpha_US1)
1326     constructor Create; override;
1327   end;
1328
1329   TfdLuminance4 = class(TfdLuminance_UB1)
1330     constructor Create; override;
1331   end;
1332
1333   TfdLuminance8 = class(TfdLuminance_UB1)
1334     constructor Create; override;
1335   end;
1336
1337   TfdLuminance12 = class(TfdLuminance_US1)
1338     constructor Create; override;
1339   end;
1340
1341   TfdLuminance16 = class(TfdLuminance_US1)
1342     constructor Create; override;
1343   end;
1344
1345   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1346     constructor Create; override;
1347   end;
1348
1349   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1350     constructor Create; override;
1351   end;
1352
1353   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1354     constructor Create; override;
1355   end;
1356
1357   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1358     constructor Create; override;
1359   end;
1360
1361   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1362     constructor Create; override;
1363   end;
1364
1365   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1366     constructor Create; override;
1367   end;
1368
1369   TfdR3G3B2 = class(TfdUniversal_UB1)
1370     constructor Create; override;
1371   end;
1372
1373   TfdRGB4 = class(TfdUniversal_US1)
1374     constructor Create; override;
1375   end;
1376
1377   TfdR5G6B5 = class(TfdUniversal_US1)
1378     constructor Create; override;
1379   end;
1380
1381   TfdRGB5 = class(TfdUniversal_US1)
1382     constructor Create; override;
1383   end;
1384
1385   TfdRGB8 = class(TfdRGB_UB3)
1386     constructor Create; override;
1387   end;
1388
1389   TfdRGB10 = class(TfdUniversal_UI1)
1390     constructor Create; override;
1391   end;
1392
1393   TfdRGB12 = class(TfdRGB_US3)
1394     constructor Create; override;
1395   end;
1396
1397   TfdRGB16 = class(TfdRGB_US3)
1398     constructor Create; override;
1399   end;
1400
1401   TfdRGBA2 = class(TfdRGBA_UB4)
1402     constructor Create; override;
1403   end;
1404
1405   TfdRGBA4 = class(TfdUniversal_US1)
1406     constructor Create; override;
1407   end;
1408
1409   TfdRGB5A1 = class(TfdUniversal_US1)
1410     constructor Create; override;
1411   end;
1412
1413   TfdRGBA8 = class(TfdRGBA_UB4)
1414     constructor Create; override;
1415   end;
1416
1417   TfdRGB10A2 = class(TfdUniversal_UI1)
1418     constructor Create; override;
1419   end;
1420
1421   TfdRGBA12 = class(TfdRGBA_US4)
1422     constructor Create; override;
1423   end;
1424
1425   TfdRGBA16 = class(TfdRGBA_US4)
1426     constructor Create; override;
1427   end;
1428
1429   TfdBGR4 = class(TfdUniversal_US1)
1430     constructor Create; override;
1431   end;
1432
1433   TfdB5G6R5 = class(TfdUniversal_US1)
1434     constructor Create; override;
1435   end;
1436
1437   TfdBGR5 = class(TfdUniversal_US1)
1438     constructor Create; override;
1439   end;
1440
1441   TfdBGR8 = class(TfdBGR_UB3)
1442     constructor Create; override;
1443   end;
1444
1445   TfdBGR10 = class(TfdUniversal_UI1)
1446     constructor Create; override;
1447   end;
1448
1449   TfdBGR12 = class(TfdBGR_US3)
1450     constructor Create; override;
1451   end;
1452
1453   TfdBGR16 = class(TfdBGR_US3)
1454     constructor Create; override;
1455   end;
1456
1457   TfdBGRA2 = class(TfdBGRA_UB4)
1458     constructor Create; override;
1459   end;
1460
1461   TfdBGRA4 = class(TfdUniversal_US1)
1462     constructor Create; override;
1463   end;
1464
1465   TfdBGR5A1 = class(TfdUniversal_US1)
1466     constructor Create; override;
1467   end;
1468
1469   TfdBGRA8 = class(TfdBGRA_UB4)
1470     constructor Create; override;
1471   end;
1472
1473   TfdBGR10A2 = class(TfdUniversal_UI1)
1474     constructor Create; override;
1475   end;
1476
1477   TfdBGRA12 = class(TfdBGRA_US4)
1478     constructor Create; override;
1479   end;
1480
1481   TfdBGRA16 = class(TfdBGRA_US4)
1482     constructor Create; override;
1483   end;
1484
1485   TfdDepth16 = class(TfdDepth_US1)
1486     constructor Create; override;
1487   end;
1488
1489   TfdDepth24 = class(TfdDepth_UI1)
1490     constructor Create; override;
1491   end;
1492
1493   TfdDepth32 = class(TfdDepth_UI1)
1494     constructor Create; override;
1495   end;
1496
1497   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1498     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1499     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1500     constructor Create; override;
1501   end;
1502
1503   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1504     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1505     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1506     constructor Create; override;
1507   end;
1508
1509   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1510     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1511     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1512     constructor Create; override;
1513   end;
1514
1515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1516   TbmpBitfieldFormat = class(TFormatDescriptor)
1517   private
1518     procedure SetRedMask  (const aValue: QWord);
1519     procedure SetGreenMask(const aValue: QWord);
1520     procedure SetBlueMask (const aValue: QWord);
1521     procedure SetAlphaMask(const aValue: QWord);
1522
1523     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1524   public
1525     property RedMask:   QWord read GetRedMask   write SetRedMask;
1526     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1527     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1528     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1529
1530     property PixelSize: Single read fPixelSize write fPixelSize;
1531
1532     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1533     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1534   end;
1535
1536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1537   TbmpColorTableEnty = packed record
1538     b, g, r, a: Byte;
1539   end;
1540   TbmpColorTable = array of TbmpColorTableEnty;
1541   TbmpColorTableFormat = class(TFormatDescriptor)
1542   private
1543     fColorTable: TbmpColorTable;
1544   public
1545     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1546     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1547     property Range:      TglBitmapColorRec read fRange      write fRange;
1548     property Shift:      TShiftRec         read fShift      write fShift;
1549     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1550
1551     procedure CreateColorTable;
1552
1553     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1554     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1555     destructor Destroy; override;
1556   end;
1557
1558 const
1559   LUMINANCE_WEIGHT_R = 0.30;
1560   LUMINANCE_WEIGHT_G = 0.59;
1561   LUMINANCE_WEIGHT_B = 0.11;
1562
1563   ALPHA_WEIGHT_R = 0.30;
1564   ALPHA_WEIGHT_G = 0.59;
1565   ALPHA_WEIGHT_B = 0.11;
1566
1567   DEPTH_WEIGHT_R = 0.333333333;
1568   DEPTH_WEIGHT_G = 0.333333333;
1569   DEPTH_WEIGHT_B = 0.333333333;
1570
1571   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1572
1573   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1574     TfdEmpty,
1575
1576     TfdAlpha4,
1577     TfdAlpha8,
1578     TfdAlpha12,
1579     TfdAlpha16,
1580
1581     TfdLuminance4,
1582     TfdLuminance8,
1583     TfdLuminance12,
1584     TfdLuminance16,
1585
1586     TfdLuminance4Alpha4,
1587     TfdLuminance6Alpha2,
1588     TfdLuminance8Alpha8,
1589     TfdLuminance12Alpha4,
1590     TfdLuminance12Alpha12,
1591     TfdLuminance16Alpha16,
1592
1593     TfdR3G3B2,
1594     TfdRGB4,
1595     TfdR5G6B5,
1596     TfdRGB5,
1597     TfdRGB8,
1598     TfdRGB10,
1599     TfdRGB12,
1600     TfdRGB16,
1601
1602     TfdRGBA2,
1603     TfdRGBA4,
1604     TfdRGB5A1,
1605     TfdRGBA8,
1606     TfdRGB10A2,
1607     TfdRGBA12,
1608     TfdRGBA16,
1609
1610     TfdBGR4,
1611     TfdB5G6R5,
1612     TfdBGR5,
1613     TfdBGR8,
1614     TfdBGR10,
1615     TfdBGR12,
1616     TfdBGR16,
1617
1618     TfdBGRA2,
1619     TfdBGRA4,
1620     TfdBGR5A1,
1621     TfdBGRA8,
1622     TfdBGR10A2,
1623     TfdBGRA12,
1624     TfdBGRA16,
1625
1626     TfdDepth16,
1627     TfdDepth24,
1628     TfdDepth32,
1629
1630     TfdS3tcDtx1RGBA,
1631     TfdS3tcDtx3RGBA,
1632     TfdS3tcDtx5RGBA
1633   );
1634
1635 var
1636   FormatDescriptorCS: TCriticalSection;
1637   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1638
1639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1640 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1641 begin
1642   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1643 end;
1644
1645 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1646 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1647 begin
1648   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1649 end;
1650
1651 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1652 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1653 begin
1654   result.Fields := [];
1655
1656   if X >= 0 then
1657     result.Fields := result.Fields + [ffX];
1658   if Y >= 0 then
1659     result.Fields := result.Fields + [ffY];
1660
1661   result.X := Max(0, X);
1662   result.Y := Max(0, Y);
1663 end;
1664
1665 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1666 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1667 begin
1668   result.r := r;
1669   result.g := g;
1670   result.b := b;
1671   result.a := a;
1672 end;
1673
1674 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1675 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1676 var
1677   i: Integer;
1678 begin
1679   result := false;
1680   for i := 0 to high(r1.arr) do
1681     if (r1.arr[i] <> r2.arr[i]) then
1682       exit;
1683   result := true;
1684 end;
1685
1686 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1687 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1688 begin
1689   result.r := r;
1690   result.g := g;
1691   result.b := b;
1692   result.a := a;
1693 end;
1694
1695 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1696 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1697 begin
1698   result := [];
1699
1700   if (aFormat in [
1701         //4 bbp
1702         tfLuminance4,
1703
1704         //8bpp
1705         tfR3G3B2, tfLuminance8,
1706
1707         //16bpp
1708         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1709         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1710
1711         //24bpp
1712         tfBGR8, tfRGB8,
1713
1714         //32bpp
1715         tfRGB10, tfRGB10A2, tfRGBA8,
1716         tfBGR10, tfBGR10A2, tfBGRA8]) then
1717     result := result + [ftBMP];
1718
1719   if (aFormat in [
1720         //8 bpp
1721         tfLuminance8, tfAlpha8,
1722
1723         //16 bpp
1724         tfLuminance16, tfLuminance8Alpha8,
1725         tfRGB5, tfRGB5A1, tfRGBA4,
1726         tfBGR5, tfBGR5A1, tfBGRA4,
1727
1728         //24 bpp
1729         tfRGB8, tfBGR8,
1730
1731         //32 bpp
1732         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1733     result := result + [ftTGA];
1734
1735   if (aFormat in [
1736         //8 bpp
1737         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1738         tfR3G3B2, tfRGBA2, tfBGRA2,
1739
1740         //16 bpp
1741         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1742         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1743         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1744
1745         //24 bpp
1746         tfRGB8, tfBGR8,
1747
1748         //32 bbp
1749         tfLuminance16Alpha16,
1750         tfRGBA8, tfRGB10A2,
1751         tfBGRA8, tfBGR10A2,
1752
1753         //compressed
1754         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1755     result := result + [ftDDS];
1756
1757   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1758   if aFormat in [
1759       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1760       tfRGB8, tfRGBA8,
1761       tfBGR8, tfBGRA8] then
1762     result := result + [ftPNG];
1763   {$ENDIF}
1764
1765   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1766   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1767     result := result + [ftJPEG];
1768   {$ENDIF}
1769 end;
1770
1771 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1772 function IsPowerOfTwo(aNumber: Integer): Boolean;
1773 begin
1774   while (aNumber and 1) = 0 do
1775     aNumber := aNumber shr 1;
1776   result := aNumber = 1;
1777 end;
1778
1779 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1780 function GetTopMostBit(aBitSet: QWord): Integer;
1781 begin
1782   result := 0;
1783   while aBitSet > 0 do begin
1784     inc(result);
1785     aBitSet := aBitSet shr 1;
1786   end;
1787 end;
1788
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function CountSetBits(aBitSet: QWord): Integer;
1791 begin
1792   result := 0;
1793   while aBitSet > 0 do begin
1794     if (aBitSet and 1) = 1 then
1795       inc(result);
1796     aBitSet := aBitSet shr 1;
1797   end;
1798 end;
1799
1800 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1801 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1802 begin
1803   result := Trunc(
1804     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1805     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1806     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1807 end;
1808
1809 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1810 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1811 begin
1812   result := Trunc(
1813     DEPTH_WEIGHT_R * aPixel.Data.r +
1814     DEPTH_WEIGHT_G * aPixel.Data.g +
1815     DEPTH_WEIGHT_B * aPixel.Data.b);
1816 end;
1817
1818 {$IFDEF GLB_NATIVE_OGL}
1819 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1820 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1821 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1822 var
1823   GL_LibHandle: Pointer = nil;
1824
1825 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1826 begin
1827   if not Assigned(aLibHandle) then
1828     aLibHandle := GL_LibHandle;
1829
1830 {$IF DEFINED(GLB_WIN)}
1831   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1832   if Assigned(result) then
1833     exit;
1834
1835   if Assigned(wglGetProcAddress) then
1836     result := wglGetProcAddress(aProcName);
1837 {$ELSEIF DEFINED(GLB_LINUX)}
1838   if Assigned(glXGetProcAddress) then begin
1839     result := glXGetProcAddress(aProcName);
1840     if Assigned(result) then
1841       exit;
1842   end;
1843
1844   if Assigned(glXGetProcAddressARB) then begin
1845     result := glXGetProcAddressARB(aProcName);
1846     if Assigned(result) then
1847       exit;
1848   end;
1849
1850   result := dlsym(aLibHandle, aProcName);
1851 {$IFEND}
1852   if not Assigned(result) then
1853     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1854 end;
1855
1856 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1857 var
1858   GLU_LibHandle: Pointer = nil;
1859   OpenGLInitialized: Boolean;
1860   InitOpenGLCS: TCriticalSection;
1861
1862 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1863 procedure glbInitOpenGL;
1864
1865   ////////////////////////////////////////////////////////////////////////////////
1866   function glbLoadLibrary(const aName: PChar): Pointer;
1867   begin
1868     {$IF DEFINED(GLB_WIN)}
1869     result := {%H-}Pointer(LoadLibrary(aName));
1870     {$ELSEIF DEFINED(GLB_LINUX)}
1871     result := dlopen(Name, RTLD_LAZY);
1872     {$ELSE}
1873     result := nil;
1874     {$IFEND}
1875   end;
1876
1877   ////////////////////////////////////////////////////////////////////////////////
1878   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1879   begin
1880     result := false;
1881     if not Assigned(aLibHandle) then
1882       exit;
1883
1884     {$IF DEFINED(GLB_WIN)}
1885     Result := FreeLibrary({%H-}HINST(aLibHandle));
1886     {$ELSEIF DEFINED(GLB_LINUX)}
1887     Result := dlclose(aLibHandle) = 0;
1888     {$IFEND}
1889   end;
1890
1891 begin
1892   if Assigned(GL_LibHandle) then
1893     glbFreeLibrary(GL_LibHandle);
1894
1895   if Assigned(GLU_LibHandle) then
1896     glbFreeLibrary(GLU_LibHandle);
1897
1898   GL_LibHandle := glbLoadLibrary(libopengl);
1899   if not Assigned(GL_LibHandle) then
1900     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1901
1902   GLU_LibHandle := glbLoadLibrary(libglu);
1903   if not Assigned(GLU_LibHandle) then
1904     raise EglBitmapException.Create('unable to load library: ' + libglu);
1905
1906   try
1907   {$IF DEFINED(GLB_WIN)}
1908     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1909   {$ELSEIF DEFINED(GLB_LINUX)}
1910     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1911     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
1912   {$IFEND}
1913
1914     glEnable := glbGetProcAddress('glEnable');
1915     glDisable := glbGetProcAddress('glDisable');
1916     glGetString := glbGetProcAddress('glGetString');
1917     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1918     glTexParameteri := glbGetProcAddress('glTexParameteri');
1919     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1920     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1921     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1922     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1923     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1924     glGenTextures := glbGetProcAddress('glGenTextures');
1925     glBindTexture := glbGetProcAddress('glBindTexture');
1926     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1927     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1928     glReadPixels := glbGetProcAddress('glReadPixels');
1929     glPixelStorei := glbGetProcAddress('glPixelStorei');
1930     glTexImage1D := glbGetProcAddress('glTexImage1D');
1931     glTexImage2D := glbGetProcAddress('glTexImage2D');
1932     glGetTexImage := glbGetProcAddress('glGetTexImage');
1933
1934     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1935     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1936   finally
1937     glbFreeLibrary(GL_LibHandle);
1938     glbFreeLibrary(GLU_LibHandle);
1939   end;
1940 end;
1941 {$ENDIF}
1942
1943 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1944 procedure glbReadOpenGLExtensions;
1945 var
1946   Buffer: AnsiString;
1947   MajorVersion, MinorVersion: Integer;
1948
1949   ///////////////////////////////////////////////////////////////////////////////////////////
1950   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1951   var
1952     Separator: Integer;
1953   begin
1954     aMinor := 0;
1955     aMajor := 0;
1956
1957     Separator := Pos(AnsiString('.'), aBuffer);
1958     if (Separator > 1) and (Separator < Length(aBuffer)) and
1959        (aBuffer[Separator - 1] in ['0'..'9']) and
1960        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1961
1962       Dec(Separator);
1963       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1964         Dec(Separator);
1965
1966       Delete(aBuffer, 1, Separator);
1967       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1968
1969       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1970         Inc(Separator);
1971
1972       Delete(aBuffer, Separator, 255);
1973       Separator := Pos(AnsiString('.'), aBuffer);
1974
1975       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1976       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
1977     end;
1978   end;
1979
1980   ///////////////////////////////////////////////////////////////////////////////////////////
1981   function CheckExtension(const Extension: AnsiString): Boolean;
1982   var
1983     ExtPos: Integer;
1984   begin
1985     ExtPos := Pos(Extension, Buffer);
1986     result := ExtPos > 0;
1987     if result then
1988       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1989   end;
1990
1991 begin
1992 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1993   InitOpenGLCS.Enter;
1994   try
1995     if not OpenGLInitialized then begin
1996       glbInitOpenGL;
1997       OpenGLInitialized := true;
1998     end;
1999   finally
2000     InitOpenGLCS.Leave;
2001   end;
2002 {$ENDIF}
2003
2004   // Version
2005   Buffer := glGetString(GL_VERSION);
2006   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2007
2008   GL_VERSION_1_2 := false;
2009   GL_VERSION_1_3 := false;
2010   GL_VERSION_1_4 := false;
2011   GL_VERSION_2_0 := false;
2012   if MajorVersion = 1 then begin
2013     if MinorVersion >= 2 then
2014       GL_VERSION_1_2 := true;
2015
2016     if MinorVersion >= 3 then
2017       GL_VERSION_1_3 := true;
2018
2019     if MinorVersion >= 4 then
2020       GL_VERSION_1_4 := true;
2021   end else if MajorVersion >= 2 then begin
2022     GL_VERSION_1_2 := true;
2023     GL_VERSION_1_3 := true;
2024     GL_VERSION_1_4 := true;
2025     GL_VERSION_2_0 := true;
2026   end;
2027
2028   // Extensions
2029   Buffer := glGetString(GL_EXTENSIONS);
2030   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2031   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2032   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2033   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2034   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2035   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2036   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2037   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2038   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2039   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2040
2041   if GL_VERSION_1_3 then begin
2042     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2043     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2044     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2045   end else begin
2046     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2047     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2048     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2049   end;
2050 end;
2051 {$ENDIF}
2052
2053 {$IFDEF GLB_SDL_IMAGE}
2054 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2055 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2057 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2058 begin
2059   result := TStream(context^.unknown.data1).Seek(offset, whence);
2060 end;
2061
2062 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2063 begin
2064   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2065 end;
2066
2067 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2068 begin
2069   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2070 end;
2071
2072 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2073 begin
2074   result := 0;
2075 end;
2076
2077 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2078 begin
2079   result := SDL_AllocRW;
2080
2081   if result = nil then
2082     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2083
2084   result^.seek := glBitmapRWseek;
2085   result^.read := glBitmapRWread;
2086   result^.write := glBitmapRWwrite;
2087   result^.close := glBitmapRWclose;
2088   result^.unknown.data1 := Stream;
2089 end;
2090 {$ENDIF}
2091
2092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2093 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2094 begin
2095   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2096 end;
2097
2098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2099 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2100 begin
2101   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2102 end;
2103
2104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2105 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2106 begin
2107   glBitmapDefaultMipmap := aValue;
2108 end;
2109
2110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2111 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2112 begin
2113   glBitmapDefaultFormat := aFormat;
2114 end;
2115
2116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2117 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2118 begin
2119   glBitmapDefaultFilterMin := aMin;
2120   glBitmapDefaultFilterMag := aMag;
2121 end;
2122
2123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2124 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2125 begin
2126   glBitmapDefaultWrapS := S;
2127   glBitmapDefaultWrapT := T;
2128   glBitmapDefaultWrapR := R;
2129 end;
2130
2131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2132 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2133 begin
2134   result := glBitmapDefaultDeleteTextureOnFree;
2135 end;
2136
2137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2138 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2139 begin
2140   result := glBitmapDefaultFreeDataAfterGenTextures;
2141 end;
2142
2143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2144 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2145 begin
2146   result := glBitmapDefaultMipmap;
2147 end;
2148
2149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2150 function glBitmapGetDefaultFormat: TglBitmapFormat;
2151 begin
2152   result := glBitmapDefaultFormat;
2153 end;
2154
2155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2156 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2157 begin
2158   aMin := glBitmapDefaultFilterMin;
2159   aMag := glBitmapDefaultFilterMag;
2160 end;
2161
2162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2163 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2164 begin
2165   S := glBitmapDefaultWrapS;
2166   T := glBitmapDefaultWrapT;
2167   R := glBitmapDefaultWrapR;
2168 end;
2169
2170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2171 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 function TFormatDescriptor.GetRedMask: QWord;
2174 begin
2175   result := fRange.r shl fShift.r;
2176 end;
2177
2178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 function TFormatDescriptor.GetGreenMask: QWord;
2180 begin
2181   result := fRange.g shl fShift.g;
2182 end;
2183
2184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 function TFormatDescriptor.GetBlueMask: QWord;
2186 begin
2187   result := fRange.b shl fShift.b;
2188 end;
2189
2190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2191 function TFormatDescriptor.GetAlphaMask: QWord;
2192 begin
2193   result := fRange.a shl fShift.a;
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 function TFormatDescriptor.GetComponents: Integer;
2198 var
2199   i: Integer;
2200 begin
2201   result := 0;
2202   for i := 0 to 3 do
2203     if (fRange.arr[i] > 0) then
2204       inc(result);
2205 end;
2206
2207 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2209 var
2210   w, h: Integer;
2211 begin
2212   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2213     w := Max(1, aSize.X);
2214     h := Max(1, aSize.Y);
2215     result := GetSize(w, h);
2216   end else
2217     result := 0;
2218 end;
2219
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2222 begin
2223   result := 0;
2224   if (aWidth <= 0) or (aHeight <= 0) then
2225     exit;
2226   result := Ceil(aWidth * aHeight * fPixelSize);
2227 end;
2228
2229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2230 function TFormatDescriptor.CreateMappingData: Pointer;
2231 begin
2232   result := nil;
2233 end;
2234
2235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2236 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2237 begin
2238   //DUMMY
2239 end;
2240
2241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2242 function TFormatDescriptor.IsEmpty: Boolean;
2243 begin
2244   result := (fFormat = tfEmpty);
2245 end;
2246
2247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 function TFormatDescriptor.HasAlpha: Boolean;
2249 begin
2250   result := (fRange.a > 0);
2251 end;
2252
2253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2254 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2255 begin
2256   result := false;
2257   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2258     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2259   if (aRedMask   <> RedMask) then
2260     exit;
2261   if (aGreenMask <> GreenMask) then
2262     exit;
2263   if (aBlueMask  <> BlueMask) then
2264     exit;
2265   if (aAlphaMask <> AlphaMask) then
2266     exit;
2267   result := true;
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2272 begin
2273   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2274   aPixel.Data   := fRange;
2275   aPixel.Range  := fRange;
2276   aPixel.Format := fFormat;
2277 end;
2278
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 constructor TFormatDescriptor.Create;
2281 begin
2282   inherited Create;
2283
2284   fFormat       := tfEmpty;
2285   fWithAlpha    := tfEmpty;
2286   fWithoutAlpha := tfEmpty;
2287   fRGBInverted  := tfEmpty;
2288   fUncompressed := tfEmpty;
2289   fPixelSize    := 0.0;
2290   fIsCompressed := false;
2291
2292   fglFormat         := 0;
2293   fglInternalFormat := 0;
2294   fglDataFormat     := 0;
2295
2296   FillChar(fRange, 0, SizeOf(fRange));
2297   FillChar(fShift, 0, SizeOf(fShift));
2298 end;
2299
2300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2301 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2304 begin
2305   aData^ := aPixel.Data.a;
2306   inc(aData);
2307 end;
2308
2309 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2310 begin
2311   aPixel.Data.r := 0;
2312   aPixel.Data.g := 0;
2313   aPixel.Data.b := 0;
2314   aPixel.Data.a := aData^;
2315   inc(aData);
2316 end;
2317
2318 constructor TfdAlpha_UB1.Create;
2319 begin
2320   inherited Create;
2321   fPixelSize        := 1.0;
2322   fRange.a          := $FF;
2323   fglFormat         := GL_ALPHA;
2324   fglDataFormat     := GL_UNSIGNED_BYTE;
2325 end;
2326
2327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2328 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2331 begin
2332   aData^ := LuminanceWeight(aPixel);
2333   inc(aData);
2334 end;
2335
2336 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2337 begin
2338   aPixel.Data.r := aData^;
2339   aPixel.Data.g := aData^;
2340   aPixel.Data.b := aData^;
2341   aPixel.Data.a := 0;
2342   inc(aData);
2343 end;
2344
2345 constructor TfdLuminance_UB1.Create;
2346 begin
2347   inherited Create;
2348   fPixelSize        := 1.0;
2349   fRange.r          := $FF;
2350   fRange.g          := $FF;
2351   fRange.b          := $FF;
2352   fglFormat         := GL_LUMINANCE;
2353   fglDataFormat     := GL_UNSIGNED_BYTE;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2360 var
2361   i: Integer;
2362 begin
2363   aData^ := 0;
2364   for i := 0 to 3 do
2365     if (fRange.arr[i] > 0) then
2366       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2367   inc(aData);
2368 end;
2369
2370 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2371 var
2372   i: Integer;
2373 begin
2374   for i := 0 to 3 do
2375     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2376   inc(aData);
2377 end;
2378
2379 constructor TfdUniversal_UB1.Create;
2380 begin
2381   inherited Create;
2382   fPixelSize := 1.0;
2383 end;
2384
2385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2388 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2389 begin
2390   inherited Map(aPixel, aData, aMapData);
2391   aData^ := aPixel.Data.a;
2392   inc(aData);
2393 end;
2394
2395 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2396 begin
2397   inherited Unmap(aData, aPixel, aMapData);
2398   aPixel.Data.a := aData^;
2399   inc(aData);
2400 end;
2401
2402 constructor TfdLuminanceAlpha_UB2.Create;
2403 begin
2404   inherited Create;
2405   fPixelSize        := 2.0;
2406   fRange.a          := $FF;
2407   fShift.a          :=   8;
2408   fglFormat         := GL_LUMINANCE_ALPHA;
2409   fglDataFormat     := GL_UNSIGNED_BYTE;
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2415 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2416 begin
2417   aData^ := aPixel.Data.r;
2418   inc(aData);
2419   aData^ := aPixel.Data.g;
2420   inc(aData);
2421   aData^ := aPixel.Data.b;
2422   inc(aData);
2423 end;
2424
2425 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2426 begin
2427   aPixel.Data.r := aData^;
2428   inc(aData);
2429   aPixel.Data.g := aData^;
2430   inc(aData);
2431   aPixel.Data.b := aData^;
2432   inc(aData);
2433   aPixel.Data.a := 0;
2434 end;
2435
2436 constructor TfdRGB_UB3.Create;
2437 begin
2438   inherited Create;
2439   fPixelSize        := 3.0;
2440   fRange.r          := $FF;
2441   fRange.g          := $FF;
2442   fRange.b          := $FF;
2443   fShift.r          :=   0;
2444   fShift.g          :=   8;
2445   fShift.b          :=  16;
2446   fglFormat         := GL_RGB;
2447   fglDataFormat     := GL_UNSIGNED_BYTE;
2448 end;
2449
2450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2451 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2454 begin
2455   aData^ := aPixel.Data.b;
2456   inc(aData);
2457   aData^ := aPixel.Data.g;
2458   inc(aData);
2459   aData^ := aPixel.Data.r;
2460   inc(aData);
2461 end;
2462
2463 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2464 begin
2465   aPixel.Data.b := aData^;
2466   inc(aData);
2467   aPixel.Data.g := aData^;
2468   inc(aData);
2469   aPixel.Data.r := aData^;
2470   inc(aData);
2471   aPixel.Data.a := 0;
2472 end;
2473
2474 constructor TfdBGR_UB3.Create;
2475 begin
2476   fPixelSize        := 3.0;
2477   fRange.r          := $FF;
2478   fRange.g          := $FF;
2479   fRange.b          := $FF;
2480   fShift.r          :=  16;
2481   fShift.g          :=   8;
2482   fShift.b          :=   0;
2483   fglFormat         := GL_BGR;
2484   fglDataFormat     := GL_UNSIGNED_BYTE;
2485 end;
2486
2487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2491 begin
2492   inherited Map(aPixel, aData, aMapData);
2493   aData^ := aPixel.Data.a;
2494   inc(aData);
2495 end;
2496
2497 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2498 begin
2499   inherited Unmap(aData, aPixel, aMapData);
2500   aPixel.Data.a := aData^;
2501   inc(aData);
2502 end;
2503
2504 constructor TfdRGBA_UB4.Create;
2505 begin
2506   inherited Create;
2507   fPixelSize        := 4.0;
2508   fRange.a          := $FF;
2509   fShift.a          :=  24;
2510   fglFormat         := GL_RGBA;
2511   fglDataFormat     := GL_UNSIGNED_BYTE;
2512 end;
2513
2514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2515 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2518 begin
2519   inherited Map(aPixel, aData, aMapData);
2520   aData^ := aPixel.Data.a;
2521   inc(aData);
2522 end;
2523
2524 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2525 begin
2526   inherited Unmap(aData, aPixel, aMapData);
2527   aPixel.Data.a := aData^;
2528   inc(aData);
2529 end;
2530
2531 constructor TfdBGRA_UB4.Create;
2532 begin
2533   inherited Create;
2534   fPixelSize        := 4.0;
2535   fRange.a          := $FF;
2536   fShift.a          :=  24;
2537   fglFormat         := GL_BGRA;
2538   fglDataFormat     := GL_UNSIGNED_BYTE;
2539 end;
2540
2541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2542 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2544 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2545 begin
2546   PWord(aData)^ := aPixel.Data.a;
2547   inc(aData, 2);
2548 end;
2549
2550 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2551 begin
2552   aPixel.Data.r := 0;
2553   aPixel.Data.g := 0;
2554   aPixel.Data.b := 0;
2555   aPixel.Data.a := PWord(aData)^;
2556   inc(aData, 2);
2557 end;
2558
2559 constructor TfdAlpha_US1.Create;
2560 begin
2561   inherited Create;
2562   fPixelSize        := 2.0;
2563   fRange.a          := $FFFF;
2564   fglFormat         := GL_ALPHA;
2565   fglDataFormat     := GL_UNSIGNED_SHORT;
2566 end;
2567
2568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2569 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2572 begin
2573   PWord(aData)^ := LuminanceWeight(aPixel);
2574   inc(aData, 2);
2575 end;
2576
2577 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2578 begin
2579   aPixel.Data.r := PWord(aData)^;
2580   aPixel.Data.g := PWord(aData)^;
2581   aPixel.Data.b := PWord(aData)^;
2582   aPixel.Data.a := 0;
2583   inc(aData, 2);
2584 end;
2585
2586 constructor TfdLuminance_US1.Create;
2587 begin
2588   inherited Create;
2589   fPixelSize        := 2.0;
2590   fRange.r          := $FFFF;
2591   fRange.g          := $FFFF;
2592   fRange.b          := $FFFF;
2593   fglFormat         := GL_LUMINANCE;
2594   fglDataFormat     := GL_UNSIGNED_SHORT;
2595 end;
2596
2597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2601 var
2602   i: Integer;
2603 begin
2604   PWord(aData)^ := 0;
2605   for i := 0 to 3 do
2606     if (fRange.arr[i] > 0) then
2607       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2608   inc(aData, 2);
2609 end;
2610
2611 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2612 var
2613   i: Integer;
2614 begin
2615   for i := 0 to 3 do
2616     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2617   inc(aData, 2);
2618 end;
2619
2620 constructor TfdUniversal_US1.Create;
2621 begin
2622   inherited Create;
2623   fPixelSize := 2.0;
2624 end;
2625
2626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2627 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2629 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2630 begin
2631   PWord(aData)^ := DepthWeight(aPixel);
2632   inc(aData, 2);
2633 end;
2634
2635 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2636 begin
2637   aPixel.Data.r := PWord(aData)^;
2638   aPixel.Data.g := PWord(aData)^;
2639   aPixel.Data.b := PWord(aData)^;
2640   aPixel.Data.a := 0;
2641   inc(aData, 2);
2642 end;
2643
2644 constructor TfdDepth_US1.Create;
2645 begin
2646   inherited Create;
2647   fPixelSize        := 2.0;
2648   fRange.r          := $FFFF;
2649   fRange.g          := $FFFF;
2650   fRange.b          := $FFFF;
2651   fglFormat         := GL_DEPTH_COMPONENT;
2652   fglDataFormat     := GL_UNSIGNED_SHORT;
2653 end;
2654
2655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2656 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2658 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2659 begin
2660   inherited Map(aPixel, aData, aMapData);
2661   PWord(aData)^ := aPixel.Data.a;
2662   inc(aData, 2);
2663 end;
2664
2665 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2666 begin
2667   inherited Unmap(aData, aPixel, aMapData);
2668   aPixel.Data.a := PWord(aData)^;
2669   inc(aData, 2);
2670 end;
2671
2672 constructor TfdLuminanceAlpha_US2.Create;
2673 begin
2674   inherited Create;
2675   fPixelSize        :=   4.0;
2676   fRange.a          := $FFFF;
2677   fShift.a          :=    16;
2678   fglFormat         := GL_LUMINANCE_ALPHA;
2679   fglDataFormat     := GL_UNSIGNED_SHORT;
2680 end;
2681
2682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2683 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2685 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2686 begin
2687   PWord(aData)^ := aPixel.Data.r;
2688   inc(aData, 2);
2689   PWord(aData)^ := aPixel.Data.g;
2690   inc(aData, 2);
2691   PWord(aData)^ := aPixel.Data.b;
2692   inc(aData, 2);
2693 end;
2694
2695 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2696 begin
2697   aPixel.Data.r := PWord(aData)^;
2698   inc(aData, 2);
2699   aPixel.Data.g := PWord(aData)^;
2700   inc(aData, 2);
2701   aPixel.Data.b := PWord(aData)^;
2702   inc(aData, 2);
2703   aPixel.Data.a := 0;
2704 end;
2705
2706 constructor TfdRGB_US3.Create;
2707 begin
2708   inherited Create;
2709   fPixelSize        :=   6.0;
2710   fRange.r          := $FFFF;
2711   fRange.g          := $FFFF;
2712   fRange.b          := $FFFF;
2713   fShift.r          :=     0;
2714   fShift.g          :=    16;
2715   fShift.b          :=    32;
2716   fglFormat         := GL_RGB;
2717   fglDataFormat     := GL_UNSIGNED_SHORT;
2718 end;
2719
2720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2721 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2723 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2724 begin
2725   PWord(aData)^ := aPixel.Data.b;
2726   inc(aData, 2);
2727   PWord(aData)^ := aPixel.Data.g;
2728   inc(aData, 2);
2729   PWord(aData)^ := aPixel.Data.r;
2730   inc(aData, 2);
2731 end;
2732
2733 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2734 begin
2735   aPixel.Data.b := PWord(aData)^;
2736   inc(aData, 2);
2737   aPixel.Data.g := PWord(aData)^;
2738   inc(aData, 2);
2739   aPixel.Data.r := PWord(aData)^;
2740   inc(aData, 2);
2741   aPixel.Data.a := 0;
2742 end;
2743
2744 constructor TfdBGR_US3.Create;
2745 begin
2746   inherited Create;
2747   fPixelSize        :=   6.0;
2748   fRange.r          := $FFFF;
2749   fRange.g          := $FFFF;
2750   fRange.b          := $FFFF;
2751   fShift.r          :=    32;
2752   fShift.g          :=    16;
2753   fShift.b          :=     0;
2754   fglFormat         := GL_BGR;
2755   fglDataFormat     := GL_UNSIGNED_SHORT;
2756 end;
2757
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2762 begin
2763   inherited Map(aPixel, aData, aMapData);
2764   PWord(aData)^ := aPixel.Data.a;
2765   inc(aData, 2);
2766 end;
2767
2768 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2769 begin
2770   inherited Unmap(aData, aPixel, aMapData);
2771   aPixel.Data.a := PWord(aData)^;
2772   inc(aData, 2);
2773 end;
2774
2775 constructor TfdRGBA_US4.Create;
2776 begin
2777   inherited Create;
2778   fPixelSize        :=   8.0;
2779   fRange.a          := $FFFF;
2780   fShift.a          :=    48;
2781   fglFormat         := GL_RGBA;
2782   fglDataFormat     := GL_UNSIGNED_SHORT;
2783 end;
2784
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2789 begin
2790   inherited Map(aPixel, aData, aMapData);
2791   PWord(aData)^ := aPixel.Data.a;
2792   inc(aData, 2);
2793 end;
2794
2795 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2796 begin
2797   inherited Unmap(aData, aPixel, aMapData);
2798   aPixel.Data.a := PWord(aData)^;
2799   inc(aData, 2);
2800 end;
2801
2802 constructor TfdBGRA_US4.Create;
2803 begin
2804   inherited Create;
2805   fPixelSize        :=   8.0;
2806   fRange.a          := $FFFF;
2807   fShift.a          :=    48;
2808   fglFormat         := GL_BGRA;
2809   fglDataFormat     := GL_UNSIGNED_SHORT;
2810 end;
2811
2812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2813 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2816 var
2817   i: Integer;
2818 begin
2819   PCardinal(aData)^ := 0;
2820   for i := 0 to 3 do
2821     if (fRange.arr[i] > 0) then
2822       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2823   inc(aData, 4);
2824 end;
2825
2826 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2827 var
2828   i: Integer;
2829 begin
2830   for i := 0 to 3 do
2831     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2832   inc(aData, 2);
2833 end;
2834
2835 constructor TfdUniversal_UI1.Create;
2836 begin
2837   inherited Create;
2838   fPixelSize := 4.0;
2839 end;
2840
2841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2844 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2845 begin
2846   PCardinal(aData)^ := DepthWeight(aPixel);
2847   inc(aData, 4);
2848 end;
2849
2850 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2851 begin
2852   aPixel.Data.r := PCardinal(aData)^;
2853   aPixel.Data.g := PCardinal(aData)^;
2854   aPixel.Data.b := PCardinal(aData)^;
2855   aPixel.Data.a := 0;
2856   inc(aData, 4);
2857 end;
2858
2859 constructor TfdDepth_UI1.Create;
2860 begin
2861   inherited Create;
2862   fPixelSize        := 4.0;
2863   fRange.r          := $FFFFFFFF;
2864   fRange.g          := $FFFFFFFF;
2865   fRange.b          := $FFFFFFFF;
2866   fglFormat         := GL_DEPTH_COMPONENT;
2867   fglDataFormat     := GL_UNSIGNED_INT;
2868 end;
2869
2870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 constructor TfdAlpha4.Create;
2874 begin
2875   inherited Create;
2876   fFormat           := tfAlpha4;
2877   fWithAlpha        := tfAlpha4;
2878   fglInternalFormat := GL_ALPHA4;
2879 end;
2880
2881 constructor TfdAlpha8.Create;
2882 begin
2883   inherited Create;
2884   fFormat           := tfAlpha8;
2885   fWithAlpha        := tfAlpha8;
2886   fglInternalFormat := GL_ALPHA8;
2887 end;
2888
2889 constructor TfdAlpha12.Create;
2890 begin
2891   inherited Create;
2892   fFormat           := tfAlpha12;
2893   fWithAlpha        := tfAlpha12;
2894   fglInternalFormat := GL_ALPHA12;
2895 end;
2896
2897 constructor TfdAlpha16.Create;
2898 begin
2899   inherited Create;
2900   fFormat           := tfAlpha16;
2901   fWithAlpha        := tfAlpha16;
2902   fglInternalFormat := GL_ALPHA16;
2903 end;
2904
2905 constructor TfdLuminance4.Create;
2906 begin
2907   inherited Create;
2908   fFormat           := tfLuminance4;
2909   fWithAlpha        := tfLuminance4Alpha4;
2910   fWithoutAlpha     := tfLuminance4;
2911   fglInternalFormat := GL_LUMINANCE4;
2912 end;
2913
2914 constructor TfdLuminance8.Create;
2915 begin
2916   inherited Create;
2917   fFormat           := tfLuminance8;
2918   fWithAlpha        := tfLuminance8Alpha8;
2919   fWithoutAlpha     := tfLuminance8;
2920   fglInternalFormat := GL_LUMINANCE8;
2921 end;
2922
2923 constructor TfdLuminance12.Create;
2924 begin
2925   inherited Create;
2926   fFormat           := tfLuminance12;
2927   fWithAlpha        := tfLuminance12Alpha12;
2928   fWithoutAlpha     := tfLuminance12;
2929   fglInternalFormat := GL_LUMINANCE12;
2930 end;
2931
2932 constructor TfdLuminance16.Create;
2933 begin
2934   inherited Create;
2935   fFormat           := tfLuminance16;
2936   fWithAlpha        := tfLuminance16Alpha16;
2937   fWithoutAlpha     := tfLuminance16;
2938   fglInternalFormat := GL_LUMINANCE16;
2939 end;
2940
2941 constructor TfdLuminance4Alpha4.Create;
2942 begin
2943   inherited Create;
2944   fFormat           := tfLuminance4Alpha4;
2945   fWithAlpha        := tfLuminance4Alpha4;
2946   fWithoutAlpha     := tfLuminance4;
2947   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2948 end;
2949
2950 constructor TfdLuminance6Alpha2.Create;
2951 begin
2952   inherited Create;
2953   fFormat           := tfLuminance6Alpha2;
2954   fWithAlpha        := tfLuminance6Alpha2;
2955   fWithoutAlpha     := tfLuminance8;
2956   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2957 end;
2958
2959 constructor TfdLuminance8Alpha8.Create;
2960 begin
2961   inherited Create;
2962   fFormat           := tfLuminance8Alpha8;
2963   fWithAlpha        := tfLuminance8Alpha8;
2964   fWithoutAlpha     := tfLuminance8;
2965   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
2966 end;
2967
2968 constructor TfdLuminance12Alpha4.Create;
2969 begin
2970   inherited Create;
2971   fFormat           := tfLuminance12Alpha4;
2972   fWithAlpha        := tfLuminance12Alpha4;
2973   fWithoutAlpha     := tfLuminance12;
2974   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2975 end;
2976
2977 constructor TfdLuminance12Alpha12.Create;
2978 begin
2979   inherited Create;
2980   fFormat           := tfLuminance12Alpha12;
2981   fWithAlpha        := tfLuminance12Alpha12;
2982   fWithoutAlpha     := tfLuminance12;
2983   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
2984 end;
2985
2986 constructor TfdLuminance16Alpha16.Create;
2987 begin
2988   inherited Create;
2989   fFormat           := tfLuminance16Alpha16;
2990   fWithAlpha        := tfLuminance16Alpha16;
2991   fWithoutAlpha     := tfLuminance16;
2992   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2993 end;
2994
2995 constructor TfdR3G3B2.Create;
2996 begin
2997   inherited Create;
2998   fFormat           := tfR3G3B2;
2999   fWithAlpha        := tfRGBA2;
3000   fWithoutAlpha     := tfR3G3B2;
3001   fRange.r          := $7;
3002   fRange.g          := $7;
3003   fRange.b          := $3;
3004   fShift.r          :=  0;
3005   fShift.g          :=  3;
3006   fShift.b          :=  6;
3007   fglFormat         := GL_RGB;
3008   fglInternalFormat := GL_R3_G3_B2;
3009   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3010 end;
3011
3012 constructor TfdRGB4.Create;
3013 begin
3014   inherited Create;
3015   fFormat           := tfRGB4;
3016   fWithAlpha        := tfRGBA4;
3017   fWithoutAlpha     := tfRGB4;
3018   fRGBInverted      := tfBGR4;
3019   fRange.r          := $F;
3020   fRange.g          := $F;
3021   fRange.b          := $F;
3022   fShift.r          :=  0;
3023   fShift.g          :=  4;
3024   fShift.b          :=  8;
3025   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3026   fglInternalFormat := GL_RGB4;
3027   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3028 end;
3029
3030 constructor TfdR5G6B5.Create;
3031 begin
3032   inherited Create;
3033   fFormat           := tfR5G6B5;
3034   fWithAlpha        := tfRGBA4;
3035   fWithoutAlpha     := tfR5G6B5;
3036   fRGBInverted      := tfB5G6R5;
3037   fRange.r          := $1F;
3038   fRange.g          := $3F;
3039   fRange.b          := $1F;
3040   fShift.r          :=   0;
3041   fShift.g          :=   5;
3042   fShift.b          :=  11;
3043   fglFormat         := GL_RGB;
3044   fglInternalFormat := GL_RGB565;
3045   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3046 end;
3047
3048 constructor TfdRGB5.Create;
3049 begin
3050   inherited Create;
3051   fFormat           := tfRGB5;
3052   fWithAlpha        := tfRGB5A1;
3053   fWithoutAlpha     := tfRGB5;
3054   fRGBInverted      := tfBGR5;
3055   fRange.r          := $1F;
3056   fRange.g          := $1F;
3057   fRange.b          := $1F;
3058   fShift.r          :=   0;
3059   fShift.g          :=   5;
3060   fShift.b          :=  10;
3061   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3062   fglInternalFormat := GL_RGB5;
3063   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3064 end;
3065
3066 constructor TfdRGB8.Create;
3067 begin
3068   inherited Create;
3069   fFormat           := tfRGB8;
3070   fWithAlpha        := tfRGBA8;
3071   fWithoutAlpha     := tfRGB8;
3072   fRGBInverted      := tfBGR8;
3073   fglInternalFormat := GL_RGB8;
3074 end;
3075
3076 constructor TfdRGB10.Create;
3077 begin
3078   inherited Create;
3079   fFormat           := tfRGB10;
3080   fWithAlpha        := tfRGB10A2;
3081   fWithoutAlpha     := tfRGB10;
3082   fRGBInverted      := tfBGR10;
3083   fRange.r          := $3FF;
3084   fRange.g          := $3FF;
3085   fRange.b          := $3FF;
3086   fShift.r          :=    0;
3087   fShift.g          :=   10;
3088   fShift.b          :=   20;
3089   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3090   fglInternalFormat := GL_RGB10;
3091   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3092 end;
3093
3094 constructor TfdRGB12.Create;
3095 begin
3096   inherited Create;
3097   fFormat           := tfRGB12;
3098   fWithAlpha        := tfRGBA12;
3099   fWithoutAlpha     := tfRGB12;
3100   fRGBInverted      := tfBGR12;
3101   fglInternalFormat := GL_RGB12;
3102 end;
3103
3104 constructor TfdRGB16.Create;
3105 begin
3106   inherited Create;
3107   fFormat           := tfRGB16;
3108   fWithAlpha        := tfRGBA16;
3109   fWithoutAlpha     := tfRGB16;
3110   fRGBInverted      := tfBGR16;
3111   fglInternalFormat := GL_RGB16;
3112 end;
3113
3114 constructor TfdRGBA2.Create;
3115 begin
3116   inherited Create;
3117   fFormat           := tfRGBA2;
3118   fWithAlpha        := tfRGBA2;
3119   fWithoutAlpha     := tfR3G3B2;
3120   fRGBInverted      := tfBGRA2;
3121   fglInternalFormat := GL_RGBA2;
3122 end;
3123
3124 constructor TfdRGBA4.Create;
3125 begin
3126   inherited Create;
3127   fFormat           := tfRGBA4;
3128   fWithAlpha        := tfRGBA4;
3129   fWithoutAlpha     := tfRGB4;
3130   fRGBInverted      := tfBGRA4;
3131   fRange.r          := $F;
3132   fRange.g          := $F;
3133   fRange.b          := $F;
3134   fRange.a          := $F;
3135   fShift.r          :=  0;
3136   fShift.g          :=  4;
3137   fShift.b          :=  8;
3138   fShift.a          := 12;
3139   fglFormat         := GL_RGBA;
3140   fglInternalFormat := GL_RGBA4;
3141   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3142 end;
3143
3144 constructor TfdRGB5A1.Create;
3145 begin
3146   inherited Create;
3147   fFormat           := tfRGB5A1;
3148   fWithAlpha        := tfRGB5A1;
3149   fWithoutAlpha     := tfRGB5;
3150   fRGBInverted      := tfBGR5A1;
3151   fRange.r          := $1F;
3152   fRange.g          := $1F;
3153   fRange.b          := $1F;
3154   fRange.a          := $01;
3155   fShift.r          :=   0;
3156   fShift.g          :=   5;
3157   fShift.b          :=  10;
3158   fShift.a          :=  15;
3159   fglFormat         := GL_RGBA;
3160   fglInternalFormat := GL_RGB5_A1;
3161   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3162 end;
3163
3164 constructor TfdRGBA8.Create;
3165 begin
3166   inherited Create;
3167   fFormat           := tfRGBA8;
3168   fWithAlpha        := tfRGBA8;
3169   fWithoutAlpha     := tfRGB8;
3170   fRGBInverted      := tfBGRA8;
3171   fglInternalFormat := GL_RGBA8;
3172 end;
3173
3174 constructor TfdRGB10A2.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfRGB10A2;
3178   fWithAlpha        := tfRGB10A2;
3179   fWithoutAlpha     := tfRGB10;
3180   fRGBInverted      := tfBGR10A2;
3181   fRange.r          := $3FF;
3182   fRange.g          := $3FF;
3183   fRange.b          := $3FF;
3184   fRange.a          := $003;
3185   fShift.r          :=    0;
3186   fShift.g          :=   10;
3187   fShift.b          :=   20;
3188   fShift.a          :=   30;
3189   fglFormat         := GL_RGBA;
3190   fglInternalFormat := GL_RGB10_A2;
3191   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3192 end;
3193
3194 constructor TfdRGBA12.Create;
3195 begin
3196   inherited Create;
3197   fFormat           := tfRGBA12;
3198   fWithAlpha        := tfRGBA12;
3199   fWithoutAlpha     := tfRGB12;
3200   fRGBInverted      := tfBGRA12;
3201   fglInternalFormat := GL_RGBA12;
3202 end;
3203
3204 constructor TfdRGBA16.Create;
3205 begin
3206   inherited Create;
3207   fFormat           := tfRGBA16;
3208   fWithAlpha        := tfRGBA16;
3209   fWithoutAlpha     := tfRGB16;
3210   fRGBInverted      := tfBGRA16;
3211   fglInternalFormat := GL_RGBA16;
3212 end;
3213
3214 constructor TfdBGR4.Create;
3215 begin
3216   inherited Create;
3217   fPixelSize        := 2.0;
3218   fFormat           := tfBGR4;
3219   fWithAlpha        := tfBGRA4;
3220   fWithoutAlpha     := tfBGR4;
3221   fRGBInverted      := tfRGB4;
3222   fRange.r          := $F;
3223   fRange.g          := $F;
3224   fRange.b          := $F;
3225   fRange.a          := $0;
3226   fShift.r          :=  8;
3227   fShift.g          :=  4;
3228   fShift.b          :=  0;
3229   fShift.a          :=  0;
3230   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3231   fglInternalFormat := GL_RGB4;
3232   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3233 end;
3234
3235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3238 constructor TfdB5G6R5.Create;
3239 begin
3240   inherited Create;
3241   fFormat           := tfB5G6R5;
3242   fWithAlpha        := tfBGRA4;
3243   fWithoutAlpha     := tfB5G6R5;
3244   fRGBInverted      := tfR5G6B5;
3245   fRange.r          := $1F;
3246   fRange.g          := $3F;
3247   fRange.b          := $1F;
3248   fShift.r          :=  11;
3249   fShift.g          :=   5;
3250   fShift.b          :=   0;
3251   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3252   fglInternalFormat := GL_RGB8;
3253   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3254 end;
3255
3256 constructor TfdBGR5.Create;
3257 begin
3258   inherited Create;
3259   fPixelSize        := 2.0;
3260   fFormat           := tfBGR5;
3261   fWithAlpha        := tfBGR5A1;
3262   fWithoutAlpha     := tfBGR5;
3263   fRGBInverted      := tfRGB5;
3264   fRange.r          := $1F;
3265   fRange.g          := $1F;
3266   fRange.b          := $1F;
3267   fRange.a          := $00;
3268   fShift.r          :=  10;
3269   fShift.g          :=   5;
3270   fShift.b          :=   0;
3271   fShift.a          :=   0;
3272   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3273   fglInternalFormat := GL_RGB5;
3274   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3275 end;
3276
3277 constructor TfdBGR8.Create;
3278 begin
3279   inherited Create;
3280   fFormat           := tfBGR8;
3281   fWithAlpha        := tfBGRA8;
3282   fWithoutAlpha     := tfBGR8;
3283   fRGBInverted      := tfRGB8;
3284   fglInternalFormat := GL_RGB8;
3285 end;
3286
3287 constructor TfdBGR10.Create;
3288 begin
3289   inherited Create;
3290   fFormat           := tfBGR10;
3291   fWithAlpha        := tfBGR10A2;
3292   fWithoutAlpha     := tfBGR10;
3293   fRGBInverted      := tfRGB10;
3294   fRange.r          := $3FF;
3295   fRange.g          := $3FF;
3296   fRange.b          := $3FF;
3297   fRange.a          := $000;
3298   fShift.r          :=   20;
3299   fShift.g          :=   10;
3300   fShift.b          :=    0;
3301   fShift.a          :=    0;
3302   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3303   fglInternalFormat := GL_RGB10;
3304   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3305 end;
3306
3307 constructor TfdBGR12.Create;
3308 begin
3309   inherited Create;
3310   fFormat           := tfBGR12;
3311   fWithAlpha        := tfBGRA12;
3312   fWithoutAlpha     := tfBGR12;
3313   fRGBInverted      := tfRGB12;
3314   fglInternalFormat := GL_RGB12;
3315 end;
3316
3317 constructor TfdBGR16.Create;
3318 begin
3319   inherited Create;
3320   fFormat           := tfBGR16;
3321   fWithAlpha        := tfBGRA16;
3322   fWithoutAlpha     := tfBGR16;
3323   fRGBInverted      := tfRGB16;
3324   fglInternalFormat := GL_RGB16;
3325 end;
3326
3327 constructor TfdBGRA2.Create;
3328 begin
3329   inherited Create;
3330   fFormat           := tfBGRA2;
3331   fWithAlpha        := tfBGRA4;
3332   fWithoutAlpha     := tfBGR4;
3333   fRGBInverted      := tfRGBA2;
3334   fglInternalFormat := GL_RGBA2;
3335 end;
3336
3337 constructor TfdBGRA4.Create;
3338 begin
3339   inherited Create;
3340   fFormat           := tfBGRA4;
3341   fWithAlpha        := tfBGRA4;
3342   fWithoutAlpha     := tfBGR4;
3343   fRGBInverted      := tfRGBA4;
3344   fRange.r          := $F;
3345   fRange.g          := $F;
3346   fRange.b          := $F;
3347   fRange.a          := $F;
3348   fShift.r          :=  8;
3349   fShift.g          :=  4;
3350   fShift.b          :=  0;
3351   fShift.a          := 12;
3352   fglFormat         := GL_BGRA;
3353   fglInternalFormat := GL_RGBA4;
3354   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3355 end;
3356
3357 constructor TfdBGR5A1.Create;
3358 begin
3359   inherited Create;
3360   fFormat           := tfBGR5A1;
3361   fWithAlpha        := tfBGR5A1;
3362   fWithoutAlpha     := tfBGR5;
3363   fRGBInverted      := tfRGB5A1;
3364   fRange.r          := $1F;
3365   fRange.g          := $1F;
3366   fRange.b          := $1F;
3367   fRange.a          := $01;
3368   fShift.r          :=  10;
3369   fShift.g          :=   5;
3370   fShift.b          :=   0;
3371   fShift.a          :=  15;
3372   fglFormat         := GL_BGRA;
3373   fglInternalFormat := GL_RGB5_A1;
3374   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3375 end;
3376
3377 constructor TfdBGRA8.Create;
3378 begin
3379   inherited Create;
3380   fFormat           := tfBGRA8;
3381   fWithAlpha        := tfBGRA8;
3382   fWithoutAlpha     := tfBGR8;
3383   fRGBInverted      := tfRGBA8;
3384   fglInternalFormat := GL_RGBA8;
3385 end;
3386
3387 constructor TfdBGR10A2.Create;
3388 begin
3389   inherited Create;
3390   fFormat           := tfBGR10A2;
3391   fWithAlpha        := tfBGR10A2;
3392   fWithoutAlpha     := tfBGR10;
3393   fRGBInverted      := tfRGB10A2;
3394   fRange.r          := $3FF;
3395   fRange.g          := $3FF;
3396   fRange.b          := $3FF;
3397   fRange.a          := $003;
3398   fShift.r          :=   20;
3399   fShift.g          :=   10;
3400   fShift.b          :=    0;
3401   fShift.a          :=   30;
3402   fglFormat         := GL_BGRA;
3403   fglInternalFormat := GL_RGB10_A2;
3404   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3405 end;
3406
3407 constructor TfdBGRA12.Create;
3408 begin
3409   inherited Create;
3410   fFormat           := tfBGRA12;
3411   fWithAlpha        := tfBGRA12;
3412   fWithoutAlpha     := tfBGR12;
3413   fRGBInverted      := tfRGBA12;
3414   fglInternalFormat := GL_RGBA12;
3415 end;
3416
3417 constructor TfdBGRA16.Create;
3418 begin
3419   inherited Create;
3420   fFormat           := tfBGRA16;
3421   fWithAlpha        := tfBGRA16;
3422   fWithoutAlpha     := tfBGR16;
3423   fRGBInverted      := tfRGBA16;
3424   fglInternalFormat := GL_RGBA16;
3425 end;
3426
3427 constructor TfdDepth16.Create;
3428 begin
3429   inherited Create;
3430   fFormat           := tfDepth16;
3431   fWithAlpha        := tfEmpty;
3432   fWithoutAlpha     := tfDepth16;
3433   fglInternalFormat := GL_DEPTH_COMPONENT16;
3434 end;
3435
3436 constructor TfdDepth24.Create;
3437 begin
3438   inherited Create;
3439   fFormat           := tfDepth24;
3440   fWithAlpha        := tfEmpty;
3441   fWithoutAlpha     := tfDepth24;
3442   fglInternalFormat := GL_DEPTH_COMPONENT24;
3443 end;
3444
3445 constructor TfdDepth32.Create;
3446 begin
3447   inherited Create;
3448   fFormat           := tfDepth32;
3449   fWithAlpha        := tfEmpty;
3450   fWithoutAlpha     := tfDepth32;
3451   fglInternalFormat := GL_DEPTH_COMPONENT32;
3452 end;
3453
3454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3455 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3457 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3458 begin
3459   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3460 end;
3461
3462 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3463 begin
3464   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3465 end;
3466
3467 constructor TfdS3tcDtx1RGBA.Create;
3468 begin
3469   inherited Create;
3470   fFormat           := tfS3tcDtx1RGBA;
3471   fWithAlpha        := tfS3tcDtx1RGBA;
3472   fUncompressed     := tfRGB5A1;
3473   fPixelSize        := 0.5;
3474   fIsCompressed     := true;
3475   fglFormat         := GL_COMPRESSED_RGBA;
3476   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3477   fglDataFormat     := GL_UNSIGNED_BYTE;
3478 end;
3479
3480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3481 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3483 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3484 begin
3485   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3486 end;
3487
3488 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3489 begin
3490   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3491 end;
3492
3493 constructor TfdS3tcDtx3RGBA.Create;
3494 begin
3495   inherited Create;
3496   fFormat           := tfS3tcDtx3RGBA;
3497   fWithAlpha        := tfS3tcDtx3RGBA;
3498   fUncompressed     := tfRGBA8;
3499   fPixelSize        := 1.0;
3500   fIsCompressed     := true;
3501   fglFormat         := GL_COMPRESSED_RGBA;
3502   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3503   fglDataFormat     := GL_UNSIGNED_BYTE;
3504 end;
3505
3506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3507 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3509 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3510 begin
3511   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3512 end;
3513
3514 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3515 begin
3516   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3517 end;
3518
3519 constructor TfdS3tcDtx5RGBA.Create;
3520 begin
3521   inherited Create;
3522   fFormat           := tfS3tcDtx3RGBA;
3523   fWithAlpha        := tfS3tcDtx3RGBA;
3524   fUncompressed     := tfRGBA8;
3525   fPixelSize        := 1.0;
3526   fIsCompressed     := true;
3527   fglFormat         := GL_COMPRESSED_RGBA;
3528   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3529   fglDataFormat     := GL_UNSIGNED_BYTE;
3530 end;
3531
3532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3533 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3535 class procedure TFormatDescriptor.Init;
3536 begin
3537   if not Assigned(FormatDescriptorCS) then
3538     FormatDescriptorCS := TCriticalSection.Create;
3539 end;
3540
3541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3542 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3543 begin
3544   FormatDescriptorCS.Enter;
3545   try
3546     result := FormatDescriptors[aFormat];
3547     if not Assigned(result) then begin
3548       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3549       FormatDescriptors[aFormat] := result;
3550     end;
3551   finally
3552     FormatDescriptorCS.Leave;
3553   end;
3554 end;
3555
3556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3557 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3558 begin
3559   result := Get(Get(aFormat).WithAlpha);
3560 end;
3561
3562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3563 class procedure TFormatDescriptor.Clear;
3564 var
3565   f: TglBitmapFormat;
3566 begin
3567   FormatDescriptorCS.Enter;
3568   try
3569     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3570       FreeAndNil(FormatDescriptors[f]);
3571   finally
3572     FormatDescriptorCS.Leave;
3573   end;
3574 end;
3575
3576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3577 class procedure TFormatDescriptor.Finalize;
3578 begin
3579   Clear;
3580   FreeAndNil(FormatDescriptorCS);
3581 end;
3582
3583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3584 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3586 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3587 begin
3588   Update(aValue, fRange.r, fShift.r);
3589 end;
3590
3591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3592 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3593 begin
3594   Update(aValue, fRange.g, fShift.g);
3595 end;
3596
3597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3598 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3599 begin
3600   Update(aValue, fRange.b, fShift.b);
3601 end;
3602
3603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3604 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3605 begin
3606   Update(aValue, fRange.a, fShift.a);
3607 end;
3608
3609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3610 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3611   aShift: Byte);
3612 begin
3613   aShift := 0;
3614   aRange := 0;
3615   if (aMask = 0) then
3616     exit;
3617   while (aMask > 0) and ((aMask and 1) = 0) do begin
3618     inc(aShift);
3619     aMask := aMask shr 1;
3620   end;
3621   aRange := 1;
3622   while (aMask > 0) do begin
3623     aRange := aRange shl 1;
3624     aMask  := aMask  shr 1;
3625   end;
3626   dec(aRange);
3627
3628   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3629 end;
3630
3631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3632 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3633 var
3634   data: QWord;
3635   s: Integer;
3636 begin
3637   data :=
3638     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3639     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3640     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3641     ((aPixel.Data.a and fRange.a) shl fShift.a);
3642   s := Round(fPixelSize);
3643   case s of
3644     1:           aData^  := data;
3645     2:     PWord(aData)^ := data;
3646     4: PCardinal(aData)^ := data;
3647     8:    PQWord(aData)^ := data;
3648   else
3649     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3650   end;
3651   inc(aData, s);
3652 end;
3653
3654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3655 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3656 var
3657   data: QWord;
3658   s, i: Integer;
3659 begin
3660   s := Round(fPixelSize);
3661   case s of
3662     1: data :=           aData^;
3663     2: data :=     PWord(aData)^;
3664     4: data := PCardinal(aData)^;
3665     8: data :=    PQWord(aData)^;
3666   else
3667     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3668   end;
3669   for i := 0 to 3 do
3670     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3671   inc(aData, s);
3672 end;
3673
3674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3675 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3677 procedure TbmpColorTableFormat.CreateColorTable;
3678 var
3679   i: Integer;
3680 begin
3681   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3682     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3683
3684   if (Format = tfLuminance4) then
3685     SetLength(fColorTable, 16)
3686   else
3687     SetLength(fColorTable, 256);
3688
3689   case Format of
3690     tfLuminance4: begin
3691       for i := 0 to High(fColorTable) do begin
3692         fColorTable[i].r := 16 * i;
3693         fColorTable[i].g := 16 * i;
3694         fColorTable[i].b := 16 * i;
3695         fColorTable[i].a := 0;
3696       end;
3697     end;
3698
3699     tfLuminance8: begin
3700       for i := 0 to High(fColorTable) do begin
3701         fColorTable[i].r := i;
3702         fColorTable[i].g := i;
3703         fColorTable[i].b := i;
3704         fColorTable[i].a := 0;
3705       end;
3706     end;
3707
3708     tfR3G3B2: begin
3709       for i := 0 to High(fColorTable) do begin
3710         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3711         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3712         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3713         fColorTable[i].a := 0;
3714       end;
3715     end;
3716   end;
3717 end;
3718
3719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3721 var
3722   d: Byte;
3723 begin
3724   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3725     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3726
3727   case Format of
3728     tfLuminance4: begin
3729       if (aMapData = nil) then
3730         aData^ := 0;
3731       d := LuminanceWeight(aPixel) and Range.r;
3732       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3733       inc(PByte(aMapData), 4);
3734       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3735         inc(aData);
3736         aMapData := nil;
3737       end;
3738     end;
3739
3740     tfLuminance8: begin
3741       aData^ := LuminanceWeight(aPixel) and Range.r;
3742       inc(aData);
3743     end;
3744
3745     tfR3G3B2: begin
3746       aData^ := Round(
3747         ((aPixel.Data.r and Range.r) shl Shift.r) or
3748         ((aPixel.Data.g and Range.g) shl Shift.g) or
3749         ((aPixel.Data.b and Range.b) shl Shift.b));
3750       inc(aData);
3751     end;
3752   end;
3753 end;
3754
3755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3756 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3757 var
3758   idx: QWord;
3759   s: Integer;
3760   bits: Byte;
3761   f: Single;
3762 begin
3763   s    := Trunc(fPixelSize);
3764   f    := fPixelSize - s;
3765   bits := Round(8 * f);
3766   case s of
3767     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3768     1: idx :=           aData^;
3769     2: idx :=     PWord(aData)^;
3770     4: idx := PCardinal(aData)^;
3771     8: idx :=    PQWord(aData)^;
3772   else
3773     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3774   end;
3775   if (idx >= Length(fColorTable)) then
3776     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3777   with fColorTable[idx] do begin
3778     aPixel.Data.r := r;
3779     aPixel.Data.g := g;
3780     aPixel.Data.b := b;
3781     aPixel.Data.a := a;
3782   end;
3783   inc(PByte(aMapData), bits);
3784   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3785     inc(aData, 1);
3786     dec(PByte(aMapData), 8);
3787   end;
3788   inc(aData, s);
3789 end;
3790
3791 destructor TbmpColorTableFormat.Destroy;
3792 begin
3793   SetLength(fColorTable, 0);
3794   inherited Destroy;
3795 end;
3796
3797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3798 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3800 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3801 var
3802   i: Integer;
3803 begin
3804   for i := 0 to 3 do begin
3805     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3806       if (aSourceFD.Range.arr[i] > 0) then
3807         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3808       else
3809         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3810     end;
3811   end;
3812 end;
3813
3814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3815 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3816 begin
3817   with aFuncRec do begin
3818     if (Source.Range.r   > 0) then
3819       Dest.Data.r := Source.Data.r;
3820     if (Source.Range.g > 0) then
3821       Dest.Data.g := Source.Data.g;
3822     if (Source.Range.b  > 0) then
3823       Dest.Data.b := Source.Data.b;
3824     if (Source.Range.a > 0) then
3825       Dest.Data.a := Source.Data.a;
3826   end;
3827 end;
3828
3829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3830 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3831 var
3832   i: Integer;
3833 begin
3834   with aFuncRec do begin
3835     for i := 0 to 3 do
3836       if (Source.Range.arr[i] > 0) then
3837         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3838   end;
3839 end;
3840
3841 type
3842   TShiftData = packed record
3843     case Integer of
3844       0: (r, g, b, a: SmallInt);
3845       1: (arr: array[0..3] of SmallInt);
3846   end;
3847   PShiftData = ^TShiftData;
3848
3849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3850 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3851 var
3852   i: Integer;
3853 begin
3854   with aFuncRec do
3855     for i := 0 to 3 do
3856       if (Source.Range.arr[i] > 0) then
3857         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3858 end;
3859
3860 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3861 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3862 begin
3863   with aFuncRec do begin
3864     Dest.Data := Source.Data;
3865     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3866       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3867       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3868       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3869     end;
3870     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3871       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3872     end;
3873   end;
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3878 var
3879   i: Integer;
3880 begin
3881   with aFuncRec do begin
3882     for i := 0 to 3 do
3883       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3884   end;
3885 end;
3886
3887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3888 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3889 var
3890   Temp: Single;
3891 begin
3892   with FuncRec do begin
3893     if (FuncRec.Args = nil) then begin //source has no alpha
3894       Temp :=
3895         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3896         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3897         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3898       Dest.Data.a := Round(Dest.Range.a * Temp);
3899     end else
3900       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3901   end;
3902 end;
3903
3904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3905 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3906 type
3907   PglBitmapPixelData = ^TglBitmapPixelData;
3908 begin
3909   with FuncRec do begin
3910     Dest.Data.r := Source.Data.r;
3911     Dest.Data.g := Source.Data.g;
3912     Dest.Data.b := Source.Data.b;
3913
3914     with PglBitmapPixelData(Args)^ do
3915       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3916           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3917           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3918         Dest.Data.a := 0
3919       else
3920         Dest.Data.a := Dest.Range.a;
3921   end;
3922 end;
3923
3924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3925 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3926 begin
3927   with FuncRec do begin
3928     Dest.Data.r := Source.Data.r;
3929     Dest.Data.g := Source.Data.g;
3930     Dest.Data.b := Source.Data.b;
3931     Dest.Data.a := PCardinal(Args)^;
3932   end;
3933 end;
3934
3935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3936 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3937 type
3938   PRGBPix = ^TRGBPix;
3939   TRGBPix = array [0..2] of byte;
3940 var
3941   Temp: Byte;
3942 begin
3943   while aWidth > 0 do begin
3944     Temp := PRGBPix(aData)^[0];
3945     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3946     PRGBPix(aData)^[2] := Temp;
3947
3948     if aHasAlpha then
3949       Inc(aData, 4)
3950     else
3951       Inc(aData, 3);
3952     dec(aWidth);
3953   end;
3954 end;
3955
3956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3957 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3959 function TglBitmap.GetWidth: Integer;
3960 begin
3961   if (ffX in fDimension.Fields) then
3962     result := fDimension.X
3963   else
3964     result := -1;
3965 end;
3966
3967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3968 function TglBitmap.GetHeight: Integer;
3969 begin
3970   if (ffY in fDimension.Fields) then
3971     result := fDimension.Y
3972   else
3973     result := -1;
3974 end;
3975
3976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3977 function TglBitmap.GetFileWidth: Integer;
3978 begin
3979   result := Max(1, Width);
3980 end;
3981
3982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3983 function TglBitmap.GetFileHeight: Integer;
3984 begin
3985   result := Max(1, Height);
3986 end;
3987
3988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 procedure TglBitmap.SetCustomData(const aValue: Pointer);
3990 begin
3991   if fCustomData = aValue then
3992     exit;
3993   fCustomData := aValue;
3994 end;
3995
3996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3997 procedure TglBitmap.SetCustomName(const aValue: String);
3998 begin
3999   if fCustomName = aValue then
4000     exit;
4001   fCustomName := aValue;
4002 end;
4003
4004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4005 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4006 begin
4007   if fCustomNameW = aValue then
4008     exit;
4009   fCustomNameW := aValue;
4010 end;
4011
4012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4013 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4014 begin
4015   if fDeleteTextureOnFree = aValue then
4016     exit;
4017   fDeleteTextureOnFree := aValue;
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4022 begin
4023   if fFormat = aValue then
4024     exit;
4025   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4026     raise EglBitmapUnsupportedFormat.Create(Format);
4027   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4028 end;
4029
4030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4031 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4032 begin
4033   if fFreeDataAfterGenTexture = aValue then
4034     exit;
4035   fFreeDataAfterGenTexture := aValue;
4036 end;
4037
4038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4039 procedure TglBitmap.SetID(const aValue: Cardinal);
4040 begin
4041   if fID = aValue then
4042     exit;
4043   fID := aValue;
4044 end;
4045
4046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4047 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4048 begin
4049   if fMipMap = aValue then
4050     exit;
4051   fMipMap := aValue;
4052 end;
4053
4054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4055 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4056 begin
4057   if fTarget = aValue then
4058     exit;
4059   fTarget := aValue;
4060 end;
4061
4062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4063 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4064 var
4065   MaxAnisotropic: Integer;
4066 begin
4067   fAnisotropic := aValue;
4068   if (ID > 0) then begin
4069     if GL_EXT_texture_filter_anisotropic then begin
4070       if fAnisotropic > 0 then begin
4071         Bind(false);
4072         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4073         if aValue > MaxAnisotropic then
4074           fAnisotropic := MaxAnisotropic;
4075         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4076       end;
4077     end else begin
4078       fAnisotropic := 0;
4079     end;
4080   end;
4081 end;
4082
4083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4084 procedure TglBitmap.CreateID;
4085 begin
4086   if (ID <> 0) then
4087     glDeleteTextures(1, @fID);
4088   glGenTextures(1, @fID);
4089   Bind(false);
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4094 begin
4095   // Set Up Parameters
4096   SetWrap(fWrapS, fWrapT, fWrapR);
4097   SetFilter(fFilterMin, fFilterMag);
4098   SetAnisotropic(fAnisotropic);
4099   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4100
4101   // Mip Maps Generation Mode
4102   aBuildWithGlu := false;
4103   if (MipMap = mmMipmap) then begin
4104     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4105       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4106     else
4107       aBuildWithGlu := true;
4108   end else if (MipMap = mmMipmapGlu) then
4109     aBuildWithGlu := true;
4110 end;
4111
4112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4114   const aWidth: Integer; const aHeight: Integer);
4115 var
4116   s: Single;
4117 begin
4118   if (Data <> aData) then begin
4119     if (Assigned(Data)) then
4120       FreeMem(Data);
4121     fData := aData;
4122   end;
4123
4124   FillChar(fDimension, SizeOf(fDimension), 0);
4125   if not Assigned(fData) then begin
4126     fFormat    := tfEmpty;
4127     fPixelSize := 0;
4128     fRowSize   := 0;
4129   end else begin
4130     if aWidth <> -1 then begin
4131       fDimension.Fields := fDimension.Fields + [ffX];
4132       fDimension.X := aWidth;
4133     end;
4134
4135     if aHeight <> -1 then begin
4136       fDimension.Fields := fDimension.Fields + [ffY];
4137       fDimension.Y := aHeight;
4138     end;
4139
4140     s := TFormatDescriptor.Get(aFormat).PixelSize;
4141     fFormat    := aFormat;
4142     fPixelSize := Ceil(s);
4143     fRowSize   := Ceil(s * aWidth);
4144   end;
4145 end;
4146
4147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 function TglBitmap.FlipHorz: Boolean;
4149 begin
4150   result := false;
4151 end;
4152
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 function TglBitmap.FlipVert: Boolean;
4155 begin
4156   result := false;
4157 end;
4158
4159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4160 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4162 procedure TglBitmap.AfterConstruction;
4163 begin
4164   inherited AfterConstruction;
4165
4166   fID         := 0;
4167   fTarget     := 0;
4168   fIsResident := false;
4169
4170   fFormat                  := glBitmapGetDefaultFormat;
4171   fMipMap                  := glBitmapDefaultMipmap;
4172   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4173   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4174
4175   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4176   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4177 end;
4178
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 procedure TglBitmap.BeforeDestruction;
4181 var
4182   NewData: PByte;
4183 begin
4184   NewData := nil;
4185   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4186   if (fID > 0) and fDeleteTextureOnFree then
4187     glDeleteTextures(1, @fID);
4188   inherited BeforeDestruction;
4189 end;
4190
4191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4192 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4193 var
4194   TempPos: Integer;
4195 begin
4196   if not Assigned(aResType) then begin
4197     TempPos   := Pos('.', aResource);
4198     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4199     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4200   end;
4201 end;
4202
4203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4204 procedure TglBitmap.LoadFromFile(const aFilename: String);
4205 var
4206   fs: TFileStream;
4207 begin
4208   if not FileExists(aFilename) then
4209     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4210   fFilename := aFilename;
4211   fs := TFileStream.Create(fFilename, fmOpenRead);
4212   try
4213     fs.Position := 0;
4214     LoadFromStream(fs);
4215   finally
4216     fs.Free;
4217   end;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4222 begin
4223   {$IFDEF GLB_SUPPORT_PNG_READ}
4224   if not LoadPNG(aStream) then
4225   {$ENDIF}
4226   {$IFDEF GLB_SUPPORT_JPEG_READ}
4227   if not LoadJPEG(aStream) then
4228   {$ENDIF}
4229   if not LoadDDS(aStream) then
4230   if not LoadTGA(aStream) then
4231   if not LoadBMP(aStream) then
4232     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4233 end;
4234
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4237   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4238 var
4239   tmpData: PByte;
4240   size: Integer;
4241 begin
4242   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4243   GetMem(tmpData, size);
4244   try
4245     FillChar(tmpData^, size, #$FF);
4246     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4247   except
4248     if Assigned(tmpData) then
4249       FreeMem(tmpData);
4250     raise;
4251   end;
4252   AddFunc(Self, aFunc, false, Format, aArgs);
4253 end;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4257 var
4258   rs: TResourceStream;
4259 begin
4260   PrepareResType(aResource, aResType);
4261   rs := TResourceStream.Create(aInstance, aResource, aResType);
4262   try
4263     LoadFromStream(rs);
4264   finally
4265     rs.Free;
4266   end;
4267 end;
4268
4269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4270 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4271 var
4272   rs: TResourceStream;
4273 begin
4274   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4275   try
4276     LoadFromStream(rs);
4277   finally
4278     rs.Free;
4279   end;
4280 end;
4281
4282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4283 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4284 var
4285   fs: TFileStream;
4286 begin
4287   fs := TFileStream.Create(aFileName, fmCreate);
4288   try
4289     fs.Position := 0;
4290     SaveToStream(fs, aFileType);
4291   finally
4292     fs.Free;
4293   end;
4294 end;
4295
4296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4298 begin
4299   case aFileType of
4300     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4301     ftPNG:  SavePNG(aStream);
4302     {$ENDIF}
4303     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4304     ftJPEG: SaveJPEG(aStream);
4305     {$ENDIF}
4306     ftDDS:  SaveDDS(aStream);
4307     ftTGA:  SaveTGA(aStream);
4308     ftBMP:  SaveBMP(aStream);
4309   end;
4310 end;
4311
4312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4314 begin
4315   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4320   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4321 var
4322   DestData, TmpData, SourceData: pByte;
4323   TempHeight, TempWidth: Integer;
4324   SourceFD, DestFD: TFormatDescriptor;
4325   SourceMD, DestMD: Pointer;
4326
4327   FuncRec: TglBitmapFunctionRec;
4328 begin
4329   Assert(Assigned(Data));
4330   Assert(Assigned(aSource));
4331   Assert(Assigned(aSource.Data));
4332
4333   result := false;
4334   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4335     SourceFD := TFormatDescriptor.Get(aSource.Format);
4336     DestFD   := TFormatDescriptor.Get(aFormat);
4337
4338     if (SourceFD.IsCompressed) then
4339       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4340     if (DestFD.IsCompressed) then
4341       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4342
4343     // inkompatible Formats so CreateTemp
4344     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4345       aCreateTemp := true;
4346
4347     // Values
4348     TempHeight := Max(1, aSource.Height);
4349     TempWidth  := Max(1, aSource.Width);
4350
4351     FuncRec.Sender := Self;
4352     FuncRec.Args   := aArgs;
4353
4354     TmpData := nil;
4355     if aCreateTemp then begin
4356       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4357       DestData := TmpData;
4358     end else
4359       DestData := Data;
4360
4361     try
4362       SourceFD.PreparePixel(FuncRec.Source);
4363       DestFD.PreparePixel  (FuncRec.Dest);
4364
4365       SourceMD := SourceFD.CreateMappingData;
4366       DestMD   := DestFD.CreateMappingData;
4367
4368       FuncRec.Size            := aSource.Dimension;
4369       FuncRec.Position.Fields := FuncRec.Size.Fields;
4370
4371       try
4372         SourceData := aSource.Data;
4373         FuncRec.Position.Y := 0;
4374         while FuncRec.Position.Y < TempHeight do begin
4375           FuncRec.Position.X := 0;
4376           while FuncRec.Position.X < TempWidth do begin
4377             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4378             aFunc(FuncRec);
4379             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4380             inc(FuncRec.Position.X);
4381           end;
4382           inc(FuncRec.Position.Y);
4383         end;
4384
4385         // Updating Image or InternalFormat
4386         if aCreateTemp then
4387           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4388         else if (aFormat <> fFormat) then
4389           Format := aFormat;
4390
4391         result := true;
4392       finally
4393         SourceFD.FreeMappingData(SourceMD);
4394         DestFD.FreeMappingData(DestMD);
4395       end;
4396     except
4397       if aCreateTemp and Assigned(TmpData) then
4398         FreeMem(TmpData);
4399       raise;
4400     end;
4401   end;
4402 end;
4403
4404 {$IFDEF GLB_SDL}
4405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4406 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4407 var
4408   Row, RowSize: Integer;
4409   SourceData, TmpData: PByte;
4410   TempDepth: Integer;
4411   FormatDesc: TFormatDescriptor;
4412
4413   function GetRowPointer(Row: Integer): pByte;
4414   begin
4415     result := aSurface.pixels;
4416     Inc(result, Row * RowSize);
4417   end;
4418
4419 begin
4420   result := false;
4421
4422   FormatDesc := TFormatDescriptor.Get(Format);
4423   if FormatDesc.IsCompressed then
4424     raise EglBitmapUnsupportedFormat.Create(Format);
4425
4426   if Assigned(Data) then begin
4427     case Trunc(FormatDesc.PixelSize) of
4428       1: TempDepth :=  8;
4429       2: TempDepth := 16;
4430       3: TempDepth := 24;
4431       4: TempDepth := 32;
4432     else
4433       raise EglBitmapUnsupportedFormat.Create(Format);
4434     end;
4435
4436     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4437       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4438     SourceData := Data;
4439     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4440
4441     for Row := 0 to FileHeight-1 do begin
4442       TmpData := GetRowPointer(Row);
4443       if Assigned(TmpData) then begin
4444         Move(SourceData^, TmpData^, RowSize);
4445         inc(SourceData, RowSize);
4446       end;
4447     end;
4448     result := true;
4449   end;
4450 end;
4451
4452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4453 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4454 var
4455   pSource, pData, pTempData: PByte;
4456   Row, RowSize, TempWidth, TempHeight: Integer;
4457   IntFormat: TglBitmapFormat;
4458   FormatDesc: TFormatDescriptor;
4459
4460   function GetRowPointer(Row: Integer): pByte;
4461   begin
4462     result := aSurface^.pixels;
4463     Inc(result, Row * RowSize);
4464   end;
4465
4466 begin
4467   result := false;
4468   if (Assigned(aSurface)) then begin
4469     with aSurface^.format^ do begin
4470       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4471         FormatDesc := TFormatDescriptor.Get(IntFormat);
4472         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4473           break;
4474       end;
4475       if (IntFormat = tfEmpty) then
4476         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4477     end;
4478
4479     TempWidth  := aSurface^.w;
4480     TempHeight := aSurface^.h;
4481     RowSize := FormatDesc.GetSize(TempWidth, 1);
4482     GetMem(pData, TempHeight * RowSize);
4483     try
4484       pTempData := pData;
4485       for Row := 0 to TempHeight -1 do begin
4486         pSource := GetRowPointer(Row);
4487         if (Assigned(pSource)) then begin
4488           Move(pSource^, pTempData^, RowSize);
4489           Inc(pTempData, RowSize);
4490         end;
4491       end;
4492       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4493       result := true;
4494     except
4495       if Assigned(pData) then
4496         FreeMem(pData);
4497       raise;
4498     end;
4499   end;
4500 end;
4501
4502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4503 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4504 var
4505   Row, Col, AlphaInterleave: Integer;
4506   pSource, pDest: PByte;
4507
4508   function GetRowPointer(Row: Integer): pByte;
4509   begin
4510     result := aSurface.pixels;
4511     Inc(result, Row * Width);
4512   end;
4513
4514 begin
4515   result := false;
4516   if Assigned(Data) then begin
4517     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4518       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4519
4520       AlphaInterleave := 0;
4521       case Format of
4522         tfLuminance8Alpha8:
4523           AlphaInterleave := 1;
4524         tfBGRA8, tfRGBA8:
4525           AlphaInterleave := 3;
4526       end;
4527
4528       pSource := Data;
4529       for Row := 0 to Height -1 do begin
4530         pDest := GetRowPointer(Row);
4531         if Assigned(pDest) then begin
4532           for Col := 0 to Width -1 do begin
4533             Inc(pSource, AlphaInterleave);
4534             pDest^ := pSource^;
4535             Inc(pDest);
4536             Inc(pSource);
4537           end;
4538         end;
4539       end;
4540       result := true;
4541     end;
4542   end;
4543 end;
4544
4545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4546 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4547 var
4548   bmp: TglBitmap2D;
4549 begin
4550   bmp := TglBitmap2D.Create;
4551   try
4552     bmp.AssignFromSurface(aSurface);
4553     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4554   finally
4555     bmp.Free;
4556   end;
4557 end;
4558 {$ENDIF}
4559
4560 {$IFDEF GLB_DELPHI}
4561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4562 function CreateGrayPalette: HPALETTE;
4563 var
4564   Idx: Integer;
4565   Pal: PLogPalette;
4566 begin
4567   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4568
4569   Pal.palVersion := $300;
4570   Pal.palNumEntries := 256;
4571
4572   for Idx := 0 to Pal.palNumEntries - 1 do begin
4573     Pal.palPalEntry[Idx].peRed   := Idx;
4574     Pal.palPalEntry[Idx].peGreen := Idx;
4575     Pal.palPalEntry[Idx].peBlue  := Idx;
4576     Pal.palPalEntry[Idx].peFlags := 0;
4577   end;
4578   Result := CreatePalette(Pal^);
4579   FreeMem(Pal);
4580 end;
4581
4582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4583 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4584 var
4585   Row: Integer;
4586   pSource, pData: PByte;
4587 begin
4588   result := false;
4589   if Assigned(Data) then begin
4590     if Assigned(aBitmap) then begin
4591       aBitmap.Width  := Width;
4592       aBitmap.Height := Height;
4593
4594       case Format of
4595         tfAlpha8, tfLuminance8: begin
4596           aBitmap.PixelFormat := pf8bit;
4597           aBitmap.Palette     := CreateGrayPalette;
4598         end;
4599         tfRGB5A1:
4600           aBitmap.PixelFormat := pf15bit;
4601         tfR5G6B5:
4602           aBitmap.PixelFormat := pf16bit;
4603         tfRGB8, tfBGR8:
4604           aBitmap.PixelFormat := pf24bit;
4605         tfRGBA8, tfBGRA8:
4606           aBitmap.PixelFormat := pf32bit;
4607       else
4608         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4609       end;
4610
4611       pSource := Data;
4612       for Row := 0 to FileHeight -1 do begin
4613         pData := aBitmap.Scanline[Row];
4614         Move(pSource^, pData^, fRowSize);
4615         Inc(pSource, fRowSize);
4616         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4617           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4618       end;
4619       result := true;
4620     end;
4621   end;
4622 end;
4623
4624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4625 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4626 var
4627   pSource, pData, pTempData: PByte;
4628   Row, RowSize, TempWidth, TempHeight: Integer;
4629   IntFormat: TglBitmapFormat;
4630 begin
4631   result := false;
4632
4633   if (Assigned(aBitmap)) then begin
4634     case aBitmap.PixelFormat of
4635       pf8bit:
4636         IntFormat := tfLuminance8;
4637       pf15bit:
4638         IntFormat := tfRGB5A1;
4639       pf16bit:
4640         IntFormat := tfR5G6B5;
4641       pf24bit:
4642         IntFormat := tfBGR8;
4643       pf32bit:
4644         IntFormat := tfBGRA8;
4645     else
4646       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4647     end;
4648
4649     TempWidth  := aBitmap.Width;
4650     TempHeight := aBitmap.Height;
4651     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4652     GetMem(pData, TempHeight * RowSize);
4653     try
4654       pTempData := pData;
4655       for Row := 0 to TempHeight -1 do begin
4656         pSource := aBitmap.Scanline[Row];
4657         if (Assigned(pSource)) then begin
4658           Move(pSource^, pTempData^, RowSize);
4659           Inc(pTempData, RowSize);
4660         end;
4661       end;
4662       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4663       result := true;
4664     except
4665       if Assigned(pData) then
4666         FreeMem(pData);
4667       raise;
4668     end;
4669   end;
4670 end;
4671
4672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4673 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4674 var
4675   Row, Col, AlphaInterleave: Integer;
4676   pSource, pDest: PByte;
4677 begin
4678   result := false;
4679
4680   if Assigned(Data) then begin
4681     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4682       if Assigned(aBitmap) then begin
4683         aBitmap.PixelFormat := pf8bit;
4684         aBitmap.Palette     := CreateGrayPalette;
4685         aBitmap.Width       := Width;
4686         aBitmap.Height      := Height;
4687
4688         case Format of
4689           tfLuminance8Alpha8:
4690             AlphaInterleave := 1;
4691           tfRGBA8, tfBGRA8:
4692             AlphaInterleave := 3;
4693           else
4694             AlphaInterleave := 0;
4695         end;
4696
4697         // Copy Data
4698         pSource := Data;
4699
4700         for Row := 0 to Height -1 do begin
4701           pDest := aBitmap.Scanline[Row];
4702           if Assigned(pDest) then begin
4703             for Col := 0 to Width -1 do begin
4704               Inc(pSource, AlphaInterleave);
4705               pDest^ := pSource^;
4706               Inc(pDest);
4707               Inc(pSource);
4708             end;
4709           end;
4710         end;
4711         result := true;
4712       end;
4713     end;
4714   end;
4715 end;
4716
4717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4718 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4719 var
4720   tex: TglBitmap2D;
4721 begin
4722   tex := TglBitmap2D.Create;
4723   try
4724     tex.AssignFromBitmap(ABitmap);
4725     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4726   finally
4727     tex.Free;
4728   end;
4729 end;
4730 {$ENDIF}
4731
4732 {$IFDEF GLB_LAZARUS}
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4735 var
4736   rid: TRawImageDescription;
4737   FormatDesc: TFormatDescriptor;
4738 begin
4739   result := false;
4740   if not Assigned(aImage) or (Format = tfEmpty) then
4741     exit;
4742   FormatDesc := TFormatDescriptor.Get(Format);
4743   if FormatDesc.IsCompressed then
4744     exit;
4745
4746   FillChar(rid{%H-}, SizeOf(rid), 0);
4747   if (Format in [
4748        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4749        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4750        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4751     rid.Format := ricfGray
4752   else
4753     rid.Format := ricfRGBA;
4754
4755   rid.Width        := Width;
4756   rid.Height       := Height;
4757   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4758   rid.BitOrder     := riboBitsInOrder;
4759   rid.ByteOrder    := riboLSBFirst;
4760   rid.LineOrder    := riloTopToBottom;
4761   rid.LineEnd      := rileTight;
4762   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4763   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4764   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4765   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4766   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4767   rid.RedShift     := FormatDesc.Shift.r;
4768   rid.GreenShift   := FormatDesc.Shift.g;
4769   rid.BlueShift    := FormatDesc.Shift.b;
4770   rid.AlphaShift   := FormatDesc.Shift.a;
4771
4772   rid.MaskBitsPerPixel  := 0;
4773   rid.PaletteColorCount := 0;
4774
4775   aImage.DataDescription := rid;
4776   aImage.CreateData;
4777
4778   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4779
4780   result := true;
4781 end;
4782
4783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4784 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4785 var
4786   f: TglBitmapFormat;
4787   FormatDesc: TFormatDescriptor;
4788   ImageData: PByte;
4789   ImageSize: Integer;
4790 begin
4791   result := false;
4792   if not Assigned(aImage) then
4793     exit;
4794   for f := High(f) downto Low(f) do begin
4795     FormatDesc := TFormatDescriptor.Get(f);
4796     with aImage.DataDescription do
4797       if FormatDesc.MaskMatch(
4798         (QWord(1 shl RedPrec  )-1) shl RedShift,
4799         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4800         (QWord(1 shl BluePrec )-1) shl BlueShift,
4801         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4802         break;
4803   end;
4804
4805   if (f = tfEmpty) then
4806     exit;
4807
4808   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4809   ImageData := GetMem(ImageSize);
4810   try
4811     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4812     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4813   except
4814     if Assigned(ImageData) then
4815       FreeMem(ImageData);
4816     raise;
4817   end;
4818
4819   result := true;
4820 end;
4821
4822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4823 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4824 var
4825   rid: TRawImageDescription;
4826   FormatDesc: TFormatDescriptor;
4827   Pixel: TglBitmapPixelData;
4828   x, y: Integer;
4829   srcMD: Pointer;
4830   src, dst: PByte;
4831 begin
4832   result := false;
4833   if not Assigned(aImage) or (Format = tfEmpty) then
4834     exit;
4835   FormatDesc := TFormatDescriptor.Get(Format);
4836   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4837     exit;
4838
4839   FillChar(rid{%H-}, SizeOf(rid), 0);
4840   rid.Format       := ricfGray;
4841   rid.Width        := Width;
4842   rid.Height       := Height;
4843   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4844   rid.BitOrder     := riboBitsInOrder;
4845   rid.ByteOrder    := riboLSBFirst;
4846   rid.LineOrder    := riloTopToBottom;
4847   rid.LineEnd      := rileTight;
4848   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4849   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4850   rid.GreenPrec    := 0;
4851   rid.BluePrec     := 0;
4852   rid.AlphaPrec    := 0;
4853   rid.RedShift     := 0;
4854   rid.GreenShift   := 0;
4855   rid.BlueShift    := 0;
4856   rid.AlphaShift   := 0;
4857
4858   rid.MaskBitsPerPixel  := 0;
4859   rid.PaletteColorCount := 0;
4860
4861   aImage.DataDescription := rid;
4862   aImage.CreateData;
4863
4864   srcMD := FormatDesc.CreateMappingData;
4865   try
4866     FormatDesc.PreparePixel(Pixel);
4867     src := Data;
4868     dst := aImage.PixelData;
4869     for y := 0 to Height-1 do
4870       for x := 0 to Width-1 do begin
4871         FormatDesc.Unmap(src, Pixel, srcMD);
4872         case rid.BitsPerPixel of
4873            8: begin
4874             dst^ := Pixel.Data.a;
4875             inc(dst);
4876           end;
4877           16: begin
4878             PWord(dst)^ := Pixel.Data.a;
4879             inc(dst, 2);
4880           end;
4881           24: begin
4882             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4883             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4884             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4885             inc(dst, 3);
4886           end;
4887           32: begin
4888             PCardinal(dst)^ := Pixel.Data.a;
4889             inc(dst, 4);
4890           end;
4891         else
4892           raise EglBitmapUnsupportedFormat.Create(Format);
4893         end;
4894       end;
4895   finally
4896     FormatDesc.FreeMappingData(srcMD);
4897   end;
4898   result := true;
4899 end;
4900
4901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4902 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4903 var
4904   tex: TglBitmap2D;
4905 begin
4906   tex := TglBitmap2D.Create;
4907   try
4908     tex.AssignFromLazIntfImage(aImage);
4909     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4910   finally
4911     tex.Free;
4912   end;
4913 end;
4914 {$ENDIF}
4915
4916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4917 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4918   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4919 var
4920   rs: TResourceStream;
4921 begin
4922   PrepareResType(aResource, aResType);
4923   rs := TResourceStream.Create(aInstance, aResource, aResType);
4924   try
4925     result := AddAlphaFromStream(rs, aFunc, aArgs);
4926   finally
4927     rs.Free;
4928   end;
4929 end;
4930
4931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4932 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4933   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4934 var
4935   rs: TResourceStream;
4936 begin
4937   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4938   try
4939     result := AddAlphaFromStream(rs, aFunc, aArgs);
4940   finally
4941     rs.Free;
4942   end;
4943 end;
4944
4945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4946 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4947 begin
4948   if TFormatDescriptor.Get(Format).IsCompressed then
4949     raise EglBitmapUnsupportedFormat.Create(Format);
4950   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4951 end;
4952
4953 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4954 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4955 var
4956   FS: TFileStream;
4957 begin
4958   FS := TFileStream.Create(FileName, fmOpenRead);
4959   try
4960     result := AddAlphaFromStream(FS, aFunc, aArgs);
4961   finally
4962     FS.Free;
4963   end;
4964 end;
4965
4966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4967 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4968 var
4969   tex: TglBitmap2D;
4970 begin
4971   tex := TglBitmap2D.Create(aStream);
4972   try
4973     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4974   finally
4975     tex.Free;
4976   end;
4977 end;
4978
4979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4980 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4981 var
4982   DestData, DestData2, SourceData: pByte;
4983   TempHeight, TempWidth: Integer;
4984   SourceFD, DestFD: TFormatDescriptor;
4985   SourceMD, DestMD, DestMD2: Pointer;
4986
4987   FuncRec: TglBitmapFunctionRec;
4988 begin
4989   result := false;
4990
4991   Assert(Assigned(Data));
4992   Assert(Assigned(aBitmap));
4993   Assert(Assigned(aBitmap.Data));
4994
4995   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4996     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4997
4998     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4999     DestFD   := TFormatDescriptor.Get(Format);
5000
5001     if not Assigned(aFunc) then begin
5002       aFunc        := glBitmapAlphaFunc;
5003       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5004     end else
5005       FuncRec.Args := aArgs;
5006
5007     // Values
5008     TempHeight := aBitmap.FileHeight;
5009     TempWidth  := aBitmap.FileWidth;
5010
5011     FuncRec.Sender          := Self;
5012     FuncRec.Size            := Dimension;
5013     FuncRec.Position.Fields := FuncRec.Size.Fields;
5014
5015     DestData   := Data;
5016     DestData2  := Data;
5017     SourceData := aBitmap.Data;
5018
5019     // Mapping
5020     SourceFD.PreparePixel(FuncRec.Source);
5021     DestFD.PreparePixel  (FuncRec.Dest);
5022
5023     SourceMD := SourceFD.CreateMappingData;
5024     DestMD   := DestFD.CreateMappingData;
5025     DestMD2  := DestFD.CreateMappingData;
5026     try
5027       FuncRec.Position.Y := 0;
5028       while FuncRec.Position.Y < TempHeight do begin
5029         FuncRec.Position.X := 0;
5030         while FuncRec.Position.X < TempWidth do begin
5031           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5032           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5033           aFunc(FuncRec);
5034           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5035           inc(FuncRec.Position.X);
5036         end;
5037         inc(FuncRec.Position.Y);
5038       end;
5039     finally
5040       SourceFD.FreeMappingData(SourceMD);
5041       DestFD.FreeMappingData(DestMD);
5042       DestFD.FreeMappingData(DestMD2);
5043     end;
5044   end;
5045 end;
5046
5047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5048 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5049 begin
5050   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5051 end;
5052
5053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5054 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5055 var
5056   PixelData: TglBitmapPixelData;
5057 begin
5058   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5059   result := AddAlphaFromColorKeyFloat(
5060     aRed   / PixelData.Range.r,
5061     aGreen / PixelData.Range.g,
5062     aBlue  / PixelData.Range.b,
5063     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5064 end;
5065
5066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5067 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5068 var
5069   values: array[0..2] of Single;
5070   tmp: Cardinal;
5071   i: Integer;
5072   PixelData: TglBitmapPixelData;
5073 begin
5074   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5075   with PixelData do begin
5076     values[0] := aRed;
5077     values[1] := aGreen;
5078     values[2] := aBlue;
5079
5080     for i := 0 to 2 do begin
5081       tmp          := Trunc(Range.arr[i] * aDeviation);
5082       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5083       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5084     end;
5085     Data.a  := 0;
5086     Range.a := 0;
5087   end;
5088   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5089 end;
5090
5091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5092 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5093 begin
5094   result := AddAlphaFromValueFloat(aAlpha / $FF);
5095 end;
5096
5097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5098 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5099 var
5100   PixelData: TglBitmapPixelData;
5101 begin
5102   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5103   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5104 end;
5105
5106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5107 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5108 var
5109   PixelData: TglBitmapPixelData;
5110 begin
5111   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5112   with PixelData do
5113     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5114   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5115 end;
5116
5117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5118 function TglBitmap.RemoveAlpha: Boolean;
5119 var
5120   FormatDesc: TFormatDescriptor;
5121 begin
5122   result := false;
5123   FormatDesc := TFormatDescriptor.Get(Format);
5124   if Assigned(Data) then begin
5125     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5126       raise EglBitmapUnsupportedFormat.Create(Format);
5127     result := ConvertTo(FormatDesc.WithoutAlpha);
5128   end;
5129 end;
5130
5131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5132 function TglBitmap.Clone: TglBitmap;
5133 var
5134   Temp: TglBitmap;
5135   TempPtr: PByte;
5136   Size: Integer;
5137 begin
5138   result := nil;
5139   Temp := (ClassType.Create as TglBitmap);
5140   try
5141     // copy texture data if assigned
5142     if Assigned(Data) then begin
5143       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5144       GetMem(TempPtr, Size);
5145       try
5146         Move(Data^, TempPtr^, Size);
5147         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5148       except
5149         if Assigned(TempPtr) then
5150           FreeMem(TempPtr);
5151         raise;
5152       end;
5153     end else begin
5154       TempPtr := nil;
5155       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5156     end;
5157
5158         // copy properties
5159     Temp.fID                      := ID;
5160     Temp.fTarget                  := Target;
5161     Temp.fFormat                  := Format;
5162     Temp.fMipMap                  := MipMap;
5163     Temp.fAnisotropic             := Anisotropic;
5164     Temp.fBorderColor             := fBorderColor;
5165     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5166     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5167     Temp.fFilterMin               := fFilterMin;
5168     Temp.fFilterMag               := fFilterMag;
5169     Temp.fWrapS                   := fWrapS;
5170     Temp.fWrapT                   := fWrapT;
5171     Temp.fWrapR                   := fWrapR;
5172     Temp.fFilename                := fFilename;
5173     Temp.fCustomName              := fCustomName;
5174     Temp.fCustomNameW             := fCustomNameW;
5175     Temp.fCustomData              := fCustomData;
5176
5177     result := Temp;
5178   except
5179     FreeAndNil(Temp);
5180     raise;
5181   end;
5182 end;
5183
5184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5185 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5186 var
5187   SourceFD, DestFD: TFormatDescriptor;
5188   SourcePD, DestPD: TglBitmapPixelData;
5189   ShiftData: TShiftData;
5190
5191   function CanCopyDirect: Boolean;
5192   begin
5193     result :=
5194       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5195       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5196       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5197       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5198   end;
5199
5200   function CanShift: Boolean;
5201   begin
5202     result :=
5203       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5204       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5205       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5206       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5207   end;
5208
5209   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5210   begin
5211     result := 0;
5212     while (aSource > aDest) and (aSource > 0) do begin
5213       inc(result);
5214       aSource := aSource shr 1;
5215     end;
5216   end;
5217
5218 begin
5219   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5220     SourceFD := TFormatDescriptor.Get(Format);
5221     DestFD   := TFormatDescriptor.Get(aFormat);
5222
5223     SourceFD.PreparePixel(SourcePD);
5224     DestFD.PreparePixel  (DestPD);
5225
5226     if CanCopyDirect then
5227       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5228     else if CanShift then begin
5229       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5230       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5231       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5232       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5233       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5234     end else
5235       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5236   end else
5237     result := true;
5238 end;
5239
5240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5241 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5242 begin
5243   if aUseRGB or aUseAlpha then
5244     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5245       ((PtrInt(aUseAlpha) and 1) shl 1) or
5246        (PtrInt(aUseRGB)   and 1)      ));
5247 end;
5248
5249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5250 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5251 begin
5252   fBorderColor[0] := aRed;
5253   fBorderColor[1] := aGreen;
5254   fBorderColor[2] := aBlue;
5255   fBorderColor[3] := aAlpha;
5256   if (ID > 0) then begin
5257     Bind(false);
5258     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5259   end;
5260 end;
5261
5262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5263 procedure TglBitmap.FreeData;
5264 var
5265   TempPtr: PByte;
5266 begin
5267   TempPtr := nil;
5268   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5269 end;
5270
5271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5272 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5273   const aAlpha: Byte);
5274 begin
5275   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5276 end;
5277
5278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5279 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5280 var
5281   PixelData: TglBitmapPixelData;
5282 begin
5283   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5284   FillWithColorFloat(
5285     aRed   / PixelData.Range.r,
5286     aGreen / PixelData.Range.g,
5287     aBlue  / PixelData.Range.b,
5288     aAlpha / PixelData.Range.a);
5289 end;
5290
5291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5292 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5293 var
5294   PixelData: TglBitmapPixelData;
5295 begin
5296   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5297   with PixelData do begin
5298     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5299     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5300     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5301     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5302   end;
5303   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5304 end;
5305
5306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5307 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5308 begin
5309   //check MIN filter
5310   case aMin of
5311     GL_NEAREST:
5312       fFilterMin := GL_NEAREST;
5313     GL_LINEAR:
5314       fFilterMin := GL_LINEAR;
5315     GL_NEAREST_MIPMAP_NEAREST:
5316       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5317     GL_LINEAR_MIPMAP_NEAREST:
5318       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5319     GL_NEAREST_MIPMAP_LINEAR:
5320       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5321     GL_LINEAR_MIPMAP_LINEAR:
5322       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5323     else
5324       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5325   end;
5326
5327   //check MAG filter
5328   case aMag of
5329     GL_NEAREST:
5330       fFilterMag := GL_NEAREST;
5331     GL_LINEAR:
5332       fFilterMag := GL_LINEAR;
5333     else
5334       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5335   end;
5336
5337   //apply filter
5338   if (ID > 0) then begin
5339     Bind(false);
5340     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5341
5342     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5343       case fFilterMin of
5344         GL_NEAREST, GL_LINEAR:
5345           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5346         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5347           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5348         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5349           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5350       end;
5351     end else
5352       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5353   end;
5354 end;
5355
5356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5357 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5358
5359   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5360   begin
5361     case aValue of
5362       GL_CLAMP:
5363         aTarget := GL_CLAMP;
5364
5365       GL_REPEAT:
5366         aTarget := GL_REPEAT;
5367
5368       GL_CLAMP_TO_EDGE: begin
5369         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5370           aTarget := GL_CLAMP_TO_EDGE
5371         else
5372           aTarget := GL_CLAMP;
5373       end;
5374
5375       GL_CLAMP_TO_BORDER: begin
5376         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5377           aTarget := GL_CLAMP_TO_BORDER
5378         else
5379           aTarget := GL_CLAMP;
5380       end;
5381
5382       GL_MIRRORED_REPEAT: begin
5383         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5384           aTarget := GL_MIRRORED_REPEAT
5385         else
5386           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5387       end;
5388     else
5389       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5390     end;
5391   end;
5392
5393 begin
5394   CheckAndSetWrap(S, fWrapS);
5395   CheckAndSetWrap(T, fWrapT);
5396   CheckAndSetWrap(R, fWrapR);
5397
5398   if (ID > 0) then begin
5399     Bind(false);
5400     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5401     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5402     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5403   end;
5404 end;
5405
5406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5407 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5408 begin
5409   if aEnableTextureUnit then
5410     glEnable(Target);
5411   if (ID > 0) then
5412     glBindTexture(Target, ID);
5413 end;
5414
5415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5417 begin
5418   if aDisableTextureUnit then
5419     glDisable(Target);
5420   glBindTexture(Target, 0);
5421 end;
5422
5423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5424 constructor TglBitmap.Create;
5425 begin
5426   if (ClassType = TglBitmap) then
5427     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5428 {$IFDEF GLB_NATIVE_OGL}
5429   glbReadOpenGLExtensions;
5430 {$ENDIF}
5431   inherited Create;
5432 end;
5433
5434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5435 constructor TglBitmap.Create(const aFileName: String);
5436 begin
5437   Create;
5438   LoadFromFile(FileName);
5439 end;
5440
5441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5442 constructor TglBitmap.Create(const aStream: TStream);
5443 begin
5444   Create;
5445   LoadFromStream(aStream);
5446 end;
5447
5448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5449 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5450 var
5451   Image: PByte;
5452   ImageSize: Integer;
5453 begin
5454   Create;
5455   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5456   GetMem(Image, ImageSize);
5457   try
5458     FillChar(Image^, ImageSize, #$FF);
5459     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5460   except
5461     if Assigned(Image) then
5462       FreeMem(Image);
5463     raise;
5464   end;
5465 end;
5466
5467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5468 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5469   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5470 begin
5471   Create;
5472   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5473 end;
5474
5475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5476 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5477 begin
5478   Create;
5479   LoadFromResource(aInstance, aResource, aResType);
5480 end;
5481
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5484 begin
5485   Create;
5486   LoadFromResourceID(aInstance, aResourceID, aResType);
5487 end;
5488
5489 {$IFDEF GLB_SUPPORT_PNG_READ}
5490 {$IF DEFINED(GLB_SDL_IMAGE)}
5491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5492 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5494 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5495 var
5496   Surface: PSDL_Surface;
5497   RWops: PSDL_RWops;
5498 begin
5499   result := false;
5500   RWops := glBitmapCreateRWops(aStream);
5501   try
5502     if IMG_isPNG(RWops) > 0 then begin
5503       Surface := IMG_LoadPNG_RW(RWops);
5504       try
5505         AssignFromSurface(Surface);
5506         result := true;
5507       finally
5508         SDL_FreeSurface(Surface);
5509       end;
5510     end;
5511   finally
5512     SDL_FreeRW(RWops);
5513   end;
5514 end;
5515
5516 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5518 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5519 begin
5520   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5521 end;
5522
5523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5524 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5525 var
5526   StreamPos: Int64;
5527   signature: array [0..7] of byte;
5528   png: png_structp;
5529   png_info: png_infop;
5530
5531   TempHeight, TempWidth: Integer;
5532   Format: TglBitmapFormat;
5533
5534   png_data: pByte;
5535   png_rows: array of pByte;
5536   Row, LineSize: Integer;
5537 begin
5538   result := false;
5539
5540   if not init_libPNG then
5541     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5542
5543   try
5544     // signature
5545     StreamPos := aStream.Position;
5546     aStream.Read(signature{%H-}, 8);
5547     aStream.Position := StreamPos;
5548
5549     if png_check_sig(@signature, 8) <> 0 then begin
5550       // png read struct
5551       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5552       if png = nil then
5553         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5554
5555       // png info
5556       png_info := png_create_info_struct(png);
5557       if png_info = nil then begin
5558         png_destroy_read_struct(@png, nil, nil);
5559         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5560       end;
5561
5562       // set read callback
5563       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5564
5565       // read informations
5566       png_read_info(png, png_info);
5567
5568       // size
5569       TempHeight := png_get_image_height(png, png_info);
5570       TempWidth := png_get_image_width(png, png_info);
5571
5572       // format
5573       case png_get_color_type(png, png_info) of
5574         PNG_COLOR_TYPE_GRAY:
5575           Format := tfLuminance8;
5576         PNG_COLOR_TYPE_GRAY_ALPHA:
5577           Format := tfLuminance8Alpha8;
5578         PNG_COLOR_TYPE_RGB:
5579           Format := tfRGB8;
5580         PNG_COLOR_TYPE_RGB_ALPHA:
5581           Format := tfRGBA8;
5582         else
5583           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5584       end;
5585
5586       // cut upper 8 bit from 16 bit formats
5587       if png_get_bit_depth(png, png_info) > 8 then
5588         png_set_strip_16(png);
5589
5590       // expand bitdepth smaller than 8
5591       if png_get_bit_depth(png, png_info) < 8 then
5592         png_set_expand(png);
5593
5594       // allocating mem for scanlines
5595       LineSize := png_get_rowbytes(png, png_info);
5596       GetMem(png_data, TempHeight * LineSize);
5597       try
5598         SetLength(png_rows, TempHeight);
5599         for Row := Low(png_rows) to High(png_rows) do begin
5600           png_rows[Row] := png_data;
5601           Inc(png_rows[Row], Row * LineSize);
5602         end;
5603
5604         // read complete image into scanlines
5605         png_read_image(png, @png_rows[0]);
5606
5607         // read end
5608         png_read_end(png, png_info);
5609
5610         // destroy read struct
5611         png_destroy_read_struct(@png, @png_info, nil);
5612
5613         SetLength(png_rows, 0);
5614
5615         // set new data
5616         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5617
5618         result := true;
5619       except
5620         if Assigned(png_data) then
5621           FreeMem(png_data);
5622         raise;
5623       end;
5624     end;
5625   finally
5626     quit_libPNG;
5627   end;
5628 end;
5629
5630 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5632 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5633 var
5634   StreamPos: Int64;
5635   Png: TPNGObject;
5636   Header: String[8];
5637   Row, Col, PixSize, LineSize: Integer;
5638   NewImage, pSource, pDest, pAlpha: pByte;
5639   PngFormat: TglBitmapFormat;
5640   FormatDesc: TFormatDescriptor;
5641
5642 const
5643   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5644
5645 begin
5646   result := false;
5647
5648   StreamPos := aStream.Position;
5649   aStream.Read(Header[0], SizeOf(Header));
5650   aStream.Position := StreamPos;
5651
5652   {Test if the header matches}
5653   if Header = PngHeader then begin
5654     Png := TPNGObject.Create;
5655     try
5656       Png.LoadFromStream(aStream);
5657
5658       case Png.Header.ColorType of
5659         COLOR_GRAYSCALE:
5660           PngFormat := tfLuminance8;
5661         COLOR_GRAYSCALEALPHA:
5662           PngFormat := tfLuminance8Alpha8;
5663         COLOR_RGB:
5664           PngFormat := tfBGR8;
5665         COLOR_RGBALPHA:
5666           PngFormat := tfBGRA8;
5667         else
5668           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5669       end;
5670
5671       FormatDesc := TFormatDescriptor.Get(PngFormat);
5672       PixSize    := Round(FormatDesc.PixelSize);
5673       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5674
5675       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5676       try
5677         pDest := NewImage;
5678
5679         case Png.Header.ColorType of
5680           COLOR_RGB, COLOR_GRAYSCALE:
5681             begin
5682               for Row := 0 to Png.Height -1 do begin
5683                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5684                 Inc(pDest, LineSize);
5685               end;
5686             end;
5687           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5688             begin
5689               PixSize := PixSize -1;
5690
5691               for Row := 0 to Png.Height -1 do begin
5692                 pSource := Png.Scanline[Row];
5693                 pAlpha := pByte(Png.AlphaScanline[Row]);
5694
5695                 for Col := 0 to Png.Width -1 do begin
5696                   Move (pSource^, pDest^, PixSize);
5697                   Inc(pSource, PixSize);
5698                   Inc(pDest, PixSize);
5699
5700                   pDest^ := pAlpha^;
5701                   inc(pAlpha);
5702                   Inc(pDest);
5703                 end;
5704               end;
5705             end;
5706           else
5707             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5708         end;
5709
5710         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5711
5712         result := true;
5713       except
5714         if Assigned(NewImage) then
5715           FreeMem(NewImage);
5716         raise;
5717       end;
5718     finally
5719       Png.Free;
5720     end;
5721   end;
5722 end;
5723 {$IFEND}
5724 {$ENDIF}
5725
5726 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5727 {$IFDEF GLB_LIB_PNG}
5728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5729 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5730 begin
5731   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5732 end;
5733 {$ENDIF}
5734
5735 {$IF DEFINED(GLB_LIB_PNG)}
5736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5737 procedure TglBitmap.SavePNG(const aStream: TStream);
5738 var
5739   png: png_structp;
5740   png_info: png_infop;
5741   png_rows: array of pByte;
5742   LineSize: Integer;
5743   ColorType: Integer;
5744   Row: Integer;
5745   FormatDesc: TFormatDescriptor;
5746 begin
5747   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5748     raise EglBitmapUnsupportedFormat.Create(Format);
5749
5750   if not init_libPNG then
5751     raise Exception.Create('unable to initialize libPNG.');
5752
5753   try
5754     case Format of
5755       tfAlpha8, tfLuminance8:
5756         ColorType := PNG_COLOR_TYPE_GRAY;
5757       tfLuminance8Alpha8:
5758         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5759       tfBGR8, tfRGB8:
5760         ColorType := PNG_COLOR_TYPE_RGB;
5761       tfBGRA8, tfRGBA8:
5762         ColorType := PNG_COLOR_TYPE_RGBA;
5763       else
5764         raise EglBitmapUnsupportedFormat.Create(Format);
5765     end;
5766
5767     FormatDesc := TFormatDescriptor.Get(Format);
5768     LineSize := FormatDesc.GetSize(Width, 1);
5769
5770     // creating array for scanline
5771     SetLength(png_rows, Height);
5772     try
5773       for Row := 0 to Height - 1 do begin
5774         png_rows[Row] := Data;
5775         Inc(png_rows[Row], Row * LineSize)
5776       end;
5777
5778       // write struct
5779       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5780       if png = nil then
5781         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5782
5783       // create png info
5784       png_info := png_create_info_struct(png);
5785       if png_info = nil then begin
5786         png_destroy_write_struct(@png, nil);
5787         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5788       end;
5789
5790       // set read callback
5791       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5792
5793       // set compression
5794       png_set_compression_level(png, 6);
5795
5796       if Format in [tfBGR8, tfBGRA8] then
5797         png_set_bgr(png);
5798
5799       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5800       png_write_info(png, png_info);
5801       png_write_image(png, @png_rows[0]);
5802       png_write_end(png, png_info);
5803       png_destroy_write_struct(@png, @png_info);
5804     finally
5805       SetLength(png_rows, 0);
5806     end;
5807   finally
5808     quit_libPNG;
5809   end;
5810 end;
5811
5812 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5814 procedure TglBitmap.SavePNG(const aStream: TStream);
5815 var
5816   Png: TPNGObject;
5817
5818   pSource, pDest: pByte;
5819   X, Y, PixSize: Integer;
5820   ColorType: Cardinal;
5821   Alpha: Boolean;
5822
5823   pTemp: pByte;
5824   Temp: Byte;
5825 begin
5826   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5827     raise EglBitmapUnsupportedFormat.Create(Format);
5828
5829   case Format of
5830     tfAlpha8, tfLuminance8: begin
5831       ColorType := COLOR_GRAYSCALE;
5832       PixSize   := 1;
5833       Alpha     := false;
5834     end;
5835     tfLuminance8Alpha8: begin
5836       ColorType := COLOR_GRAYSCALEALPHA;
5837       PixSize   := 1;
5838       Alpha     := true;
5839     end;
5840     tfBGR8, tfRGB8: begin
5841       ColorType := COLOR_RGB;
5842       PixSize   := 3;
5843       Alpha     := false;
5844     end;
5845     tfBGRA8, tfRGBA8: begin
5846       ColorType := COLOR_RGBALPHA;
5847       PixSize   := 3;
5848       Alpha     := true
5849     end;
5850   else
5851     raise EglBitmapUnsupportedFormat.Create(Format);
5852   end;
5853
5854   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5855   try
5856     // Copy ImageData
5857     pSource := Data;
5858     for Y := 0 to Height -1 do begin
5859       pDest := png.ScanLine[Y];
5860       for X := 0 to Width -1 do begin
5861         Move(pSource^, pDest^, PixSize);
5862         Inc(pDest, PixSize);
5863         Inc(pSource, PixSize);
5864         if Alpha then begin
5865           png.AlphaScanline[Y]^[X] := pSource^;
5866           Inc(pSource);
5867         end;
5868       end;
5869
5870       // convert RGB line to BGR
5871       if Format in [tfRGB8, tfRGBA8] then begin
5872         pTemp := png.ScanLine[Y];
5873         for X := 0 to Width -1 do begin
5874           Temp := pByteArray(pTemp)^[0];
5875           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5876           pByteArray(pTemp)^[2] := Temp;
5877           Inc(pTemp, 3);
5878         end;
5879       end;
5880     end;
5881
5882     // Save to Stream
5883     Png.CompressionLevel := 6;
5884     Png.SaveToStream(aStream);
5885   finally
5886     FreeAndNil(Png);
5887   end;
5888 end;
5889 {$IFEND}
5890 {$ENDIF}
5891
5892 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5893 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5895 {$IFDEF GLB_LIB_JPEG}
5896 type
5897   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5898   glBitmap_libJPEG_source_mgr = record
5899     pub: jpeg_source_mgr;
5900
5901     SrcStream: TStream;
5902     SrcBuffer: array [1..4096] of byte;
5903   end;
5904
5905   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5906   glBitmap_libJPEG_dest_mgr = record
5907     pub: jpeg_destination_mgr;
5908
5909     DestStream: TStream;
5910     DestBuffer: array [1..4096] of byte;
5911   end;
5912
5913 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5914 begin
5915   //DUMMY
5916 end;
5917
5918
5919 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5920 begin
5921   //DUMMY
5922 end;
5923
5924
5925 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5926 begin
5927   //DUMMY
5928 end;
5929
5930 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5931 begin
5932   //DUMMY
5933 end;
5934
5935
5936 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5937 begin
5938   //DUMMY
5939 end;
5940
5941
5942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5943 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5944 var
5945   src: glBitmap_libJPEG_source_mgr_ptr;
5946   bytes: integer;
5947 begin
5948   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5949
5950   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5951         if (bytes <= 0) then begin
5952                 src^.SrcBuffer[1] := $FF;
5953                 src^.SrcBuffer[2] := JPEG_EOI;
5954                 bytes := 2;
5955         end;
5956
5957         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5958         src^.pub.bytes_in_buffer := bytes;
5959
5960   result := true;
5961 end;
5962
5963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5964 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5965 var
5966   src: glBitmap_libJPEG_source_mgr_ptr;
5967 begin
5968   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5969
5970   if num_bytes > 0 then begin
5971     // wanted byte isn't in buffer so set stream position and read buffer
5972     if num_bytes > src^.pub.bytes_in_buffer then begin
5973       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5974       src^.pub.fill_input_buffer(cinfo);
5975     end else begin
5976       // wanted byte is in buffer so only skip
5977                 inc(src^.pub.next_input_byte, num_bytes);
5978                 dec(src^.pub.bytes_in_buffer, num_bytes);
5979     end;
5980   end;
5981 end;
5982
5983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5984 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5985 var
5986   dest: glBitmap_libJPEG_dest_mgr_ptr;
5987 begin
5988   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5989
5990   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5991     // write complete buffer
5992     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5993
5994     // reset buffer
5995     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5996     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5997   end;
5998
5999   result := true;
6000 end;
6001
6002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6003 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6004 var
6005   Idx: Integer;
6006   dest: glBitmap_libJPEG_dest_mgr_ptr;
6007 begin
6008   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6009
6010   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6011     // check for endblock
6012     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6013       // write endblock
6014       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6015
6016       // leave
6017       break;
6018     end else
6019       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6020   end;
6021 end;
6022 {$ENDIF}
6023
6024 {$IFDEF GLB_SUPPORT_JPEG_READ}
6025 {$IF DEFINED(GLB_SDL_IMAGE)}
6026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6027 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6028 var
6029   Surface: PSDL_Surface;
6030   RWops: PSDL_RWops;
6031 begin
6032   result := false;
6033
6034   RWops := glBitmapCreateRWops(aStream);
6035   try
6036     if IMG_isJPG(RWops) > 0 then begin
6037       Surface := IMG_LoadJPG_RW(RWops);
6038       try
6039         AssignFromSurface(Surface);
6040         result := true;
6041       finally
6042         SDL_FreeSurface(Surface);
6043       end;
6044     end;
6045   finally
6046     SDL_FreeRW(RWops);
6047   end;
6048 end;
6049
6050 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6052 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6053 var
6054   StreamPos: Int64;
6055   Temp: array[0..1]of Byte;
6056
6057   jpeg: jpeg_decompress_struct;
6058   jpeg_err: jpeg_error_mgr;
6059
6060   IntFormat: TglBitmapFormat;
6061   pImage: pByte;
6062   TempHeight, TempWidth: Integer;
6063
6064   pTemp: pByte;
6065   Row: Integer;
6066
6067   FormatDesc: TFormatDescriptor;
6068 begin
6069   result := false;
6070
6071   if not init_libJPEG then
6072     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6073
6074   try
6075     // reading first two bytes to test file and set cursor back to begin
6076     StreamPos := aStream.Position;
6077     aStream.Read({%H-}Temp[0], 2);
6078     aStream.Position := StreamPos;
6079
6080     // if Bitmap then read file.
6081     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6082       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6083       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6084
6085       // error managment
6086       jpeg.err := jpeg_std_error(@jpeg_err);
6087       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6088       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6089
6090       // decompression struct
6091       jpeg_create_decompress(@jpeg);
6092
6093       // allocation space for streaming methods
6094       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6095
6096       // seeting up custom functions
6097       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6098         pub.init_source       := glBitmap_libJPEG_init_source;
6099         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6100         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6101         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6102         pub.term_source       := glBitmap_libJPEG_term_source;
6103
6104         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6105         pub.next_input_byte := nil;   // until buffer loaded
6106
6107         SrcStream := aStream;
6108       end;
6109
6110       // set global decoding state
6111       jpeg.global_state := DSTATE_START;
6112
6113       // read header of jpeg
6114       jpeg_read_header(@jpeg, false);
6115
6116       // setting output parameter
6117       case jpeg.jpeg_color_space of
6118         JCS_GRAYSCALE:
6119           begin
6120             jpeg.out_color_space := JCS_GRAYSCALE;
6121             IntFormat := tfLuminance8;
6122           end;
6123         else
6124           jpeg.out_color_space := JCS_RGB;
6125           IntFormat := tfRGB8;
6126       end;
6127
6128       // reading image
6129       jpeg_start_decompress(@jpeg);
6130
6131       TempHeight := jpeg.output_height;
6132       TempWidth := jpeg.output_width;
6133
6134       FormatDesc := TFormatDescriptor.Get(IntFormat);
6135
6136       // creating new image
6137       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6138       try
6139         pTemp := pImage;
6140
6141         for Row := 0 to TempHeight -1 do begin
6142           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6143           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6144         end;
6145
6146         // finish decompression
6147         jpeg_finish_decompress(@jpeg);
6148
6149         // destroy decompression
6150         jpeg_destroy_decompress(@jpeg);
6151
6152         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6153
6154         result := true;
6155       except
6156         if Assigned(pImage) then
6157           FreeMem(pImage);
6158         raise;
6159       end;
6160     end;
6161   finally
6162     quit_libJPEG;
6163   end;
6164 end;
6165
6166 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6168 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6169 var
6170   bmp: TBitmap;
6171   jpg: TJPEGImage;
6172   StreamPos: Int64;
6173   Temp: array[0..1]of Byte;
6174 begin
6175   result := false;
6176
6177   // reading first two bytes to test file and set cursor back to begin
6178   StreamPos := aStream.Position;
6179   aStream.Read(Temp[0], 2);
6180   aStream.Position := StreamPos;
6181
6182   // if Bitmap then read file.
6183   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6184     bmp := TBitmap.Create;
6185     try
6186       jpg := TJPEGImage.Create;
6187       try
6188         jpg.LoadFromStream(aStream);
6189         bmp.Assign(jpg);
6190         result := AssignFromBitmap(bmp);
6191       finally
6192         jpg.Free;
6193       end;
6194     finally
6195       bmp.Free;
6196     end;
6197   end;
6198 end;
6199 {$IFEND}
6200 {$ENDIF}
6201
6202 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6203 {$IF DEFINED(GLB_LIB_JPEG)}
6204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6205 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6206 var
6207   jpeg: jpeg_compress_struct;
6208   jpeg_err: jpeg_error_mgr;
6209   Row: Integer;
6210   pTemp, pTemp2: pByte;
6211
6212   procedure CopyRow(pDest, pSource: pByte);
6213   var
6214     X: Integer;
6215   begin
6216     for X := 0 to Width - 1 do begin
6217       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6218       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6219       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6220       Inc(pDest, 3);
6221       Inc(pSource, 3);
6222     end;
6223   end;
6224
6225 begin
6226   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6227     raise EglBitmapUnsupportedFormat.Create(Format);
6228
6229   if not init_libJPEG then
6230     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6231
6232   try
6233     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6234     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6235
6236     // error managment
6237     jpeg.err := jpeg_std_error(@jpeg_err);
6238     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6239     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6240
6241     // compression struct
6242     jpeg_create_compress(@jpeg);
6243
6244     // allocation space for streaming methods
6245     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6246
6247     // seeting up custom functions
6248     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6249       pub.init_destination    := glBitmap_libJPEG_init_destination;
6250       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6251       pub.term_destination    := glBitmap_libJPEG_term_destination;
6252
6253       pub.next_output_byte  := @DestBuffer[1];
6254       pub.free_in_buffer    := Length(DestBuffer);
6255
6256       DestStream := aStream;
6257     end;
6258
6259     // very important state
6260     jpeg.global_state := CSTATE_START;
6261     jpeg.image_width  := Width;
6262     jpeg.image_height := Height;
6263     case Format of
6264       tfAlpha8, tfLuminance8: begin
6265         jpeg.input_components := 1;
6266         jpeg.in_color_space   := JCS_GRAYSCALE;
6267       end;
6268       tfRGB8, tfBGR8: begin
6269         jpeg.input_components := 3;
6270         jpeg.in_color_space   := JCS_RGB;
6271       end;
6272     end;
6273
6274     jpeg_set_defaults(@jpeg);
6275     jpeg_set_quality(@jpeg, 95, true);
6276     jpeg_start_compress(@jpeg, true);
6277     pTemp := Data;
6278
6279     if Format = tfBGR8 then
6280       GetMem(pTemp2, fRowSize)
6281     else
6282       pTemp2 := pTemp;
6283
6284     try
6285       for Row := 0 to jpeg.image_height -1 do begin
6286         // prepare row
6287         if Format = tfBGR8 then
6288           CopyRow(pTemp2, pTemp)
6289         else
6290           pTemp2 := pTemp;
6291
6292         // write row
6293         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6294         inc(pTemp, fRowSize);
6295       end;
6296     finally
6297       // free memory
6298       if Format = tfBGR8 then
6299         FreeMem(pTemp2);
6300     end;
6301     jpeg_finish_compress(@jpeg);
6302     jpeg_destroy_compress(@jpeg);
6303   finally
6304     quit_libJPEG;
6305   end;
6306 end;
6307
6308 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6310 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6311 var
6312   Bmp: TBitmap;
6313   Jpg: TJPEGImage;
6314 begin
6315   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6316     raise EglBitmapUnsupportedFormat.Create(Format);
6317
6318   Bmp := TBitmap.Create;
6319   try
6320     Jpg := TJPEGImage.Create;
6321     try
6322       AssignToBitmap(Bmp);
6323       if (Format in [tfAlpha8, tfLuminance8]) then begin
6324         Jpg.Grayscale   := true;
6325         Jpg.PixelFormat := jf8Bit;
6326       end;
6327       Jpg.Assign(Bmp);
6328       Jpg.SaveToStream(aStream);
6329     finally
6330       FreeAndNil(Jpg);
6331     end;
6332   finally
6333     FreeAndNil(Bmp);
6334   end;
6335 end;
6336 {$IFEND}
6337 {$ENDIF}
6338
6339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6340 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6342 const
6343   BMP_MAGIC          = $4D42;
6344
6345   BMP_COMP_RGB       = 0;
6346   BMP_COMP_RLE8      = 1;
6347   BMP_COMP_RLE4      = 2;
6348   BMP_COMP_BITFIELDS = 3;
6349
6350 type
6351   TBMPHeader = packed record
6352     bfType: Word;
6353     bfSize: Cardinal;
6354     bfReserved1: Word;
6355     bfReserved2: Word;
6356     bfOffBits: Cardinal;
6357   end;
6358
6359   TBMPInfo = packed record
6360     biSize: Cardinal;
6361     biWidth: Longint;
6362     biHeight: Longint;
6363     biPlanes: Word;
6364     biBitCount: Word;
6365     biCompression: Cardinal;
6366     biSizeImage: Cardinal;
6367     biXPelsPerMeter: Longint;
6368     biYPelsPerMeter: Longint;
6369     biClrUsed: Cardinal;
6370     biClrImportant: Cardinal;
6371   end;
6372
6373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6374 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6375
6376   //////////////////////////////////////////////////////////////////////////////////////////////////
6377   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6378   begin
6379     result := tfEmpty;
6380     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6381     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6382
6383     //Read Compression
6384     case aInfo.biCompression of
6385       BMP_COMP_RLE4,
6386       BMP_COMP_RLE8: begin
6387         raise EglBitmapException.Create('RLE compression is not supported');
6388       end;
6389       BMP_COMP_BITFIELDS: begin
6390         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6391           aStream.Read(aMask.r, SizeOf(aMask.r));
6392           aStream.Read(aMask.g, SizeOf(aMask.g));
6393           aStream.Read(aMask.b, SizeOf(aMask.b));
6394           aStream.Read(aMask.a, SizeOf(aMask.a));
6395         end else
6396           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6397       end;
6398     end;
6399
6400     //get suitable format
6401     case aInfo.biBitCount of
6402        8: result := tfLuminance8;
6403       16: result := tfBGR5;
6404       24: result := tfBGR8;
6405       32: result := tfBGRA8;
6406     end;
6407   end;
6408
6409   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6410   var
6411     i, c: Integer;
6412     ColorTable: TbmpColorTable;
6413   begin
6414     result := nil;
6415     if (aInfo.biBitCount >= 16) then
6416       exit;
6417     aFormat := tfLuminance8;
6418     c := aInfo.biClrUsed;
6419     if (c = 0) then
6420       c := 1 shl aInfo.biBitCount;
6421     SetLength(ColorTable, c);
6422     for i := 0 to c-1 do begin
6423       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6424       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6425         aFormat := tfRGB8;
6426     end;
6427
6428     result := TbmpColorTableFormat.Create;
6429     result.PixelSize  := aInfo.biBitCount / 8;
6430     result.ColorTable := ColorTable;
6431     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6432   end;
6433
6434   //////////////////////////////////////////////////////////////////////////////////////////////////
6435   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6436     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6437   var
6438     TmpFormat: TglBitmapFormat;
6439     FormatDesc: TFormatDescriptor;
6440   begin
6441     result := nil;
6442     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6443       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6444         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6445         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6446           aFormat := FormatDesc.Format;
6447           exit;
6448         end;
6449       end;
6450
6451       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6452         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6453       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6454         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6455
6456       result := TbmpBitfieldFormat.Create;
6457       result.PixelSize := aInfo.biBitCount / 8;
6458       result.RedMask   := aMask.r;
6459       result.GreenMask := aMask.g;
6460       result.BlueMask  := aMask.b;
6461       result.AlphaMask := aMask.a;
6462     end;
6463   end;
6464
6465 var
6466   //simple types
6467   StartPos: Int64;
6468   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6469   PaddingBuff: Cardinal;
6470   LineBuf, ImageData, TmpData: PByte;
6471   SourceMD, DestMD: Pointer;
6472   BmpFormat: TglBitmapFormat;
6473
6474   //records
6475   Mask: TglBitmapColorRec;
6476   Header: TBMPHeader;
6477   Info: TBMPInfo;
6478
6479   //classes
6480   SpecialFormat: TFormatDescriptor;
6481   FormatDesc: TFormatDescriptor;
6482
6483   //////////////////////////////////////////////////////////////////////////////////////////////////
6484   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6485   var
6486     i: Integer;
6487     Pixel: TglBitmapPixelData;
6488   begin
6489     aStream.Read(aLineBuf^, rbLineSize);
6490     SpecialFormat.PreparePixel(Pixel);
6491     for i := 0 to Info.biWidth-1 do begin
6492       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6493       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6494       FormatDesc.Map(Pixel, aData, DestMD);
6495     end;
6496   end;
6497
6498 begin
6499   result        := false;
6500   BmpFormat     := tfEmpty;
6501   SpecialFormat := nil;
6502   LineBuf       := nil;
6503   SourceMD      := nil;
6504   DestMD        := nil;
6505
6506   // Header
6507   StartPos := aStream.Position;
6508   aStream.Read(Header{%H-}, SizeOf(Header));
6509
6510   if Header.bfType = BMP_MAGIC then begin
6511     try try
6512       BmpFormat        := ReadInfo(Info, Mask);
6513       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6514       if not Assigned(SpecialFormat) then
6515         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6516       aStream.Position := StartPos + Header.bfOffBits;
6517
6518       if (BmpFormat <> tfEmpty) then begin
6519         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6520         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6521         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6522         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6523
6524         //get Memory
6525         DestMD    := FormatDesc.CreateMappingData;
6526         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6527         GetMem(ImageData, ImageSize);
6528         if Assigned(SpecialFormat) then begin
6529           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6530           SourceMD := SpecialFormat.CreateMappingData;
6531         end;
6532
6533         //read Data
6534         try try
6535           FillChar(ImageData^, ImageSize, $FF);
6536           TmpData := ImageData;
6537           if (Info.biHeight > 0) then
6538             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6539           for i := 0 to Abs(Info.biHeight)-1 do begin
6540             if Assigned(SpecialFormat) then
6541               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6542             else
6543               aStream.Read(TmpData^, wbLineSize);   //else only read data
6544             if (Info.biHeight > 0) then
6545               dec(TmpData, wbLineSize)
6546             else
6547               inc(TmpData, wbLineSize);
6548             aStream.Read(PaddingBuff{%H-}, Padding);
6549           end;
6550           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6551           result := true;
6552         finally
6553           if Assigned(LineBuf) then
6554             FreeMem(LineBuf);
6555           if Assigned(SourceMD) then
6556             SpecialFormat.FreeMappingData(SourceMD);
6557           FormatDesc.FreeMappingData(DestMD);
6558         end;
6559         except
6560           if Assigned(ImageData) then
6561             FreeMem(ImageData);
6562           raise;
6563         end;
6564       end else
6565         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6566     except
6567       aStream.Position := StartPos;
6568       raise;
6569     end;
6570     finally
6571       FreeAndNil(SpecialFormat);
6572     end;
6573   end
6574     else aStream.Position := StartPos;
6575 end;
6576
6577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6578 procedure TglBitmap.SaveBMP(const aStream: TStream);
6579 var
6580   Header: TBMPHeader;
6581   Info: TBMPInfo;
6582   Converter: TbmpColorTableFormat;
6583   FormatDesc: TFormatDescriptor;
6584   SourceFD, DestFD: Pointer;
6585   pData, srcData, dstData, ConvertBuffer: pByte;
6586
6587   Pixel: TglBitmapPixelData;
6588   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6589   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6590
6591   PaddingBuff: Cardinal;
6592
6593   function GetLineWidth : Integer;
6594   begin
6595     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6596   end;
6597
6598 begin
6599   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6600     raise EglBitmapUnsupportedFormat.Create(Format);
6601
6602   Converter  := nil;
6603   FormatDesc := TFormatDescriptor.Get(Format);
6604   ImageSize  := FormatDesc.GetSize(Dimension);
6605
6606   FillChar(Header{%H-}, SizeOf(Header), 0);
6607   Header.bfType      := BMP_MAGIC;
6608   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6609   Header.bfReserved1 := 0;
6610   Header.bfReserved2 := 0;
6611   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6612
6613   FillChar(Info{%H-}, SizeOf(Info), 0);
6614   Info.biSize        := SizeOf(Info);
6615   Info.biWidth       := Width;
6616   Info.biHeight      := Height;
6617   Info.biPlanes      := 1;
6618   Info.biCompression := BMP_COMP_RGB;
6619   Info.biSizeImage   := ImageSize;
6620
6621   try
6622     case Format of
6623       tfLuminance4: begin
6624         Info.biBitCount  := 4;
6625         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6626         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6627         Converter           := TbmpColorTableFormat.Create;
6628         Converter.PixelSize := 0.5;
6629         Converter.Format    := Format;
6630         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6631         Converter.CreateColorTable;
6632       end;
6633
6634       tfR3G3B2, tfLuminance8: begin
6635         Info.biBitCount  :=  8;
6636         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6637         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6638         Converter           := TbmpColorTableFormat.Create;
6639         Converter.PixelSize := 1;
6640         Converter.Format    := Format;
6641         if (Format = tfR3G3B2) then begin
6642           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6643           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6644         end else
6645           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6646         Converter.CreateColorTable;
6647       end;
6648
6649       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6650       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6651         Info.biBitCount    := 16;
6652         Info.biCompression := BMP_COMP_BITFIELDS;
6653       end;
6654
6655       tfBGR8, tfRGB8: begin
6656         Info.biBitCount := 24;
6657       end;
6658
6659       tfRGB10, tfRGB10A2, tfRGBA8,
6660       tfBGR10, tfBGR10A2, tfBGRA8: begin
6661         Info.biBitCount    := 32;
6662         Info.biCompression := BMP_COMP_BITFIELDS;
6663       end;
6664     else
6665       raise EglBitmapUnsupportedFormat.Create(Format);
6666     end;
6667     Info.biXPelsPerMeter := 2835;
6668     Info.biYPelsPerMeter := 2835;
6669
6670     // prepare bitmasks
6671     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6672       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6673       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6674
6675       RedMask    := FormatDesc.RedMask;
6676       GreenMask  := FormatDesc.GreenMask;
6677       BlueMask   := FormatDesc.BlueMask;
6678       AlphaMask  := FormatDesc.AlphaMask;
6679     end;
6680
6681     // headers
6682     aStream.Write(Header, SizeOf(Header));
6683     aStream.Write(Info, SizeOf(Info));
6684
6685     // colortable
6686     if Assigned(Converter) then
6687       aStream.Write(Converter.ColorTable[0].b,
6688         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6689
6690     // bitmasks
6691     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6692       aStream.Write(RedMask,   SizeOf(Cardinal));
6693       aStream.Write(GreenMask, SizeOf(Cardinal));
6694       aStream.Write(BlueMask,  SizeOf(Cardinal));
6695       aStream.Write(AlphaMask, SizeOf(Cardinal));
6696     end;
6697
6698     // image data
6699     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6700     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6701     Padding     := GetLineWidth - wbLineSize;
6702     PaddingBuff := 0;
6703
6704     pData := Data;
6705     inc(pData, (Height-1) * rbLineSize);
6706
6707     // prepare row buffer. But only for RGB because RGBA supports color masks
6708     // so it's possible to change color within the image.
6709     if Assigned(Converter) then begin
6710       FormatDesc.PreparePixel(Pixel);
6711       GetMem(ConvertBuffer, wbLineSize);
6712       SourceFD := FormatDesc.CreateMappingData;
6713       DestFD   := Converter.CreateMappingData;
6714     end else
6715       ConvertBuffer := nil;
6716
6717     try
6718       for LineIdx := 0 to Height - 1 do begin
6719         // preparing row
6720         if Assigned(Converter) then begin
6721           srcData := pData;
6722           dstData := ConvertBuffer;
6723           for PixelIdx := 0 to Info.biWidth-1 do begin
6724             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6725             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6726             Converter.Map(Pixel, dstData, DestFD);
6727           end;
6728           aStream.Write(ConvertBuffer^, wbLineSize);
6729         end else begin
6730           aStream.Write(pData^, rbLineSize);
6731         end;
6732         dec(pData, rbLineSize);
6733         if (Padding > 0) then
6734           aStream.Write(PaddingBuff, Padding);
6735       end;
6736     finally
6737       // destroy row buffer
6738       if Assigned(ConvertBuffer) then begin
6739         FormatDesc.FreeMappingData(SourceFD);
6740         Converter.FreeMappingData(DestFD);
6741         FreeMem(ConvertBuffer);
6742       end;
6743     end;
6744   finally
6745     if Assigned(Converter) then
6746       Converter.Free;
6747   end;
6748 end;
6749
6750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6751 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6753 type
6754   TTGAHeader = packed record
6755     ImageID: Byte;
6756     ColorMapType: Byte;
6757     ImageType: Byte;
6758     //ColorMapSpec: Array[0..4] of Byte;
6759     ColorMapStart: Word;
6760     ColorMapLength: Word;
6761     ColorMapEntrySize: Byte;
6762     OrigX: Word;
6763     OrigY: Word;
6764     Width: Word;
6765     Height: Word;
6766     Bpp: Byte;
6767     ImageDesc: Byte;
6768   end;
6769
6770 const
6771   TGA_UNCOMPRESSED_RGB  =  2;
6772   TGA_UNCOMPRESSED_GRAY =  3;
6773   TGA_COMPRESSED_RGB    = 10;
6774   TGA_COMPRESSED_GRAY   = 11;
6775
6776   TGA_NONE_COLOR_TABLE  = 0;
6777
6778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6779 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6780 var
6781   Header: TTGAHeader;
6782   ImageData: System.PByte;
6783   StartPosition: Int64;
6784   PixelSize, LineSize: Integer;
6785   tgaFormat: TglBitmapFormat;
6786   FormatDesc: TFormatDescriptor;
6787   Counter: packed record
6788     X, Y: packed record
6789       low, high, dir: Integer;
6790     end;
6791   end;
6792
6793 const
6794   CACHE_SIZE = $4000;
6795
6796   ////////////////////////////////////////////////////////////////////////////////////////
6797   procedure ReadUncompressed;
6798   var
6799     i, j: Integer;
6800     buf, tmp1, tmp2: System.PByte;
6801   begin
6802     buf := nil;
6803     if (Counter.X.dir < 0) then
6804       GetMem(buf, LineSize);
6805     try
6806       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6807         tmp1 := ImageData;
6808         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
6809         if (Counter.X.dir < 0) then begin               //flip X
6810           aStream.Read(buf^, LineSize);
6811           tmp2 := buf;
6812           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
6813           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6814             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6815               tmp1^ := tmp2^;
6816               inc(tmp1);
6817               inc(tmp2);
6818             end;
6819             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6820           end;
6821         end else
6822           aStream.Read(tmp1^, LineSize);
6823         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6824       end;
6825     finally
6826       if Assigned(buf) then
6827         FreeMem(buf);
6828     end;
6829   end;
6830
6831   ////////////////////////////////////////////////////////////////////////////////////////
6832   procedure ReadCompressed;
6833
6834     /////////////////////////////////////////////////////////////////
6835     var
6836       TmpData: System.PByte;
6837       LinePixelsRead: Integer;
6838     procedure CheckLine;
6839     begin
6840       if (LinePixelsRead >= Header.Width) then begin
6841         LinePixelsRead := 0;
6842         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6843         TmpData := ImageData;
6844         inc(TmpData, Counter.Y.low * LineSize);           //set line
6845         if (Counter.X.dir < 0) then                       //if x flipped then
6846           inc(TmpData, LineSize - PixelSize);             //set last pixel
6847       end;
6848     end;
6849
6850     /////////////////////////////////////////////////////////////////
6851     var
6852       Cache: PByte;
6853       CacheSize, CachePos: Integer;
6854     procedure CachedRead(out Buffer; Count: Integer);
6855     var
6856       BytesRead: Integer;
6857     begin
6858       if (CachePos + Count > CacheSize) then begin
6859         //if buffer overflow save non read bytes
6860         BytesRead := 0;
6861         if (CacheSize - CachePos > 0) then begin
6862           BytesRead := CacheSize - CachePos;
6863           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6864           inc(CachePos, BytesRead);
6865         end;
6866
6867         //load cache from file
6868         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6869         aStream.Read(Cache^, CacheSize);
6870         CachePos := 0;
6871
6872         //read rest of requested bytes
6873         if (Count - BytesRead > 0) then begin
6874           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6875           inc(CachePos, Count - BytesRead);
6876         end;
6877       end else begin
6878         //if no buffer overflow just read the data
6879         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6880         inc(CachePos, Count);
6881       end;
6882     end;
6883
6884     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6885     begin
6886       case PixelSize of
6887         1: begin
6888           aBuffer^ := aData^;
6889           inc(aBuffer, Counter.X.dir);
6890         end;
6891         2: begin
6892           PWord(aBuffer)^ := PWord(aData)^;
6893           inc(aBuffer, 2 * Counter.X.dir);
6894         end;
6895         3: begin
6896           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6897           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6898           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6899           inc(aBuffer, 3 * Counter.X.dir);
6900         end;
6901         4: begin
6902           PCardinal(aBuffer)^ := PCardinal(aData)^;
6903           inc(aBuffer, 4 * Counter.X.dir);
6904         end;
6905       end;
6906     end;
6907
6908   var
6909     TotalPixelsToRead, TotalPixelsRead: Integer;
6910     Temp: Byte;
6911     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6912     PixelRepeat: Boolean;
6913     PixelsToRead, PixelCount: Integer;
6914   begin
6915     CacheSize := 0;
6916     CachePos  := 0;
6917
6918     TotalPixelsToRead := Header.Width * Header.Height;
6919     TotalPixelsRead   := 0;
6920     LinePixelsRead    := 0;
6921
6922     GetMem(Cache, CACHE_SIZE);
6923     try
6924       TmpData := ImageData;
6925       inc(TmpData, Counter.Y.low * LineSize);           //set line
6926       if (Counter.X.dir < 0) then                       //if x flipped then
6927         inc(TmpData, LineSize - PixelSize);             //set last pixel
6928
6929       repeat
6930         //read CommandByte
6931         CachedRead(Temp, 1);
6932         PixelRepeat  := (Temp and $80) > 0;
6933         PixelsToRead := (Temp and $7F) + 1;
6934         inc(TotalPixelsRead, PixelsToRead);
6935
6936         if PixelRepeat then
6937           CachedRead(buf[0], PixelSize);
6938         while (PixelsToRead > 0) do begin
6939           CheckLine;
6940           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6941           while (PixelCount > 0) do begin
6942             if not PixelRepeat then
6943               CachedRead(buf[0], PixelSize);
6944             PixelToBuffer(@buf[0], TmpData);
6945             inc(LinePixelsRead);
6946             dec(PixelsToRead);
6947             dec(PixelCount);
6948           end;
6949         end;
6950       until (TotalPixelsRead >= TotalPixelsToRead);
6951     finally
6952       FreeMem(Cache);
6953     end;
6954   end;
6955
6956   function IsGrayFormat: Boolean;
6957   begin
6958     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6959   end;
6960
6961 begin
6962   result := false;
6963
6964   // reading header to test file and set cursor back to begin
6965   StartPosition := aStream.Position;
6966   aStream.Read(Header{%H-}, SizeOf(Header));
6967
6968   // no colormapped files
6969   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6970     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6971   begin
6972     try
6973       if Header.ImageID <> 0 then       // skip image ID
6974         aStream.Position := aStream.Position + Header.ImageID;
6975
6976       tgaFormat := tfEmpty;
6977       case Header.Bpp of
6978          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6979                0: tgaFormat := tfLuminance8;
6980                8: tgaFormat := tfAlpha8;
6981             end;
6982
6983         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6984                0: tgaFormat := tfLuminance16;
6985                8: tgaFormat := tfLuminance8Alpha8;
6986             end else case (Header.ImageDesc and $F) of
6987                0: tgaFormat := tfBGR5;
6988                1: tgaFormat := tfBGR5A1;
6989                4: tgaFormat := tfBGRA4;
6990             end;
6991
6992         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6993                0: tgaFormat := tfBGR8;
6994             end;
6995
6996         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6997                2: tgaFormat := tfBGR10A2;
6998                8: tgaFormat := tfBGRA8;
6999             end;
7000       end;
7001
7002       if (tgaFormat = tfEmpty) then
7003         raise EglBitmapException.Create('LoadTga - unsupported format');
7004
7005       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7006       PixelSize  := FormatDesc.GetSize(1, 1);
7007       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7008
7009       GetMem(ImageData, LineSize * Header.Height);
7010       try
7011         //column direction
7012         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7013           Counter.X.low  := Header.Height-1;;
7014           Counter.X.high := 0;
7015           Counter.X.dir  := -1;
7016         end else begin
7017           Counter.X.low  := 0;
7018           Counter.X.high := Header.Height-1;
7019           Counter.X.dir  := 1;
7020         end;
7021
7022         // Row direction
7023         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7024           Counter.Y.low  := 0;
7025           Counter.Y.high := Header.Height-1;
7026           Counter.Y.dir  := 1;
7027         end else begin
7028           Counter.Y.low  := Header.Height-1;;
7029           Counter.Y.high := 0;
7030           Counter.Y.dir  := -1;
7031         end;
7032
7033         // Read Image
7034         case Header.ImageType of
7035           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7036             ReadUncompressed;
7037           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7038             ReadCompressed;
7039         end;
7040
7041         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7042         result := true;
7043       except
7044         if Assigned(ImageData) then
7045           FreeMem(ImageData);
7046         raise;
7047       end;
7048     finally
7049       aStream.Position := StartPosition;
7050     end;
7051   end
7052     else aStream.Position := StartPosition;
7053 end;
7054
7055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7056 procedure TglBitmap.SaveTGA(const aStream: TStream);
7057 var
7058   Header: TTGAHeader;
7059   LineSize, Size, x, y: Integer;
7060   Pixel: TglBitmapPixelData;
7061   LineBuf, SourceData, DestData: PByte;
7062   SourceMD, DestMD: Pointer;
7063   FormatDesc: TFormatDescriptor;
7064   Converter: TFormatDescriptor;
7065 begin
7066   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7067     raise EglBitmapUnsupportedFormat.Create(Format);
7068
7069   //prepare header
7070   FillChar(Header{%H-}, SizeOf(Header), 0);
7071
7072   //set ImageType
7073   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7074                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7075     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7076   else
7077     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7078
7079   //set BitsPerPixel
7080   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7081     Header.Bpp := 8
7082   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7083                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7084     Header.Bpp := 16
7085   else if (Format in [tfBGR8, tfRGB8]) then
7086     Header.Bpp := 24
7087   else
7088     Header.Bpp := 32;
7089
7090   //set AlphaBitCount
7091   case Format of
7092     tfRGB5A1, tfBGR5A1:
7093       Header.ImageDesc := 1 and $F;
7094     tfRGB10A2, tfBGR10A2:
7095       Header.ImageDesc := 2 and $F;
7096     tfRGBA4, tfBGRA4:
7097       Header.ImageDesc := 4 and $F;
7098     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7099       Header.ImageDesc := 8 and $F;
7100   end;
7101
7102   Header.Width     := Width;
7103   Header.Height    := Height;
7104   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7105   aStream.Write(Header, SizeOf(Header));
7106
7107   // convert RGB(A) to BGR(A)
7108   Converter  := nil;
7109   FormatDesc := TFormatDescriptor.Get(Format);
7110   Size       := FormatDesc.GetSize(Dimension);
7111   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7112     if (FormatDesc.RGBInverted = tfEmpty) then
7113       raise EglBitmapException.Create('inverted RGB format is empty');
7114     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7115     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7116        (Converter.PixelSize <> FormatDesc.PixelSize) then
7117       raise EglBitmapException.Create('invalid inverted RGB format');
7118   end;
7119
7120   if Assigned(Converter) then begin
7121     LineSize := FormatDesc.GetSize(Width, 1);
7122     GetMem(LineBuf, LineSize);
7123     SourceMD := FormatDesc.CreateMappingData;
7124     DestMD   := Converter.CreateMappingData;
7125     try
7126       SourceData := Data;
7127       for y := 0 to Height-1 do begin
7128         DestData := LineBuf;
7129         for x := 0 to Width-1 do begin
7130           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7131           Converter.Map(Pixel, DestData, DestMD);
7132         end;
7133         aStream.Write(LineBuf^, LineSize);
7134       end;
7135     finally
7136       FreeMem(LineBuf);
7137       FormatDesc.FreeMappingData(SourceMD);
7138       FormatDesc.FreeMappingData(DestMD);
7139     end;
7140   end else
7141     aStream.Write(Data^, Size);
7142 end;
7143
7144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7145 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7147 const
7148   DDS_MAGIC: Cardinal         = $20534444;
7149
7150   // DDS_header.dwFlags
7151   DDSD_CAPS                   = $00000001;
7152   DDSD_HEIGHT                 = $00000002;
7153   DDSD_WIDTH                  = $00000004;
7154   DDSD_PIXELFORMAT            = $00001000;
7155
7156   // DDS_header.sPixelFormat.dwFlags
7157   DDPF_ALPHAPIXELS            = $00000001;
7158   DDPF_ALPHA                  = $00000002;
7159   DDPF_FOURCC                 = $00000004;
7160   DDPF_RGB                    = $00000040;
7161   DDPF_LUMINANCE              = $00020000;
7162
7163   // DDS_header.sCaps.dwCaps1
7164   DDSCAPS_TEXTURE             = $00001000;
7165
7166   // DDS_header.sCaps.dwCaps2
7167   DDSCAPS2_CUBEMAP            = $00000200;
7168
7169   D3DFMT_DXT1                 = $31545844;
7170   D3DFMT_DXT3                 = $33545844;
7171   D3DFMT_DXT5                 = $35545844;
7172
7173 type
7174   TDDSPixelFormat = packed record
7175     dwSize: Cardinal;
7176     dwFlags: Cardinal;
7177     dwFourCC: Cardinal;
7178     dwRGBBitCount: Cardinal;
7179     dwRBitMask: Cardinal;
7180     dwGBitMask: Cardinal;
7181     dwBBitMask: Cardinal;
7182     dwABitMask: Cardinal;
7183   end;
7184
7185   TDDSCaps = packed record
7186     dwCaps1: Cardinal;
7187     dwCaps2: Cardinal;
7188     dwDDSX: Cardinal;
7189     dwReserved: Cardinal;
7190   end;
7191
7192   TDDSHeader = packed record
7193     dwSize: Cardinal;
7194     dwFlags: Cardinal;
7195     dwHeight: Cardinal;
7196     dwWidth: Cardinal;
7197     dwPitchOrLinearSize: Cardinal;
7198     dwDepth: Cardinal;
7199     dwMipMapCount: Cardinal;
7200     dwReserved: array[0..10] of Cardinal;
7201     PixelFormat: TDDSPixelFormat;
7202     Caps: TDDSCaps;
7203     dwReserved2: Cardinal;
7204   end;
7205
7206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7207 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7208 var
7209   Header: TDDSHeader;
7210   Converter: TbmpBitfieldFormat;
7211
7212   function GetDDSFormat: TglBitmapFormat;
7213   var
7214     fd: TFormatDescriptor;
7215     i: Integer;
7216     Range: TglBitmapColorRec;
7217     match: Boolean;
7218   begin
7219     result := tfEmpty;
7220     with Header.PixelFormat do begin
7221       // Compresses
7222       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7223         case Header.PixelFormat.dwFourCC of
7224           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7225           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7226           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7227         end;
7228       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7229
7230         //find matching format
7231         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7232           fd := TFormatDescriptor.Get(result);
7233           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7234              (8 * fd.PixelSize = dwRGBBitCount) then
7235             exit;
7236         end;
7237
7238         //find format with same Range
7239         Range.r := dwRBitMask;
7240         Range.g := dwGBitMask;
7241         Range.b := dwBBitMask;
7242         Range.a := dwABitMask;
7243         for i := 0 to 3 do begin
7244           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7245             Range.arr[i] := Range.arr[i] shr 1;
7246         end;
7247         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7248           fd := TFormatDescriptor.Get(result);
7249           match := true;
7250           for i := 0 to 3 do
7251             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7252               match := false;
7253               break;
7254             end;
7255           if match then
7256             break;
7257         end;
7258
7259         //no format with same range found -> use default
7260         if (result = tfEmpty) then begin
7261           if (dwABitMask > 0) then
7262             result := tfBGRA8
7263           else
7264             result := tfBGR8;
7265         end;
7266
7267         Converter := TbmpBitfieldFormat.Create;
7268         Converter.RedMask   := dwRBitMask;
7269         Converter.GreenMask := dwGBitMask;
7270         Converter.BlueMask  := dwBBitMask;
7271         Converter.AlphaMask := dwABitMask;
7272         Converter.PixelSize := dwRGBBitCount / 8;
7273       end;
7274     end;
7275   end;
7276
7277 var
7278   StreamPos: Int64;
7279   x, y, LineSize, RowSize, Magic: Cardinal;
7280   NewImage, TmpData, RowData, SrcData: System.PByte;
7281   SourceMD, DestMD: Pointer;
7282   Pixel: TglBitmapPixelData;
7283   ddsFormat: TglBitmapFormat;
7284   FormatDesc: TFormatDescriptor;
7285
7286 begin
7287   result    := false;
7288   Converter := nil;
7289   StreamPos := aStream.Position;
7290
7291   // Magic
7292   aStream.Read(Magic{%H-}, sizeof(Magic));
7293   if (Magic <> DDS_MAGIC) then begin
7294     aStream.Position := StreamPos;
7295     exit;
7296   end;
7297
7298   //Header
7299   aStream.Read(Header{%H-}, sizeof(Header));
7300   if (Header.dwSize <> SizeOf(Header)) or
7301      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7302         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7303   begin
7304     aStream.Position := StreamPos;
7305     exit;
7306   end;
7307
7308   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7309     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7310
7311   ddsFormat := GetDDSFormat;
7312   try
7313     if (ddsFormat = tfEmpty) then
7314       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7315
7316     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7317     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7318     GetMem(NewImage, Header.dwHeight * LineSize);
7319     try
7320       TmpData := NewImage;
7321
7322       //Converter needed
7323       if Assigned(Converter) then begin
7324         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7325         GetMem(RowData, RowSize);
7326         SourceMD := Converter.CreateMappingData;
7327         DestMD   := FormatDesc.CreateMappingData;
7328         try
7329           for y := 0 to Header.dwHeight-1 do begin
7330             TmpData := NewImage;
7331             inc(TmpData, y * LineSize);
7332             SrcData := RowData;
7333             aStream.Read(SrcData^, RowSize);
7334             for x := 0 to Header.dwWidth-1 do begin
7335               Converter.Unmap(SrcData, Pixel, SourceMD);
7336               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7337               FormatDesc.Map(Pixel, TmpData, DestMD);
7338             end;
7339           end;
7340         finally
7341           Converter.FreeMappingData(SourceMD);
7342           FormatDesc.FreeMappingData(DestMD);
7343           FreeMem(RowData);
7344         end;
7345       end else
7346
7347       // Compressed
7348       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7349         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7350         for Y := 0 to Header.dwHeight-1 do begin
7351           aStream.Read(TmpData^, RowSize);
7352           Inc(TmpData, LineSize);
7353         end;
7354       end else
7355
7356       // Uncompressed
7357       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7358         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7359         for Y := 0 to Header.dwHeight-1 do begin
7360           aStream.Read(TmpData^, RowSize);
7361           Inc(TmpData, LineSize);
7362         end;
7363       end else
7364         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7365
7366       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7367       result := true;
7368     except
7369       if Assigned(NewImage) then
7370         FreeMem(NewImage);
7371       raise;
7372     end;
7373   finally
7374     FreeAndNil(Converter);
7375   end;
7376 end;
7377
7378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7379 procedure TglBitmap.SaveDDS(const aStream: TStream);
7380 var
7381   Header: TDDSHeader;
7382   FormatDesc: TFormatDescriptor;
7383 begin
7384   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7385     raise EglBitmapUnsupportedFormat.Create(Format);
7386
7387   FormatDesc := TFormatDescriptor.Get(Format);
7388
7389   // Generell
7390   FillChar(Header{%H-}, SizeOf(Header), 0);
7391   Header.dwSize  := SizeOf(Header);
7392   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7393
7394   Header.dwWidth  := Max(1, Width);
7395   Header.dwHeight := Max(1, Height);
7396
7397   // Caps
7398   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7399
7400   // Pixelformat
7401   Header.PixelFormat.dwSize := sizeof(Header);
7402   if (FormatDesc.IsCompressed) then begin
7403     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7404     case Format of
7405       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7406       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7407       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7408     end;
7409   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7410     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7411     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7412     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7413   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7414     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7415     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7416     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7417     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7418   end else begin
7419     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7420     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7421     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7422     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7423     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7424     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7425   end;
7426
7427   if (FormatDesc.HasAlpha) then
7428     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7429
7430   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7431   aStream.Write(Header, SizeOf(Header));
7432   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7433 end;
7434
7435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7436 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7438 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7439   const aWidth: Integer; const aHeight: Integer);
7440 var
7441   pTemp: pByte;
7442   Size: Integer;
7443 begin
7444   if (aHeight > 1) then begin
7445     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7446     GetMem(pTemp, Size);
7447     try
7448       Move(aData^, pTemp^, Size);
7449       FreeMem(aData);
7450       aData := nil;
7451     except
7452       FreeMem(pTemp);
7453       raise;
7454     end;
7455   end else
7456     pTemp := aData;
7457   inherited SetDataPointer(pTemp, aFormat, aWidth);
7458 end;
7459
7460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7461 function TglBitmap1D.FlipHorz: Boolean;
7462 var
7463   Col: Integer;
7464   pTempDest, pDest, pSource: PByte;
7465 begin
7466   result := inherited FlipHorz;
7467   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7468     pSource := Data;
7469     GetMem(pDest, fRowSize);
7470     try
7471       pTempDest := pDest;
7472       Inc(pTempDest, fRowSize);
7473       for Col := 0 to Width-1 do begin
7474         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7475         Move(pSource^, pTempDest^, fPixelSize);
7476         Inc(pSource, fPixelSize);
7477       end;
7478       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7479       result := true;
7480     except
7481       if Assigned(pDest) then
7482         FreeMem(pDest);
7483       raise;
7484     end;
7485   end;
7486 end;
7487
7488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7489 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7490 var
7491   FormatDesc: TFormatDescriptor;
7492 begin
7493   // Upload data
7494   FormatDesc := TFormatDescriptor.Get(Format);
7495   if FormatDesc.IsCompressed then
7496     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7497   else if aBuildWithGlu then
7498     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7499   else
7500     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7501
7502   // Free Data
7503   if (FreeDataAfterGenTexture) then
7504     FreeData;
7505 end;
7506
7507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7508 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7509 var
7510   BuildWithGlu, TexRec: Boolean;
7511   TexSize: Integer;
7512 begin
7513   if Assigned(Data) then begin
7514     // Check Texture Size
7515     if (aTestTextureSize) then begin
7516       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7517
7518       if (Width > TexSize) then
7519         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7520
7521       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7522                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7523       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7524         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7525     end;
7526
7527     CreateId;
7528     SetupParameters(BuildWithGlu);
7529     UploadData(BuildWithGlu);
7530     glAreTexturesResident(1, @fID, @fIsResident);
7531   end;
7532 end;
7533
7534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7535 procedure TglBitmap1D.AfterConstruction;
7536 begin
7537   inherited;
7538   Target := GL_TEXTURE_1D;
7539 end;
7540
7541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7542 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7544 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7545 begin
7546   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7547     result := fLines[aIndex]
7548   else
7549     result := nil;
7550 end;
7551
7552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7553 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7554   const aWidth: Integer; const aHeight: Integer);
7555 var
7556   Idx, LineWidth: Integer;
7557 begin
7558   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7559
7560   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7561     // Assigning Data
7562     if Assigned(Data) then begin
7563       SetLength(fLines, GetHeight);
7564       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7565
7566       for Idx := 0 to GetHeight-1 do begin
7567         fLines[Idx] := Data;
7568         Inc(fLines[Idx], Idx * LineWidth);
7569       end;
7570     end
7571       else SetLength(fLines, 0);
7572   end else begin
7573     SetLength(fLines, 0);
7574   end;
7575 end;
7576
7577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7578 procedure TglBitmap2D.UploadData(const aBuildWithGlu: Boolean);
7579 var
7580   FormatDesc: TFormatDescriptor;
7581 begin
7582   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7583
7584   FormatDesc := TFormatDescriptor.Get(Format);
7585   if FormatDesc.IsCompressed then begin
7586     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7587   end else if aBuildWithGlu then begin
7588     gluBuild2DMipmaps(Target, FormatDesc.Components, Width, Height,
7589       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7590   end else begin
7591     glTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7592       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7593   end;
7594
7595   // Freigeben
7596   if (FreeDataAfterGenTexture) then
7597     FreeData;
7598 end;
7599
7600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7601 procedure TglBitmap2D.AfterConstruction;
7602 begin
7603   inherited;
7604   Target := GL_TEXTURE_2D;
7605 end;
7606
7607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7608 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7609 var
7610   Temp: pByte;
7611   Size, w, h: Integer;
7612   FormatDesc: TFormatDescriptor;
7613 begin
7614   FormatDesc := TFormatDescriptor.Get(Format);
7615   if FormatDesc.IsCompressed then
7616     raise EglBitmapUnsupportedFormat.Create(Format);
7617
7618   w    := aRight  - aLeft;
7619   h    := aBottom - aTop;
7620   Size := FormatDesc.GetSize(w, h);
7621   GetMem(Temp, Size);
7622   try
7623     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7624     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7625     SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
7626     FlipVert;
7627   except
7628     if Assigned(Temp) then
7629       FreeMem(Temp);
7630     raise;
7631   end;
7632 end;
7633
7634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7635 procedure TglBitmap2D.GetDataFromTexture;
7636 var
7637   Temp: PByte;
7638   TempWidth, TempHeight: Integer;
7639   TempIntFormat: Cardinal;
7640   IntFormat, f: TglBitmapFormat;
7641   FormatDesc: TFormatDescriptor;
7642 begin
7643   Bind;
7644
7645   // Request Data
7646   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7647   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7648   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7649
7650   IntFormat := tfEmpty;
7651   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7652     FormatDesc := TFormatDescriptor.Get(f);
7653     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7654       IntFormat := FormatDesc.Format;
7655       break;
7656     end;
7657   end;
7658
7659   // Getting data from OpenGL
7660   FormatDesc := TFormatDescriptor.Get(IntFormat);
7661   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7662   try
7663     if FormatDesc.IsCompressed then
7664       glGetCompressedTexImage(Target, 0, Temp)
7665     else
7666      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7667     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7668   except
7669     if Assigned(Temp) then
7670       FreeMem(Temp);
7671     raise;
7672   end;
7673 end;
7674
7675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7676 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7677 var
7678   BuildWithGlu, PotTex, TexRec: Boolean;
7679   TexSize: Integer;
7680 begin
7681   if Assigned(Data) then begin
7682     // Check Texture Size
7683     if (aTestTextureSize) then begin
7684       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7685
7686       if ((Height > TexSize) or (Width > TexSize)) then
7687         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7688
7689       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7690       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7691       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7692         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7693     end;
7694
7695     CreateId;
7696     SetupParameters(BuildWithGlu);
7697     UploadData(BuildWithGlu);
7698     glAreTexturesResident(1, @fID, @fIsResident);
7699   end;
7700 end;
7701
7702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7703 function TglBitmap2D.FlipHorz: Boolean;
7704 var
7705   Col, Row: Integer;
7706   TempDestData, DestData, SourceData: PByte;
7707   ImgSize: Integer;
7708 begin
7709   result := inherited FlipHorz;
7710   if Assigned(Data) then begin
7711     SourceData := Data;
7712     ImgSize := Height * fRowSize;
7713     GetMem(DestData, ImgSize);
7714     try
7715       TempDestData := DestData;
7716       Dec(TempDestData, fRowSize + fPixelSize);
7717       for Row := 0 to Height -1 do begin
7718         Inc(TempDestData, fRowSize * 2);
7719         for Col := 0 to Width -1 do begin
7720           Move(SourceData^, TempDestData^, fPixelSize);
7721           Inc(SourceData, fPixelSize);
7722           Dec(TempDestData, fPixelSize);
7723         end;
7724       end;
7725       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7726       result := true;
7727     except
7728       if Assigned(DestData) then
7729         FreeMem(DestData);
7730       raise;
7731     end;
7732   end;
7733 end;
7734
7735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7736 function TglBitmap2D.FlipVert: Boolean;
7737 var
7738   Row: Integer;
7739   TempDestData, DestData, SourceData: PByte;
7740 begin
7741   result := inherited FlipVert;
7742   if Assigned(Data) then begin
7743     SourceData := Data;
7744     GetMem(DestData, Height * fRowSize);
7745     try
7746       TempDestData := DestData;
7747       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7748       for Row := 0 to Height -1 do begin
7749         Move(SourceData^, TempDestData^, fRowSize);
7750         Dec(TempDestData, fRowSize);
7751         Inc(SourceData, fRowSize);
7752       end;
7753       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7754       result := true;
7755     except
7756       if Assigned(DestData) then
7757         FreeMem(DestData);
7758       raise;
7759     end;
7760   end;
7761 end;
7762
7763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7764 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7766 type
7767   TMatrixItem = record
7768     X, Y: Integer;
7769     W: Single;
7770   end;
7771
7772   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7773   TglBitmapToNormalMapRec = Record
7774     Scale: Single;
7775     Heights: array of Single;
7776     MatrixU : array of TMatrixItem;
7777     MatrixV : array of TMatrixItem;
7778   end;
7779
7780 const
7781   ONE_OVER_255 = 1 / 255;
7782
7783   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7784 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7785 var
7786   Val: Single;
7787 begin
7788   with FuncRec do begin
7789     Val :=
7790       Source.Data.r * LUMINANCE_WEIGHT_R +
7791       Source.Data.g * LUMINANCE_WEIGHT_G +
7792       Source.Data.b * LUMINANCE_WEIGHT_B;
7793     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7794   end;
7795 end;
7796
7797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7798 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7799 begin
7800   with FuncRec do
7801     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7802 end;
7803
7804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7805 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7806 type
7807   TVec = Array[0..2] of Single;
7808 var
7809   Idx: Integer;
7810   du, dv: Double;
7811   Len: Single;
7812   Vec: TVec;
7813
7814   function GetHeight(X, Y: Integer): Single;
7815   begin
7816     with FuncRec do begin
7817       X := Max(0, Min(Size.X -1, X));
7818       Y := Max(0, Min(Size.Y -1, Y));
7819       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7820     end;
7821   end;
7822
7823 begin
7824   with FuncRec do begin
7825     with PglBitmapToNormalMapRec(Args)^ do begin
7826       du := 0;
7827       for Idx := Low(MatrixU) to High(MatrixU) do
7828         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7829
7830       dv := 0;
7831       for Idx := Low(MatrixU) to High(MatrixU) do
7832         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7833
7834       Vec[0] := -du * Scale;
7835       Vec[1] := -dv * Scale;
7836       Vec[2] := 1;
7837     end;
7838
7839     // Normalize
7840     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7841     if Len <> 0 then begin
7842       Vec[0] := Vec[0] * Len;
7843       Vec[1] := Vec[1] * Len;
7844       Vec[2] := Vec[2] * Len;
7845     end;
7846
7847     // Farbe zuweisem
7848     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7849     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7850     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7851   end;
7852 end;
7853
7854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7855 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7856 var
7857   Rec: TglBitmapToNormalMapRec;
7858
7859   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7860   begin
7861     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7862       Matrix[Index].X := X;
7863       Matrix[Index].Y := Y;
7864       Matrix[Index].W := W;
7865     end;
7866   end;
7867
7868 begin
7869   if TFormatDescriptor.Get(Format).IsCompressed then
7870     raise EglBitmapUnsupportedFormat.Create(Format);
7871
7872   if aScale > 100 then
7873     Rec.Scale := 100
7874   else if aScale < -100 then
7875     Rec.Scale := -100
7876   else
7877     Rec.Scale := aScale;
7878
7879   SetLength(Rec.Heights, Width * Height);
7880   try
7881     case aFunc of
7882       nm4Samples: begin
7883         SetLength(Rec.MatrixU, 2);
7884         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7885         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7886
7887         SetLength(Rec.MatrixV, 2);
7888         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7889         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7890       end;
7891
7892       nmSobel: begin
7893         SetLength(Rec.MatrixU, 6);
7894         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7895         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7896         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7897         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7898         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7899         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7900
7901         SetLength(Rec.MatrixV, 6);
7902         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7903         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7904         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7905         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7906         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7907         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7908       end;
7909
7910       nm3x3: begin
7911         SetLength(Rec.MatrixU, 6);
7912         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7913         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7914         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7915         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7916         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7917         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7918
7919         SetLength(Rec.MatrixV, 6);
7920         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7921         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7922         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7923         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7924         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7925         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7926       end;
7927
7928       nm5x5: begin
7929         SetLength(Rec.MatrixU, 20);
7930         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7931         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7932         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7933         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7934         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7935         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7936         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7937         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7938         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7939         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7940         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7941         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7942         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7943         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7944         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7945         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7946         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7947         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7948         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7949         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7950
7951         SetLength(Rec.MatrixV, 20);
7952         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7953         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7954         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7955         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7956         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7957         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7958         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7959         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7960         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7961         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7962         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7963         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7964         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7965         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7966         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7967         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7968         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7969         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7970         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7971         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7972       end;
7973     end;
7974
7975     // Daten Sammeln
7976     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7977       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7978     else
7979       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7980     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7981   finally
7982     SetLength(Rec.Heights, 0);
7983   end;
7984 end;
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994 (*
7995
7996
7997
7998 { TglBitmapCubeMap }
7999
8000 procedure TglBitmapCubeMap.AfterConstruction;
8001 begin
8002   inherited;
8003
8004   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8005     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8006
8007   SetWrap; // set all to GL_CLAMP_TO_EDGE
8008   Target := GL_TEXTURE_CUBE_MAP;
8009   fGenMode := GL_REFLECTION_MAP;
8010 end;
8011
8012
8013 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8014 begin
8015   inherited Bind (EnableTextureUnit);
8016
8017   if EnableTexCoordsGen then begin
8018     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8019     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8020     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8021     glEnable(GL_TEXTURE_GEN_S);
8022     glEnable(GL_TEXTURE_GEN_T);
8023     glEnable(GL_TEXTURE_GEN_R);
8024   end;
8025 end;
8026
8027
8028 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8029 var
8030   glFormat, glInternalFormat, glType: Cardinal;
8031   BuildWithGlu: Boolean;
8032   TexSize: Integer;
8033 begin
8034   // Check Texture Size
8035   if (TestTextureSize) then begin
8036     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8037
8038     if ((Height > TexSize) or (Width > TexSize)) then
8039       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8040
8041     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8042       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8043   end;
8044
8045   // create Texture
8046   if ID = 0 then begin
8047     CreateID;
8048     SetupParameters(BuildWithGlu);
8049   end;
8050
8051   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8052
8053   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8054 end;
8055
8056
8057 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8058 begin
8059   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8060 end;
8061
8062
8063 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8064   DisableTextureUnit: Boolean);
8065 begin
8066   inherited Unbind (DisableTextureUnit);
8067
8068   if DisableTexCoordsGen then begin
8069     glDisable(GL_TEXTURE_GEN_S);
8070     glDisable(GL_TEXTURE_GEN_T);
8071     glDisable(GL_TEXTURE_GEN_R);
8072   end;
8073 end;
8074
8075
8076 { TglBitmapNormalMap }
8077
8078 type
8079   TVec = Array[0..2] of Single;
8080   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8081
8082   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8083   TglBitmapNormalMapRec = record
8084     HalfSize : Integer;
8085     Func: TglBitmapNormalMapGetVectorFunc;
8086   end;
8087
8088
8089 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8090 begin
8091   Vec[0] := HalfSize;
8092   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8093   Vec[2] := - (Position.X + 0.5 - HalfSize);
8094 end;
8095
8096
8097 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8098 begin
8099   Vec[0] := - HalfSize;
8100   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8101   Vec[2] := Position.X + 0.5 - HalfSize;
8102 end;
8103
8104
8105 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8106 begin
8107   Vec[0] := Position.X + 0.5 - HalfSize;
8108   Vec[1] := HalfSize;
8109   Vec[2] := Position.Y + 0.5 - HalfSize;
8110 end;
8111
8112
8113 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8114 begin
8115   Vec[0] := Position.X + 0.5 - HalfSize;
8116   Vec[1] := - HalfSize;
8117   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8118 end;
8119
8120
8121 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8122 begin
8123   Vec[0] := Position.X + 0.5 - HalfSize;
8124   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8125   Vec[2] := HalfSize;
8126 end;
8127
8128
8129 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8130 begin
8131   Vec[0] := - (Position.X + 0.5 - HalfSize);
8132   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8133   Vec[2] := - HalfSize;
8134 end;
8135
8136
8137 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8138 var
8139   Vec : TVec;
8140   Len: Single;
8141 begin
8142   with FuncRec do begin
8143     with PglBitmapNormalMapRec (CustomData)^ do begin
8144       Func(Vec, Position, HalfSize);
8145
8146       // Normalize
8147       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8148       if Len <> 0 then begin
8149         Vec[0] := Vec[0] * Len;
8150         Vec[1] := Vec[1] * Len;
8151         Vec[2] := Vec[2] * Len;
8152       end;
8153
8154       // Scale Vector and AddVectro
8155       Vec[0] := Vec[0] * 0.5 + 0.5;
8156       Vec[1] := Vec[1] * 0.5 + 0.5;
8157       Vec[2] := Vec[2] * 0.5 + 0.5;
8158     end;
8159
8160     // Set Color
8161     Dest.Red   := Round(Vec[0] * 255);
8162     Dest.Green := Round(Vec[1] * 255);
8163     Dest.Blue  := Round(Vec[2] * 255);
8164   end;
8165 end;
8166
8167
8168 procedure TglBitmapNormalMap.AfterConstruction;
8169 begin
8170   inherited;
8171
8172   fGenMode := GL_NORMAL_MAP;
8173 end;
8174
8175
8176 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8177   TestTextureSize: Boolean);
8178 var
8179   Rec: TglBitmapNormalMapRec;
8180   SizeRec: TglBitmapPixelPosition;
8181 begin
8182   Rec.HalfSize := Size div 2;
8183
8184   FreeDataAfterGenTexture := false;
8185
8186   SizeRec.Fields := [ffX, ffY];
8187   SizeRec.X := Size;
8188   SizeRec.Y := Size;
8189
8190   // Positive X
8191   Rec.Func := glBitmapNormalMapPosX;
8192   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8193   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8194
8195   // Negative X
8196   Rec.Func := glBitmapNormalMapNegX;
8197   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8198   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8199
8200   // Positive Y
8201   Rec.Func := glBitmapNormalMapPosY;
8202   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8203   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8204
8205   // Negative Y
8206   Rec.Func := glBitmapNormalMapNegY;
8207   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8208   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8209
8210   // Positive Z
8211   Rec.Func := glBitmapNormalMapPosZ;
8212   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8213   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8214
8215   // Negative Z
8216   Rec.Func := glBitmapNormalMapNegZ;
8217   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8218   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8219 end;
8220 *)
8221
8222 initialization
8223   glBitmapSetDefaultFormat(tfEmpty);
8224   glBitmapSetDefaultMipmap(mmMipmap);
8225   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8226   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8227
8228   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8229   glBitmapSetDefaultDeleteTextureOnFree    (true);
8230
8231   TFormatDescriptor.Init;
8232
8233 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8234   OpenGLInitialized := false;
8235   InitOpenGLCS := TCriticalSection.Create;
8236 {$ENDIF}
8237
8238 finalization
8239   TFormatDescriptor.Finalize;
8240
8241 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8242   FreeAndNil(InitOpenGLCS);
8243 {$ENDIF}
8244
8245 end.
8246