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 ------------------------------------------------------------
   9 The contents of this file are used with permission, subject to
  10 the Mozilla Public License Version 1.1 (the "License"); you may
  11 not use this file except in compliance with the License. You may
  12 obtain a copy of the License at
  13 http://www.mozilla.org/MPL/MPL-1.1.html
  14 ------------------------------------------------------------
  15 Version 2.0.3
  16 ------------------------------------------------------------
  17 History
  18 21-03-2010
  19 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  20   then it's your problem if that isn't true. This prevents the unit for incompatibility
  21   with newer versions of Delphi.
  22 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  23 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  24 10-08-2008
  25 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  26 - Additional Datapointer for functioninterface now has the name CustomData
  27 24-07-2008
  28 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  29 - If you load an texture from an file the property Filename will be set to the name of the file
  30 - Three new properties to attach custom data to the Texture objects
  31   - CustomName  (free for use string)
  32   - CustomNameW (free for use widestring)
  33   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  34 27-05-2008
  35 - RLE TGAs loaded much faster
  36 26-05-2008
  37 - fixed some problem with reading RLE TGAs.
  38 21-05-2008
  39 - function clone now only copys data if it's assigned and now it also copies the ID
  40 - it seems that lazarus dont like comments in comments.
  41 01-05-2008
  42 - It's possible to set the id of the texture
  43 - define GLB_NO_NATIVE_GL deactivated by default
  44 27-04-2008
  45 - Now supports the following libraries
  46   - SDL and SDL_image
  47   - libPNG
  48   - libJPEG
  49 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  50 - BMPs now loaded manuel
  51 - Large restructuring
  52 - Property DataPtr now has the name Data
  53 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  54 - Unused Depth removed
  55 - Function FreeData to freeing image data added
  56 24-10-2007
  57 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  58 15-11-2006
  59 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  60 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  61 - Function ReadOpenGLExtension is now only intern
  62 29-06-2006
  63 - pngimage now disabled by default like all other versions.
  64 26-06-2006
  65 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  66 22-06-2006
  67 - Fixed some Problem with Delphi 5
  68 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  69 22-03-2006
  70 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  71 09-03-2006
  72 - Internal Format ifDepth8 added
  73 - function GrabScreen now supports all uncompressed formats
  74 31-01-2006
  75 - AddAlphaFromglBitmap implemented
  76 29-12-2005
  77 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  78 28-12-2005
  79 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  80   property Width, Height, Depth are still existing and new property Dimension are avail
  81 11-12-2005
  82 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  83 19-10-2005
  84 - Added function GrabScreen to class TglBitmap2D
  85 18-10-2005
  86 - Added support to Save images
  87 - Added function Clone to Clone Instance
  88 11-10-2005
  89 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  90   Usefull for Future
  91 - Several speed optimizations
  92 09-10-2005
  93 - Internal structure change. Loading of TGA, PNG and DDS improved.
  94   Data, format and size will now set directly with SetDataPtr.
  95 - AddFunc now works with all Types of Images and Formats
  96 - Some Funtions moved to Baseclass TglBitmap
  97 06-10-2005
  98 - Added Support to decompress DXT3 and DXT5 compressed Images.
  99 - Added Mapping to convert data from one format into an other.
 100 05-10-2005
 101 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 102   supported Input format (supported by GetPixel) into any uncompresed Format
 103 - Added Support to decompress DXT1 compressed Images.
 104 - SwapColors replaced by ConvertTo
 105 04-10-2005
 106 - Added Support for compressed DDSs
 107 - Added new internal formats (DXT1, DXT3, DXT5)
 108 29-09-2005
 109 - Parameter Components renamed to InternalFormat
 110 23-09-2005
 111 - Some AllocMem replaced with GetMem (little speed change)
 112 - better exception handling. Better protection from memory leaks.
 113 22-09-2005
 114 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 115 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 116 07-09-2005
 117 - Added support for Grayscale textures
 118 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 119 10-07-2005
 120 - Added support for GL_VERSION_2_0
 121 - Added support for GL_EXT_texture_filter_anisotropic
 122 04-07-2005
 123 - Function FillWithColor fills the Image with one Color
 124 - Function LoadNormalMap added
 125 30-06-2005
 126 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 127 - ToNormalMap now supports Sobel (nmSobel) function.
 128 29-06-2005
 129 - support for RLE Compressed RGB TGAs added
 130 28-06-2005
 131 - Class TglBitmapNormalMap added to support Normalmap generation
 132 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 133   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 134 16-06-2005
 135 - Method LoadCubeMapClass removed
 136 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 137 - virtual abstract method GenTexture in class TglBitmap now is protected
 138 12-06-2005
 139 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 140 10-06-2005
 141 - little enhancement for IsPowerOfTwo
 142 - TglBitmap1D.GenTexture now tests NPOT Textures
 143 06-06-2005
 144 - some little name changes. All properties or function with Texture in name are
 145   now without texture in name. We have allways texture so we dosn't name it.
 146 03-06-2005
 147 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 148   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 149 02-06-2005
 150 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 151 25-04-2005
 152 - Function Unbind added
 153 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 154 21-04-2005
 155 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 156 29-03-2005
 157 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 158   To Enable png's use the define pngimage
 159 22-03-2005
 160 - New Functioninterface added
 161 - Function GetPixel added
 162 27-11-2004
 163 - Property BuildMipMaps renamed to MipMap
 164 21-11-2004
 165 - property Name removed.
 166 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 167 22-05-2004
 168 - property name added. Only used in glForms!
 169 26-11-2003
 170 - property FreeDataAfterGenTexture is now available as default (default = true)
 171 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 172 - function MoveMemory replaced with function Move (little speed change)
 173 - several calculations stored in variables (little speed change)
 174 29-09-2003
 175 - property BuildMipsMaps added (default = true)
 176   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 177 - property FreeDataAfterGenTexture added (default = true)
 178   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 179 - parameter DisableOtherTextureUnits of Bind removed
 180 - parameter FreeDataAfterGeneration of GenTextures removed
 181 12-09-2003
 182 - TglBitmap dosn't delete data if class was destroyed (fixed)
 183 09-09-2003
 184 - Bind now enables TextureUnits (by params)
 185 - GenTextures can leave data (by param)
 186 - LoadTextures now optimal
 187 03-09-2003
 188 - Performance optimization in AddFunc
 189 - procedure Bind moved to subclasses
 190 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 191 19-08-2003
 192 - Texturefilter and texturewrap now also as defaults
 193   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 194   Magfilter = GL_LINEAR
 195   Wrap(str) = GL_CLAMP_TO_EDGE
 196 - Added new format tfCompressed to create a compressed texture.
 197 - propertys IsCompressed, TextureSize and IsResident added
 198   IsCompressed and TextureSize only contains data from level 0
 199 18-08-2003
 200 - Added function AddFunc to add PerPixelEffects to Image
 201 - LoadFromFunc now based on AddFunc
 202 - Invert now based on AddFunc
 203 - SwapColors now based on AddFunc
 204 16-08-2003
 205 - Added function FlipHorz
 206 15-08-2003
 207 - Added function LaodFromFunc to create images with function
 208 - Added function FlipVert
 209 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 210 29-07-2003
 211 - Added Alphafunctions to calculate alpha per function
 212 - Added Alpha from ColorKey using alphafunctions
 213 28-07-2003
 214 - First full functionally Version of glBitmap
 215 - Support for 24Bit and 32Bit TGA Pictures added
 216 25-07-2003
 217 - begin of programming
 218 ***********************************************************}
 219 unit glBitmap;
 220
 221 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 222 // Please uncomment the defines below to configure the glBitmap to your preferences.
 223 // If you have configured the unit you can uncomment the warning above.
 224
 225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 228 // activate to enable build-in OpenGL support with statically linked methods
 229 // use dglOpenGL.pas if not enabled
 230 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 231
 232 // activate to enable build-in OpenGL support with dynamically linked methods
 233 // use dglOpenGL.pas if not enabled
 234 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 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
 243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 244 // activate to enable the support of SDL_image to load files. (READ ONLY)
 245 // If you enable SDL_image all other libraries will be ignored!
 246 {.$DEFINE GLB_SDL_IMAGE}
 247
 248 // PNG /////////////////////////////////////////////////////////////////////////////////////////////
 249 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 250 // if you enable pngimage the libPNG will be ignored
 251 {$DEFINE GLB_PNGIMAGE}
 252
 253 // activate to use the libPNG -> http://www.libpng.org/
 254 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 255 {.$DEFINE GLB_LIB_PNG}
 256
 257 // JPEG ////////////////////////////////////////////////////////////////////////////////////////////
 258 // if you enable delphi jpegs the libJPEG will be ignored
 259 {.$DEFINE GLB_DELPHI_JPEG}
 260
 261 // activate to use the libJPEG -> http://www.ijg.org/
 262 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 263 {.$DEFINE GLB_LIB_JPEG}
 264
 265
 266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 267 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 269 // Delphi Versions
 270 {$IFDEF fpc}
 271   {$MODE Delphi}
 272
 273   {$IFDEF CPUI386}
 274     {$DEFINE CPU386}
 275     {$ASMMODE INTEL}
 276   {$ENDIF}
 277
 278   {$IFNDEF WINDOWS}
 279     {$linklib c}
 280   {$ENDIF}
 281 {$ENDIF}
 282
 283 // Operation System
 284 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
 285   {$DEFINE GLB_WIN}
 286 {$ELSEIF DEFINED(LINUX)}
 287   {$DEFINE GLB_LINUX}
 288 {$IFEND}
 289
 290 // native OpenGL Support
 291 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 292   {$DEFINE GLB_NATIVE_OGL}
 293 {$IFEND}
 294
 295 // checking define combinations
 296 //SDL Image
 297 {$IFDEF GLB_SDL_IMAGE}
 298   {$IFNDEF GLB_SDL}
 299     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 300     {$DEFINE GLB_SDL}
 301   {$ENDIF}
 302   {$IFDEF GLB_PNGIMAGE}
 303     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 304     {$undef GLB_PNGIMAGE}
 305   {$ENDIF}
 306   {$IFDEF GLB_DELPHI_JPEG}
 307     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 308     {$undef GLB_DELPHI_JPEG}
 309   {$ENDIF}
 310   {$IFDEF GLB_LIB_PNG}
 311     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 312     {$undef GLB_LIB_PNG}
 313   {$ENDIF}
 314   {$IFDEF GLB_LIB_JPEG}
 315     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 316     {$undef GLB_LIB_JPEG}
 317   {$ENDIF}
 318
 319   {$DEFINE GLB_SUPPORT_PNG_READ}
 320   {$DEFINE GLB_SUPPORT_JPEG_READ}
 321 {$ENDIF}
 322
 323 // PNG Image
 324 {$IFDEF GLB_PNGIMAGE}
 325   {$IFDEF GLB_LIB_PNG}
 326     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 327     {$undef GLB_LIB_PNG}
 328   {$ENDIF}
 329
 330   {$DEFINE GLB_SUPPORT_PNG_READ}
 331   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 332 {$ENDIF}
 333
 334 // libPNG
 335 {$IFDEF GLB_LIB_PNG}
 336   {$DEFINE GLB_SUPPORT_PNG_READ}
 337   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 338 {$ENDIF}
 339
 340 // JPEG Image
 341 {$IFDEF GLB_DELPHI_JPEG}
 342   {$IFDEF GLB_LIB_JPEG}
 343     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 344     {$undef GLB_LIB_JPEG}
 345   {$ENDIF}
 346
 347   {$DEFINE GLB_SUPPORT_JPEG_READ}
 348   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 349 {$ENDIF}
 350
 351 // libJPEG
 352 {$IFDEF GLB_LIB_JPEG}
 353   {$DEFINE GLB_SUPPORT_JPEG_READ}
 354   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 355 {$ENDIF}
 356
 357 // native OpenGL
 358 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 359   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 360 {$ENDIF}
 361
 362 // general options
 363 {$EXTENDEDSYNTAX ON}
 364 {$LONGSTRINGS ON}
 365 {$ALIGN ON}
 366 {$IFNDEF FPC}
 367   {$OPTIMIZATION ON}
 368 {$ENDIF}
 369
 370 interface
 371
 372 uses
 373   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                   {$ENDIF}
 374   {$IF DEFINED(GLB_WIN) AND
 375        DEFINED(GLB_NATIVE_OGL)} windows,                 {$IFEND}
 376
 377   {$IFDEF GLB_SDL}              SDL,                         {$ENDIF}
 378   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,           {$ENDIF}
 379
 380   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                   {$ENDIF}
 381
 382   {$IFDEF GLB_PNGIMAGE}         pngimage,                    {$ENDIF}
 383   {$IFDEF GLB_LIB_PNG}          libPNG,                      {$ENDIF}
 384
 385   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                        {$ENDIF}
 386   {$IFDEF GLB_LIB_JPEG}         libJPEG,                     {$ENDIF}
 387
 388   Classes, SysUtils;
 389
 390 {$IFNDEF GLB_DELPHI}
 391 type
 392   HGLRC = Cardinal;
 393   DWORD = Cardinal;
 394   PDWORD = ^DWORD;
 395
 396   TRGBQuad = packed record
 397     rgbBlue: Byte;
 398     rgbGreen: Byte;
 399     rgbRed: Byte;
 400     rgbReserved: Byte;
 401   end;
 402 {$ENDIF}
 403
 404 {$IFDEF GLB_NATIVE_OGL}
 405 const
 406   GL_TRUE   = 1;
 407   GL_FALSE  = 0;
 408
 409   GL_VERSION    = $1F02;
 410   GL_EXTENSIONS = $1F03;
 411
 412   GL_TEXTURE_1D         = $0DE0;
 413   GL_TEXTURE_2D         = $0DE1;
 414   GL_TEXTURE_RECTANGLE  = $84F5;
 415
 416   GL_TEXTURE_WIDTH            = $1000;
 417   GL_TEXTURE_HEIGHT           = $1001;
 418   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 419
 420   GL_ALPHA    = $1906;
 421   GL_ALPHA4   = $803B;
 422   GL_ALPHA8   = $803C;
 423   GL_ALPHA12  = $803D;
 424   GL_ALPHA16  = $803E;
 425
 426   GL_LUMINANCE    = $1909;
 427   GL_LUMINANCE4   = $803F;
 428   GL_LUMINANCE8   = $8040;
 429   GL_LUMINANCE12  = $8041;
 430   GL_LUMINANCE16  = $8042;
 431
 432   GL_LUMINANCE_ALPHA      = $190A;
 433   GL_LUMINANCE4_ALPHA4    = $8043;
 434   GL_LUMINANCE6_ALPHA2    = $8044;
 435   GL_LUMINANCE8_ALPHA8    = $8045;
 436   GL_LUMINANCE12_ALPHA4   = $8046;
 437   GL_LUMINANCE12_ALPHA12  = $8047;
 438   GL_LUMINANCE16_ALPHA16  = $8048;
 439
 440   GL_RGB      = $1907;
 441   GL_BGR      = $80E0;
 442   GL_R3_G3_B2 = $2A10;
 443   GL_RGB4     = $804F;
 444   GL_RGB5     = $8050;
 445   GL_RGB565   = $8D62;
 446   GL_RGB8     = $8051;
 447   GL_RGB10    = $8052;
 448   GL_RGB12    = $8053;
 449   GL_RGB16    = $8054;
 450
 451   GL_RGBA     = $1908;
 452   GL_BGRA     = $80E1;
 453   GL_RGBA2    = $8055;
 454   GL_RGBA4    = $8056;
 455   GL_RGB5_A1  = $8057;
 456   GL_RGBA8    = $8058;
 457   GL_RGB10_A2 = $8059;
 458   GL_RGBA12   = $805A;
 459   GL_RGBA16   = $805B;
 460
 461   GL_DEPTH_COMPONENT    = $1902;
 462   GL_DEPTH_COMPONENT16  = $81A5;
 463   GL_DEPTH_COMPONENT24  = $81A6;
 464   GL_DEPTH_COMPONENT32  = $81A7;
 465
 466   GL_COMPRESSED_RGB                 = $84ED;
 467   GL_COMPRESSED_RGBA                = $84EE;
 468   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 469   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 470   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 471   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 472
 473   GL_UNSIGNED_BYTE            = $1401;
 474   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 475   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 476
 477   GL_UNSIGNED_SHORT             = $1403;
 478   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 479   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 480   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 481   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 482   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 483   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 484
 485   GL_UNSIGNED_INT                 = $1405;
 486   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 487   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 488   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 489   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 490
 491   { Texture Filter }
 492   GL_TEXTURE_MAG_FILTER     = $2800;
 493   GL_TEXTURE_MIN_FILTER     = $2801;
 494   GL_NEAREST                = $2600;
 495   GL_NEAREST_MIPMAP_NEAREST = $2700;
 496   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 497   GL_LINEAR                 = $2601;
 498   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 499   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 500
 501   { Texture Wrap }
 502   GL_TEXTURE_WRAP_S   = $2802;
 503   GL_TEXTURE_WRAP_T   = $2803;
 504   GL_TEXTURE_WRAP_R   = $8072;
 505   GL_CLAMP            = $2900;
 506   GL_REPEAT           = $2901;
 507   GL_CLAMP_TO_EDGE    = $812F;
 508   GL_CLAMP_TO_BORDER  = $812D;
 509   GL_MIRRORED_REPEAT  = $8370;
 510
 511   { Other }
 512   GL_GENERATE_MIPMAP      = $8191;
 513   GL_TEXTURE_BORDER_COLOR = $1004;
 514   GL_MAX_TEXTURE_SIZE     = $0D33;
 515   GL_PACK_ALIGNMENT       = $0D05;
 516   GL_UNPACK_ALIGNMENT     = $0CF5;
 517
 518   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 519   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 520
 521 {$ifdef LINUX}
 522   libglu    = 'libGLU.so.1';
 523   libopengl = 'libGL.so.1';
 524 {$else}
 525   libglu    = 'glu32.dll';
 526   libopengl = 'opengl32.dll';
 527 {$endif}
 528
 529 type
 530   GLboolean = BYTEBOOL;
 531   GLint     = Integer;
 532   GLsizei   = Integer;
 533   GLuint    = Cardinal;
 534   GLfloat   = Single;
 535   GLenum    = Cardinal;
 536
 537   PGLvoid    = Pointer;
 538   PGLboolean = ^GLboolean;
 539   PGLint     = ^GLint;
 540   PGLuint    = ^GLuint;
 541   PGLfloat   = ^GLfloat;
 542
 543   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 544   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}
 545   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 546
 547 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 548   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 550
 551   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 553
 554   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 557   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 560
 561   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 564
 565   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 567   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 568
 569   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}
 570   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}
 571   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 572
 573   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 574   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 575
 576   {$IFDEF GLB_LINUX}
 577   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 578   {$ELSE}
 579   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 580   {$ENDIF}
 581
 582 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 583   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 585
 586   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588
 589   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 592   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 593   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 595
 596   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 597   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 598   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 599
 600   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 601   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;
 602   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 603
 604   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;
 605   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;
 606   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 607
 608   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 609   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 610 {$ENDIF}
 611
 612 var
 613   GL_VERSION_1_2,
 614   GL_VERSION_1_3,
 615   GL_VERSION_1_4,
 616   GL_VERSION_2_0,
 617
 618   GL_SGIS_generate_mipmap,
 619
 620   GL_ARB_texture_border_clamp,
 621   GL_ARB_texture_mirrored_repeat,
 622   GL_ARB_texture_rectangle,
 623   GL_ARB_texture_non_power_of_two,
 624
 625   GL_IBM_texture_mirrored_repeat,
 626
 627   GL_NV_texture_rectangle,
 628
 629   GL_EXT_texture_edge_clamp,
 630   GL_EXT_texture_rectangle,
 631   GL_EXT_texture_filter_anisotropic: Boolean;
 632
 633   glCompressedTexImage1D: TglCompressedTexImage1D;
 634   glCompressedTexImage2D: TglCompressedTexImage2D;
 635   glGetCompressedTexImage: TglGetCompressedTexImage;
 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
 666   {$IF DEFINED(GLB_WIN)}
 667   wglGetProcAddress: TwglGetProcAddress;
 668   {$ELSEIF DEFINED(GLB_LINUX)}
 669   glXGetProcAddress: TglXGetProcAddress;
 670   glXGetProcAddressARB: TglXGetProcAddressARB;
 671   {$ENDIF}
 672 {$ENDIF}
 673
 674 (*
 675 {$IFDEF GLB_DELPHI}
 676 var
 677   gLastContext: HGLRC;
 678 {$ENDIF}
 679 *)
 680
 681 {$ENDIF}
 682
 683 type
 684 ////////////////////////////////////////////////////////////////////////////////////////////////////
 685   TglBitmapFormat = (
 686     tfEmpty = 0, //must be smallest value!
 687
 688     tfAlpha4,
 689     tfAlpha8,
 690     tfAlpha12,
 691     tfAlpha16,
 692
 693     tfLuminance4,
 694     tfLuminance8,
 695     tfLuminance12,
 696     tfLuminance16,
 697
 698     tfLuminance4Alpha4,
 699     tfLuminance6Alpha2,
 700     tfLuminance8Alpha8,
 701     tfLuminance12Alpha4,
 702     tfLuminance12Alpha12,
 703     tfLuminance16Alpha16,
 704
 705     tfR3G3B2,
 706     tfRGB4,
 707     tfR5G6B5,
 708     tfRGB5,
 709     tfRGB8,
 710     tfRGB10,
 711     tfRGB12,
 712     tfRGB16,
 713
 714     tfRGBA2,
 715     tfRGBA4,
 716     tfRGB5A1,
 717     tfRGBA8,
 718     tfRGB10A2,
 719     tfRGBA12,
 720     tfRGBA16,
 721
 722     tfBGR4,
 723     tfB5G6R5,
 724     tfBGR5,
 725     tfBGR8,
 726     tfBGR10,
 727     tfBGR12,
 728     tfBGR16,
 729
 730     tfBGRA2,
 731     tfBGRA4,
 732     tfBGR5A1,
 733     tfBGRA8,
 734     tfBGR10A2,
 735     tfBGRA12,
 736     tfBGRA16,
 737
 738     tfDepth16,
 739     tfDepth24,
 740     tfDepth32,
 741
 742     tfS3tcDtx1RGBA,
 743     tfS3tcDtx3RGBA,
 744     tfS3tcDtx5RGBA
 745   );
 746
 747   TglBitmapFileType = (
 748      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 749      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 750      ftDDS,
 751      ftTGA,
 752      ftBMP);
 753    TglBitmapFileTypes = set of TglBitmapFileType;
 754
 755    TglBitmapMipMap = (
 756      mmNone,
 757      mmMipmap,
 758      mmMipmapGlu);
 759
 760    TglBitmapNormalMapFunc = (
 761      nm4Samples,
 762      nmSobel,
 763      nm3x3,
 764      nm5x5);
 765
 766  ////////////////////////////////////////////////////////////////////////////////////////////////////
 767    EglBitmapException               = class(Exception);
 768    EglBitmapSizeToLargeException    = class(EglBitmapException);
 769    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 770    EglBitmapUnsupportedFormat       = class(EglBitmapException)
 771      constructor Create(const aFormat: TglBitmapFormat);
 772    end;
 773
 774 ////////////////////////////////////////////////////////////////////////////////////////////////////
 775   TglBitmapColorRec = packed record
 776   case Integer of
 777     0: (r, g, b, a: Cardinal);
 778     1: (arr: array[0..3] of Cardinal);
 779   end;
 780
 781   TglBitmapPixelData = packed record
 782     Data, Range: TglBitmapColorRec;
 783     Format: TglBitmapFormat;
 784   end;
 785   PglBitmapPixelData = ^TglBitmapPixelData;
 786
 787 ////////////////////////////////////////////////////////////////////////////////////////////////////
 788   TglBitmapPixelPositionFields = set of (ffX, ffY);
 789   TglBitmapPixelPosition = record
 790     Fields : TglBitmapPixelPositionFields;
 791     X : Word;
 792     Y : Word;
 793   end;
 794
 795 ////////////////////////////////////////////////////////////////////////////////////////////////////
 796   TglBitmap = class;
 797   TglBitmapFunctionRec = record
 798     Sender:   TglBitmap;
 799     Size:     TglBitmapPixelPosition;
 800     Position: TglBitmapPixelPosition;
 801     Source:   TglBitmapPixelData;
 802     Dest:     TglBitmapPixelData;
 803     Args:     Pointer;
 804   end;
 805   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 806
 807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 808   TglBitmap = class
 809   protected
 810     fID: GLuint;
 811     fTarget: GLuint;
 812     fAnisotropic: Integer;
 813     fDeleteTextureOnFree: Boolean;
 814     fFreeDataAfterGenTexture: Boolean;
 815     fData: PByte;
 816     fIsResident: Boolean;
 817     fBorderColor: array[0..3] of Single;
 818
 819     fDimension: TglBitmapPixelPosition;
 820     fMipMap: TglBitmapMipMap;
 821     fFormat: TglBitmapFormat;
 822
 823     // Mapping
 824     fPixelSize: Integer;
 825     fRowSize: Integer;
 826
 827     // Filtering
 828     fFilterMin: Cardinal;
 829     fFilterMag: Cardinal;
 830
 831     // TexturWarp
 832     fWrapS: Cardinal;
 833     fWrapT: Cardinal;
 834     fWrapR: Cardinal;
 835
 836     // CustomData
 837     fFilename: String;
 838     fCustomName: String;
 839     fCustomNameW: WideString;
 840     fCustomData: Pointer;
 841
 842     //Getter
 843     function GetWidth:  Integer; virtual;
 844     function GetHeight: Integer; virtual;
 845
 846     function GetFileWidth:  Integer; virtual;
 847     function GetFileHeight: Integer; virtual;
 848
 849     //Setter
 850     procedure SetCustomData(const aValue: Pointer);
 851     procedure SetCustomName(const aValue: String);
 852     procedure SetCustomNameW(const aValue: WideString);
 853     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 854     procedure SetFormat(const aValue: TglBitmapFormat);
 855     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 856     procedure SetID(const aValue: Cardinal);
 857     procedure SetMipMap(const aValue: TglBitmapMipMap);
 858     procedure SetTarget(const aValue: Cardinal);
 859     procedure SetAnisotropic(const aValue: Integer);
 860
 861     procedure CreateID;
 862     procedure SetupParameters(out aBuildWithGlu: Boolean);
 863     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 864       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 865     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 866
 867     function FlipHorz: Boolean; virtual;
 868     function FlipVert: Boolean; virtual;
 869
 870     property Width:  Integer read GetWidth;
 871     property Height: Integer read GetHeight;
 872
 873     property FileWidth:  Integer read GetFileWidth;
 874     property FileHeight: Integer read GetFileHeight;
 875   public
 876     //Properties
 877     property ID:           Cardinal        read fID          write SetID;
 878     property Target:       Cardinal        read fTarget      write SetTarget;
 879     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 880     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 881     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 882
 883     property Filename:    String     read fFilename;
 884     property CustomName:  String     read fCustomName  write SetCustomName;
 885     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 886     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 887
 888     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 889     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 890
 891     property Dimension:  TglBitmapPixelPosition  read fDimension;
 892     property Data:       PByte                   read fData;
 893     property IsResident: Boolean                 read fIsResident;
 894
 895     procedure AfterConstruction; override;
 896     procedure BeforeDestruction; override;
 897
 898     //Load
 899     procedure LoadFromFile(const aFilename: String);
 900     procedure LoadFromStream(const aStream: TStream); virtual;
 901     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 902       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 903     {$IFDEF GLB_DELPHI}
 904     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 905     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 906     {$ENDIF}
 907
 908     //Save
 909     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 910     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 911
 912     //Convert
 913     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 914     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 915       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 916   public
 917     //Alpha & Co
 918     {$IFDEF GLB_SDL}
 919     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 920     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 921     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 922     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 923       const aArgs: Pointer = nil): Boolean;
 924     {$ENDIF}
 925
 926     {$IFDEF GLB_DELPHI}
 927     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 928     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 929     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 930     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 931       const aArgs: Pointer = nil): Boolean;
 932     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 933       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 934     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 935       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 936     {$ENDIF}
 937
 938     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 939     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 940     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 941     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 942
 943     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 944     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 945     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 946
 947     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 948     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 949     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 950
 951     function RemoveAlpha: Boolean; virtual;
 952   public
 953     //Common
 954     function Clone: TglBitmap;
 955     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 956     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 957     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 958     procedure FreeData;
 959
 960     //ColorFill
 961     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 962     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 963     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 964
 965     //TexParameters
 966     procedure SetFilter(const aMin, aMag: Cardinal);
 967     procedure SetWrap(
 968       const S: Cardinal = GL_CLAMP_TO_EDGE;
 969       const T: Cardinal = GL_CLAMP_TO_EDGE;
 970       const R: Cardinal = GL_CLAMP_TO_EDGE);
 971
 972     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 973     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 974
 975     //Constructors
 976     constructor Create; overload;
 977     constructor Create(const aFileName: String); overload;
 978     constructor Create(const aStream: TStream); overload;
 979     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 980     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 981     {$IFDEF GLB_DELPHI}
 982     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 983     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 984     {$ENDIF}
 985   private
 986     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 987     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
 988
 989     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 990     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
 991
 992     function LoadBMP(const aStream: TStream): Boolean; virtual;
 993     procedure SaveBMP(const aStream: TStream); virtual;
 994
 995     function LoadTGA(const aStream: TStream): Boolean; virtual;
 996     procedure SaveTGA(const aStream: TStream); virtual;
 997
 998     function LoadDDS(const aStream: TStream): Boolean; virtual;
 999     procedure SaveDDS(const aStream: TStream); virtual;
1000   end;
1001
1002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1003   TglBitmap2D = class(TglBitmap)
1004   protected
1005     // Bildeinstellungen
1006     fLines: array of PByte;
1007
1008     (* TODO
1009     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1010     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1011     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1012     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1013     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1014     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1015     *)
1016
1017     function GetScanline(const aIndex: Integer): Pointer;
1018     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1019       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1020     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1021   public
1022     property Width;
1023     property Height;
1024     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1025
1026     procedure AfterConstruction; override;
1027
1028     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1029     procedure GetDataFromTexture;
1030     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1031
1032     function FlipHorz: Boolean; override;
1033     function FlipVert: Boolean; override;
1034
1035     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1036       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1037   end;
1038
1039 (* TODO
1040   TglBitmapCubeMap = class(TglBitmap2D)
1041   protected
1042     fGenMode: Integer;
1043
1044     // Hide GenTexture
1045     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1046   public
1047     procedure AfterConstruction; override;
1048
1049     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1050
1051     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1052     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1053   end;
1054
1055
1056   TglBitmapNormalMap = class(TglBitmapCubeMap)
1057   public
1058     procedure AfterConstruction; override;
1059
1060     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1061   end;
1062
1063
1064   TglBitmap1D = class(TglBitmap)
1065   protected
1066     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1067
1068     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1069     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1070   public
1071     // propertys
1072     property Width;
1073
1074     procedure AfterConstruction; override;
1075
1076     // Other
1077     function FlipHorz: Boolean; override;
1078
1079     // Generation
1080     procedure GenTexture(TestTextureSize: Boolean = true); override;
1081   end;
1082 *)
1083
1084 const
1085   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1086
1087 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1088 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1089 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1090 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1091 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1092 procedure glBitmapSetDefaultWrap(
1093   const S: Cardinal = GL_CLAMP_TO_EDGE;
1094   const T: Cardinal = GL_CLAMP_TO_EDGE;
1095   const R: Cardinal = GL_CLAMP_TO_EDGE);
1096
1097 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1098 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1099 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1100 function glBitmapGetDefaultFormat: TglBitmapFormat;
1101 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1102 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1103
1104 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1105 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1106 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1107
1108 var
1109   glBitmapDefaultDeleteTextureOnFree: Boolean;
1110   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1111   glBitmapDefaultFormat: TglBitmapFormat;
1112   glBitmapDefaultMipmap: TglBitmapMipMap;
1113   glBitmapDefaultFilterMin: Cardinal;
1114   glBitmapDefaultFilterMag: Cardinal;
1115   glBitmapDefaultWrapS: Cardinal;
1116   glBitmapDefaultWrapT: Cardinal;
1117   glBitmapDefaultWrapR: Cardinal;
1118
1119 {$IFDEF GLB_DELPHI}
1120 function CreateGrayPalette: HPALETTE;
1121 {$ENDIF}
1122
1123 implementation
1124
1125
1126     (* TODO
1127     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1128     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1129     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1130     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1131     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1132     *)
1133
1134 uses
1135   Math, syncobjs, typinfo;
1136
1137 type
1138 ////////////////////////////////////////////////////////////////////////////////////////////////////
1139   TShiftRec = packed record
1140   case Integer of
1141     0: (r, g, b, a: Byte);
1142     1: (arr: array[0..3] of Byte);
1143   end;
1144
1145   TFormatDescriptor = class(TObject)
1146   private
1147     function GetRedMask: QWord;
1148     function GetGreenMask: QWord;
1149     function GetBlueMask: QWord;
1150     function GetAlphaMask: QWord;
1151   protected
1152     fFormat: TglBitmapFormat;
1153     fWithAlpha: TglBitmapFormat;
1154     fWithoutAlpha: TglBitmapFormat;
1155     fRGBInverted: TglBitmapFormat;
1156     fUncompressed: TglBitmapFormat;
1157     fPixelSize: Single;
1158     fIsCompressed: Boolean;
1159
1160     fRange: TglBitmapColorRec;
1161     fShift: TShiftRec;
1162
1163     fglFormat:         Cardinal;
1164     fglInternalFormat: Cardinal;
1165     fglDataFormat:     Cardinal;
1166
1167     function GetComponents: Integer; virtual;
1168   public
1169     property Format:       TglBitmapFormat read fFormat;
1170     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1171     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1172     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1173     property Components:   Integer         read GetComponents;
1174     property PixelSize:    Single          read fPixelSize;
1175     property IsCompressed: Boolean         read fIsCompressed;
1176
1177     property glFormat:         Cardinal read fglFormat;
1178     property glInternalFormat: Cardinal read fglInternalFormat;
1179     property glDataFormat:     Cardinal read fglDataFormat;
1180
1181     property Range: TglBitmapColorRec read fRange;
1182     property Shift: TShiftRec         read fShift;
1183
1184     property RedMask:   QWord read GetRedMask;
1185     property GreenMask: QWord read GetGreenMask;
1186     property BlueMask:  QWord read GetBlueMask;
1187     property AlphaMask: QWord read GetAlphaMask;
1188
1189     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1190     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1191
1192     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1193     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1194
1195     function CreateMappingData: Pointer; virtual;
1196     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1197
1198     function IsEmpty:  Boolean; virtual;
1199     function HasAlpha: Boolean; virtual;
1200     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1201
1202     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1203
1204     constructor Create; virtual;
1205   public
1206     class procedure Init;
1207     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1208     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1209     class procedure Clear;
1210     class procedure Finalize;
1211   end;
1212   TFormatDescriptorClass = class of TFormatDescriptor;
1213
1214   TfdEmpty = class(TFormatDescriptor);
1215
1216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1217   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1218     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1219     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1220     constructor Create; override;
1221   end;
1222
1223   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1224     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1225     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1226     constructor Create; override;
1227   end;
1228
1229   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1230     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1231     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1232     constructor Create; override;
1233   end;
1234
1235   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1236     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1237     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1238     constructor Create; override;
1239   end;
1240
1241   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1242     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1243     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1244     constructor Create; override;
1245   end;
1246
1247   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1248     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1249     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1250     constructor Create; override;
1251   end;
1252
1253   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1254     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1255     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1256     constructor Create; override;
1257   end;
1258
1259   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1260     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1261     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1262     constructor Create; override;
1263   end;
1264
1265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1266   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1267     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269     constructor Create; override;
1270   end;
1271
1272   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1273     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275     constructor Create; override;
1276   end;
1277
1278   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1279     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1280     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1281     constructor Create; override;
1282   end;
1283
1284   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1285     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1286     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1287     constructor Create; override;
1288   end;
1289
1290   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1293     constructor Create; override;
1294   end;
1295
1296   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299     constructor Create; override;
1300   end;
1301
1302   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1303     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1304     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1305     constructor Create; override;
1306   end;
1307
1308   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1309     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311     constructor Create; override;
1312   end;
1313
1314   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1315     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1316     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1317     constructor Create; override;
1318   end;
1319
1320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1321   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330     constructor Create; override;
1331   end;
1332
1333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1334   TfdAlpha4 = class(TfdAlpha_UB1)
1335     constructor Create; override;
1336   end;
1337
1338   TfdAlpha8 = class(TfdAlpha_UB1)
1339     constructor Create; override;
1340   end;
1341
1342   TfdAlpha12 = class(TfdAlpha_US1)
1343     constructor Create; override;
1344   end;
1345
1346   TfdAlpha16 = class(TfdAlpha_US1)
1347     constructor Create; override;
1348   end;
1349
1350   TfdLuminance4 = class(TfdLuminance_UB1)
1351     constructor Create; override;
1352   end;
1353
1354   TfdLuminance8 = class(TfdLuminance_UB1)
1355     constructor Create; override;
1356   end;
1357
1358   TfdLuminance12 = class(TfdLuminance_US1)
1359     constructor Create; override;
1360   end;
1361
1362   TfdLuminance16 = class(TfdLuminance_US1)
1363     constructor Create; override;
1364   end;
1365
1366   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1367     constructor Create; override;
1368   end;
1369
1370   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1371     constructor Create; override;
1372   end;
1373
1374   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1375     constructor Create; override;
1376   end;
1377
1378   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1379     constructor Create; override;
1380   end;
1381
1382   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1383     constructor Create; override;
1384   end;
1385
1386   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1387     constructor Create; override;
1388   end;
1389
1390   TfdR3G3B2 = class(TfdUniversal_UB1)
1391     constructor Create; override;
1392   end;
1393
1394   TfdRGB4 = class(TfdUniversal_US1)
1395     constructor Create; override;
1396   end;
1397
1398   TfdR5G6B5 = class(TfdUniversal_US1)
1399     constructor Create; override;
1400   end;
1401
1402   TfdRGB5 = class(TfdUniversal_US1)
1403     constructor Create; override;
1404   end;
1405
1406   TfdRGB8 = class(TfdRGB_UB3)
1407     constructor Create; override;
1408   end;
1409
1410   TfdRGB10 = class(TfdUniversal_UI1)
1411     constructor Create; override;
1412   end;
1413
1414   TfdRGB12 = class(TfdRGB_US3)
1415     constructor Create; override;
1416   end;
1417
1418   TfdRGB16 = class(TfdRGB_US3)
1419     constructor Create; override;
1420   end;
1421
1422   TfdRGBA2 = class(TfdRGBA_UB4)
1423     constructor Create; override;
1424   end;
1425
1426   TfdRGBA4 = class(TfdUniversal_US1)
1427     constructor Create; override;
1428   end;
1429
1430   TfdRGB5A1 = class(TfdUniversal_US1)
1431     constructor Create; override;
1432   end;
1433
1434   TfdRGBA8 = class(TfdRGBA_UB4)
1435     constructor Create; override;
1436   end;
1437
1438   TfdRGB10A2 = class(TfdUniversal_UI1)
1439     constructor Create; override;
1440   end;
1441
1442   TfdRGBA12 = class(TfdRGBA_US4)
1443     constructor Create; override;
1444   end;
1445
1446   TfdRGBA16 = class(TfdRGBA_US4)
1447     constructor Create; override;
1448   end;
1449
1450   TfdBGR4 = class(TfdUniversal_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdB5G6R5 = class(TfdUniversal_US1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdBGR5 = class(TfdUniversal_US1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdBGR8 = class(TfdBGR_UB3)
1463     constructor Create; override;
1464   end;
1465
1466   TfdBGR10 = class(TfdUniversal_UI1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdBGR12 = class(TfdBGR_US3)
1471     constructor Create; override;
1472   end;
1473
1474   TfdBGR16 = class(TfdBGR_US3)
1475     constructor Create; override;
1476   end;
1477
1478   TfdBGRA2 = class(TfdBGRA_UB4)
1479     constructor Create; override;
1480   end;
1481
1482   TfdBGRA4 = class(TfdUniversal_US1)
1483     constructor Create; override;
1484   end;
1485
1486   TfdBGR5A1 = class(TfdUniversal_US1)
1487     constructor Create; override;
1488   end;
1489
1490   TfdBGRA8 = class(TfdBGRA_UB4)
1491     constructor Create; override;
1492   end;
1493
1494   TfdBGR10A2 = class(TfdUniversal_UI1)
1495     constructor Create; override;
1496   end;
1497
1498   TfdBGRA12 = class(TfdBGRA_US4)
1499     constructor Create; override;
1500   end;
1501
1502   TfdBGRA16 = class(TfdBGRA_US4)
1503     constructor Create; override;
1504   end;
1505
1506   TfdDepth16 = class(TfdDepth_US1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdDepth24 = class(TfdDepth_UI1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdDepth32 = class(TfdDepth_UI1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1519     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1520     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1521     constructor Create; override;
1522   end;
1523
1524   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1525     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1526     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1527     constructor Create; override;
1528   end;
1529
1530   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1531     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1532     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1533     constructor Create; override;
1534   end;
1535
1536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1537   TbmpBitfieldFormat = class(TFormatDescriptor)
1538   private
1539     procedure SetRedMask  (const aValue: QWord);
1540     procedure SetGreenMask(const aValue: QWord);
1541     procedure SetBlueMask (const aValue: QWord);
1542     procedure SetAlphaMask(const aValue: QWord);
1543
1544     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1545   public
1546     property RedMask:   QWord read GetRedMask   write SetRedMask;
1547     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1548     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1549     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1550
1551     property PixelSize: Single read fPixelSize write fPixelSize;
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   end;
1556
1557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1558   TbmpColorTableEnty = packed record
1559     b, g, r, a: Byte;
1560   end;
1561   TbmpColorTable = array of TbmpColorTableEnty;
1562   TbmpColorTableFormat = class(TFormatDescriptor)
1563   private
1564     fColorTable: TbmpColorTable;
1565   public
1566     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1567     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1568     property Range:      TglBitmapColorRec read fRange      write fRange;
1569     property Shift:      TShiftRec         read fShift      write fShift;
1570     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1571
1572     procedure CreateColorTable;
1573
1574     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1575     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1576     destructor Destroy; override;
1577   end;
1578
1579 const
1580   LUMINANCE_WEIGHT_R = 0.30;
1581   LUMINANCE_WEIGHT_G = 0.59;
1582   LUMINANCE_WEIGHT_B = 0.11;
1583
1584   ALPHA_WEIGHT_R = 0.30;
1585   ALPHA_WEIGHT_G = 0.59;
1586   ALPHA_WEIGHT_B = 0.11;
1587
1588   DEPTH_WEIGHT_R = 0.333333333;
1589   DEPTH_WEIGHT_G = 0.333333333;
1590   DEPTH_WEIGHT_B = 0.333333333;
1591
1592   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1593
1594   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1595     TfdEmpty,
1596
1597     TfdAlpha4,
1598     TfdAlpha8,
1599     TfdAlpha12,
1600     TfdAlpha16,
1601
1602     TfdLuminance4,
1603     TfdLuminance8,
1604     TfdLuminance12,
1605     TfdLuminance16,
1606
1607     TfdLuminance4Alpha4,
1608     TfdLuminance6Alpha2,
1609     TfdLuminance8Alpha8,
1610     TfdLuminance12Alpha4,
1611     TfdLuminance12Alpha12,
1612     TfdLuminance16Alpha16,
1613
1614     TfdR3G3B2,
1615     TfdRGB4,
1616     TfdR5G6B5,
1617     TfdRGB5,
1618     TfdRGB8,
1619     TfdRGB10,
1620     TfdRGB12,
1621     TfdRGB16,
1622
1623     TfdRGBA2,
1624     TfdRGBA4,
1625     TfdRGB5A1,
1626     TfdRGBA8,
1627     TfdRGB10A2,
1628     TfdRGBA12,
1629     TfdRGBA16,
1630
1631     TfdBGR4,
1632     TfdB5G6R5,
1633     TfdBGR5,
1634     TfdBGR8,
1635     TfdBGR10,
1636     TfdBGR12,
1637     TfdBGR16,
1638
1639     TfdBGRA2,
1640     TfdBGRA4,
1641     TfdBGR5A1,
1642     TfdBGRA8,
1643     TfdBGR10A2,
1644     TfdBGRA12,
1645     TfdBGRA16,
1646
1647     TfdDepth16,
1648     TfdDepth24,
1649     TfdDepth32,
1650
1651     TfdS3tcDtx1RGBA,
1652     TfdS3tcDtx3RGBA,
1653     TfdS3tcDtx5RGBA
1654   );
1655
1656 var
1657   FormatDescriptorCS: TCriticalSection;
1658   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1659
1660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1661 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1662 begin
1663   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1664 end;
1665
1666 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1667 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1668 begin
1669   result.Fields := [];
1670
1671   if X >= 0 then
1672     result.Fields := result.Fields + [ffX];
1673   if Y >= 0 then
1674     result.Fields := result.Fields + [ffY];
1675
1676   result.X := Max(0, X);
1677   result.Y := Max(0, Y);
1678 end;
1679
1680 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1681 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1682 begin
1683   result.r := r;
1684   result.g := g;
1685   result.b := b;
1686   result.a := a;
1687 end;
1688
1689 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1690 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1691 var
1692   i: Integer;
1693 begin
1694   result := false;
1695   for i := 0 to high(r1.arr) do
1696     if (r1.arr[i] <> r2.arr[i]) then
1697       exit;
1698   result := true;
1699 end;
1700
1701 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1702 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1703 begin
1704   result.r := r;
1705   result.g := g;
1706   result.b := b;
1707   result.a := a;
1708 end;
1709
1710 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1711 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1712 begin
1713   result := [];
1714
1715   if (aFormat in [
1716         //4 bbp
1717         tfLuminance4,
1718
1719         //8bpp
1720         tfR3G3B2, tfLuminance8,
1721
1722         //16bpp
1723         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1724         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1725
1726         //24bpp
1727         tfBGR8, tfRGB8,
1728
1729         //32bpp
1730         tfRGB10, tfRGB10A2, tfRGBA8,
1731         tfBGR10, tfBGR10A2, tfBGRA8]) then
1732     result := result + [ftBMP];
1733
1734   if (aFormat in [
1735         //8 bpp
1736         tfLuminance8, tfAlpha8,
1737
1738         //16 bpp
1739         tfLuminance16, tfLuminance8Alpha8,
1740         tfRGB5, tfRGB5A1, tfRGBA4,
1741         tfBGR5, tfBGR5A1, tfBGRA4,
1742
1743         //24 bpp
1744         tfRGB8, tfBGR8,
1745
1746         //32 bpp
1747         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1748     result := result + [ftTGA];
1749
1750   if (aFormat in [
1751         //8 bpp
1752         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1753         tfR3G3B2, tfRGBA2, tfBGRA2,
1754
1755         //16 bpp
1756         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1757         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1758         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1759
1760         //24 bpp
1761         tfRGB8, tfBGR8,
1762
1763         //32 bbp
1764         tfLuminance16Alpha16,
1765         tfRGBA8, tfRGB10A2,
1766         tfBGRA8, tfBGR10A2,
1767
1768         //compressed
1769         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1770     result := result + [ftDDS];
1771
1772   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1773   if aFormat in [
1774       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1775       tfRGB8, tfRGBA8,
1776       tfBGR8, tfBGRA8] then
1777     result := result + [ftPNG];
1778   {$ENDIF}
1779
1780   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1781   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1782     result := result + [ftJPEG];
1783   {$ENDIF}
1784 end;
1785
1786 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1787 function IsPowerOfTwo(aNumber: Integer): Boolean;
1788 begin
1789   while (aNumber and 1) = 0 do
1790     aNumber := aNumber shr 1;
1791   result := aNumber = 1;
1792 end;
1793
1794 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1795 function GetTopMostBit(aBitSet: QWord): Integer;
1796 begin
1797   result := 0;
1798   while aBitSet > 0 do begin
1799     inc(result);
1800     aBitSet := aBitSet shr 1;
1801   end;
1802 end;
1803
1804 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1805 function CountSetBits(aBitSet: QWord): Integer;
1806 begin
1807   result := 0;
1808   while aBitSet > 0 do begin
1809     if (aBitSet and 1) = 1 then
1810       inc(result);
1811     aBitSet := aBitSet shr 1;
1812   end;
1813 end;
1814
1815 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1817 begin
1818   result := Trunc(
1819     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1820     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1821     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1826 begin
1827   result := Trunc(
1828     DEPTH_WEIGHT_R * aPixel.Data.r +
1829     DEPTH_WEIGHT_G * aPixel.Data.g +
1830     DEPTH_WEIGHT_B * aPixel.Data.b);
1831 end;
1832
1833 {$IFDEF GLB_NATIVE_OGL}
1834 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1835 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1836 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1837 var
1838   GL_LibHandle: Pointer = nil;
1839
1840 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1841 begin
1842   result :=  nil;
1843
1844   if not Assigned(aLibHandle) then
1845     aLibHandle := GL_LibHandle;
1846
1847 {$IF DEFINED(GLB_WIN)}
1848   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1849   if Assigned(result) then
1850     exit;
1851
1852   if Assigned(wglGetProcAddress) then
1853     result := wglGetProcAddress(aProcName);
1854 {$ELSEIF DEFINED(GLB_LINUX)}
1855   if Assigned(glXGetProcAddress) then begin
1856     result := glXGetProcAddress(aProcName);
1857     if Assigned(result) then
1858       exit;
1859   end;
1860
1861   if Assigned(glXGetProcAddressARB) then begin
1862     result := glXGetProcAddressARB(aProcName);
1863     if Assigned(result) then
1864       exit;
1865   end;
1866
1867   result := dlsym(aLibHandle, aProcName);
1868 {$ENDIF}
1869   if not Assigned(result) then
1870     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1871 end;
1872
1873 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1874 var
1875   GLU_LibHandle: Pointer = nil;
1876   OpenGLInitialized: Boolean;
1877   InitOpenGLCS: TCriticalSection;
1878
1879 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1880 procedure glbInitOpenGL;
1881
1882   ////////////////////////////////////////////////////////////////////////////////
1883   function glbLoadLibrary(const aName: PChar): Pointer;
1884   begin
1885     {$IF DEFINED(GLB_WIN)}
1886     result := {%H-}Pointer(LoadLibrary(aName));
1887     {$ELSEIF DEFINED(GLB_LINUX)}
1888     result := dlopen(Name, RTLD_LAZY);
1889     {$ELSE}
1890     result := nil;
1891     {$ENDIF}
1892   end;
1893
1894   ////////////////////////////////////////////////////////////////////////////////
1895   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1896   begin
1897     result := false;
1898     if not Assigned(aLibHandle) then
1899       exit;
1900
1901     {$IF DEFINED(GLB_WIN)}
1902     Result := FreeLibrary({%H-}HINST(aLibHandle));
1903     {$ELSEIF DEFINED(GLB_LINUX)}
1904     Result := dlclose(aLibHandle) = 0;
1905     {$ENDIF}
1906   end;
1907
1908 begin
1909   if Assigned(GL_LibHandle) then
1910     glbFreeLibrary(GL_LibHandle);
1911
1912   if Assigned(GLU_LibHandle) then
1913     glbFreeLibrary(GLU_LibHandle);
1914
1915   GL_LibHandle := glbLoadLibrary(libopengl);
1916   if not Assigned(GL_LibHandle) then
1917     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1918
1919   GLU_LibHandle := glbLoadLibrary(libglu);
1920   if not Assigned(GLU_LibHandle) then
1921     raise EglBitmapException.Create('unable to load library: ' + libglu);
1922
1923   try
1924   {$IF DEFINED(GLB_WIN)}
1925     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1926   {$ELSEIF DEFINED(GLB_LINUX)}
1927     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1928     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1929   {$ENDIF}
1930
1931     glEnable := glbGetProcAddress('glEnable');
1932     glDisable := glbGetProcAddress('glDisable');
1933     glGetString := glbGetProcAddress('glGetString');
1934     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1935     glTexParameteri := glbGetProcAddress('glTexParameteri');
1936     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1937     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1938     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1939     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1940     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1941     glGenTextures := glbGetProcAddress('glGenTextures');
1942     glBindTexture := glbGetProcAddress('glBindTexture');
1943     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1944     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1945     glReadPixels := glbGetProcAddress('glReadPixels');
1946     glPixelStorei := glbGetProcAddress('glPixelStorei');
1947     glTexImage1D := glbGetProcAddress('glTexImage1D');
1948     glTexImage2D := glbGetProcAddress('glTexImage2D');
1949     glGetTexImage := glbGetProcAddress('glGetTexImage');
1950
1951     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1952     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1953   finally
1954     glbFreeLibrary(GL_LibHandle);
1955     glbFreeLibrary(GLU_LibHandle);
1956   end;
1957 end;
1958 {$ENDIF}
1959
1960 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1961 procedure glbReadOpenGLExtensions;
1962 var
1963   {$IFDEF GLB_DELPHI}
1964   Context: HGLRC;
1965   {$ENDIF}
1966   Buffer: AnsiString;
1967   MajorVersion, MinorVersion: Integer;
1968
1969   ///////////////////////////////////////////////////////////////////////////////////////////
1970   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1971   var
1972     Separator: Integer;
1973   begin
1974     aMinor := 0;
1975     aMajor := 0;
1976
1977     Separator := Pos(AnsiString('.'), aBuffer);
1978     if (Separator > 1) and (Separator < Length(aBuffer)) and
1979        (aBuffer[Separator - 1] in ['0'..'9']) and
1980        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1981
1982       Dec(Separator);
1983       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1984         Dec(Separator);
1985
1986       Delete(aBuffer, 1, Separator);
1987       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1988
1989       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1990         Inc(Separator);
1991
1992       Delete(aBuffer, Separator, 255);
1993       Separator := Pos(AnsiString('.'), aBuffer);
1994
1995       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1996       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
1997     end;
1998   end;
1999
2000   ///////////////////////////////////////////////////////////////////////////////////////////
2001   function CheckExtension(const Extension: AnsiString): Boolean;
2002   var
2003     ExtPos: Integer;
2004   begin
2005     ExtPos := Pos(Extension, Buffer);
2006     result := ExtPos > 0;
2007     if result then
2008       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2009   end;
2010
2011 begin
2012 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2013   InitOpenGLCS.Enter;
2014   try
2015     if not OpenGLInitialized then begin
2016       glbInitOpenGL;
2017       OpenGLInitialized := true;
2018     end;
2019   finally
2020     InitOpenGLCS.Leave;
2021   end;
2022 {$ENDIF}
2023
2024 {$IFDEF GLB_DELPHI}
2025   Context := wglGetCurrentContext;
2026   if (Context <> gLastContext) then begin
2027     gLastContext := Context;
2028 {$ENDIF}
2029
2030     // Version
2031     Buffer := glGetString(GL_VERSION);
2032     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2033
2034     GL_VERSION_1_2 := false;
2035     GL_VERSION_1_3 := false;
2036     GL_VERSION_1_4 := false;
2037     GL_VERSION_2_0 := false;
2038     if MajorVersion = 1 then begin
2039       if MinorVersion >= 2 then
2040         GL_VERSION_1_2 := true;
2041
2042       if MinorVersion >= 3 then
2043         GL_VERSION_1_3 := true;
2044
2045       if MinorVersion >= 4 then
2046         GL_VERSION_1_4 := true;
2047     end else if MajorVersion >= 2 then begin
2048       GL_VERSION_1_2 := true;
2049       GL_VERSION_1_3 := true;
2050       GL_VERSION_1_4 := true;
2051       GL_VERSION_2_0 := true;
2052     end;
2053
2054     // Extensions
2055     Buffer := glGetString(GL_EXTENSIONS);
2056     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2057     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2058     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2059     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2060     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2061     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2062     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2063     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2064     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2065     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2066
2067     if GL_VERSION_1_3 then begin
2068       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2069       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2070       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2071     end else begin
2072       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2073       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2074       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2075     end;
2076 {$IFDEF GLB_DELPHI}
2077   end;
2078 {$ENDIF}
2079 end;
2080 {$ENDIF}
2081
2082 (* TODO GLB_DELPHI
2083 {$IFDEF GLB_DELPHI}
2084 function CreateGrayPalette: HPALETTE;
2085 var
2086   Idx: Integer;
2087   Pal: PLogPalette;
2088 begin
2089   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2090
2091   Pal.palVersion := $300;
2092   Pal.palNumEntries := 256;
2093
2094   {$IFOPT R+}
2095     {$DEFINE GLB_TEMPRANGECHECK}
2096     {$R-}
2097   {$ENDIF}
2098
2099   for Idx := 0 to 256 - 1 do begin
2100     Pal.palPalEntry[Idx].peRed   := Idx;
2101     Pal.palPalEntry[Idx].peGreen := Idx;
2102     Pal.palPalEntry[Idx].peBlue  := Idx;
2103     Pal.palPalEntry[Idx].peFlags := 0;
2104   end;
2105
2106   {$IFDEF GLB_TEMPRANGECHECK}
2107     {$UNDEF GLB_TEMPRANGECHECK}
2108     {$R+}
2109   {$ENDIF}
2110
2111   result := CreatePalette(Pal^);
2112
2113   FreeMem(Pal);
2114 end;
2115 {$ENDIF}
2116 *)
2117
2118 {$IFDEF GLB_SDL_IMAGE}
2119 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2122 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2123 begin
2124   result := TStream(context^.unknown.data1).Seek(offset, whence);
2125 end;
2126
2127 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2128 begin
2129   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2130 end;
2131
2132 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2133 begin
2134   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2135 end;
2136
2137 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2138 begin
2139   result := 0;
2140 end;
2141
2142 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2143 begin
2144   result := SDL_AllocRW;
2145
2146   if result = nil then
2147     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2148
2149   result^.seek := glBitmapRWseek;
2150   result^.read := glBitmapRWread;
2151   result^.write := glBitmapRWwrite;
2152   result^.close := glBitmapRWclose;
2153   result^.unknown.data1 := Stream;
2154 end;
2155 {$ENDIF}
2156
2157 (* TODO LoadFuncs
2158 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2159 var
2160   glBitmap: TglBitmap2D;
2161 begin
2162   result := false;
2163   Texture := 0;
2164
2165   {$IFDEF GLB_DELPHI}
2166   if Instance = 0 then
2167     Instance := HInstance;
2168
2169   if (LoadFromRes) then
2170     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2171   else
2172   {$ENDIF}
2173     glBitmap := TglBitmap2D.Create(FileName);
2174
2175   try
2176     glBitmap.DeleteTextureOnFree := false;
2177     glBitmap.FreeDataAfterGenTexture := false;
2178     glBitmap.GenTexture(true);
2179     if (glBitmap.ID > 0) then begin
2180       Texture := glBitmap.ID;
2181       result := true;
2182     end;
2183   finally
2184     glBitmap.Free;
2185   end;
2186 end;
2187
2188 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2189 var
2190   CM: TglBitmapCubeMap;
2191 begin
2192   Texture := 0;
2193
2194   {$IFDEF GLB_DELPHI}
2195   if Instance = 0 then
2196     Instance := HInstance;
2197   {$ENDIF}
2198
2199   CM := TglBitmapCubeMap.Create;
2200   try
2201     CM.DeleteTextureOnFree := false;
2202
2203     // Maps
2204     {$IFDEF GLB_DELPHI}
2205     if (LoadFromRes) then
2206       CM.LoadFromResource(Instance, PositiveX)
2207     else
2208     {$ENDIF}
2209       CM.LoadFromFile(PositiveX);
2210     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2211
2212     {$IFDEF GLB_DELPHI}
2213     if (LoadFromRes) then
2214       CM.LoadFromResource(Instance, NegativeX)
2215     else
2216     {$ENDIF}
2217       CM.LoadFromFile(NegativeX);
2218     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2219
2220     {$IFDEF GLB_DELPHI}
2221     if (LoadFromRes) then
2222       CM.LoadFromResource(Instance, PositiveY)
2223     else
2224     {$ENDIF}
2225       CM.LoadFromFile(PositiveY);
2226     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2227
2228     {$IFDEF GLB_DELPHI}
2229     if (LoadFromRes) then
2230       CM.LoadFromResource(Instance, NegativeY)
2231     else
2232     {$ENDIF}
2233       CM.LoadFromFile(NegativeY);
2234     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2235
2236     {$IFDEF GLB_DELPHI}
2237     if (LoadFromRes) then
2238       CM.LoadFromResource(Instance, PositiveZ)
2239     else
2240     {$ENDIF}
2241       CM.LoadFromFile(PositiveZ);
2242     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2243
2244     {$IFDEF GLB_DELPHI}
2245     if (LoadFromRes) then
2246       CM.LoadFromResource(Instance, NegativeZ)
2247     else
2248     {$ENDIF}
2249       CM.LoadFromFile(NegativeZ);
2250     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2251
2252     Texture := CM.ID;
2253     result := true;
2254   finally
2255     CM.Free;
2256   end;
2257 end;
2258
2259 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2260 var
2261   NM: TglBitmapNormalMap;
2262 begin
2263   Texture := 0;
2264
2265   NM := TglBitmapNormalMap.Create;
2266   try
2267     NM.DeleteTextureOnFree := false;
2268     NM.GenerateNormalMap(Size);
2269
2270     Texture := NM.ID;
2271     result := true;
2272   finally
2273     NM.Free;
2274   end;
2275 end;
2276 *)
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2280 begin
2281   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2286 begin
2287   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2292 begin
2293   glBitmapDefaultMipmap := aValue;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2298 begin
2299   glBitmapDefaultFormat := aFormat;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2304 begin
2305   glBitmapDefaultFilterMin := aMin;
2306   glBitmapDefaultFilterMag := aMag;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2311 begin
2312   glBitmapDefaultWrapS := S;
2313   glBitmapDefaultWrapT := T;
2314   glBitmapDefaultWrapR := R;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2319 begin
2320   result := glBitmapDefaultDeleteTextureOnFree;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2325 begin
2326   result := glBitmapDefaultFreeDataAfterGenTextures;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2331 begin
2332   result := glBitmapDefaultMipmap;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function glBitmapGetDefaultFormat: TglBitmapFormat;
2337 begin
2338   result := glBitmapDefaultFormat;
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2343 begin
2344   aMin := glBitmapDefaultFilterMin;
2345   aMag := glBitmapDefaultFilterMag;
2346 end;
2347
2348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2349 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2350 begin
2351   S := glBitmapDefaultWrapS;
2352   T := glBitmapDefaultWrapT;
2353   R := glBitmapDefaultWrapR;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetRedMask: QWord;
2360 begin
2361   result := fRange.r shl fShift.r;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetGreenMask: QWord;
2366 begin
2367   result := fRange.g shl fShift.g;
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetBlueMask: QWord;
2372 begin
2373   result := fRange.b shl fShift.b;
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetAlphaMask: QWord;
2378 begin
2379   result := fRange.a shl fShift.a;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetComponents: Integer;
2384 var
2385   i: Integer;
2386 begin
2387   result := 0;
2388   for i := 0 to 3 do
2389     if (fRange.arr[i] > 0) then
2390       inc(result);
2391 end;
2392
2393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2394 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2395 var
2396   w, h: Integer;
2397 begin
2398   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2399     w := Max(1, aSize.X);
2400     h := Max(1, aSize.Y);
2401     result := GetSize(w, h);
2402   end else
2403     result := 0;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2408 begin
2409   result := 0;
2410   if (aWidth <= 0) or (aHeight <= 0) then
2411     exit;
2412   result := Ceil(aWidth * aHeight * fPixelSize);
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 function TFormatDescriptor.CreateMappingData: Pointer;
2417 begin
2418   result := nil;
2419 end;
2420
2421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2422 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2423 begin
2424   //DUMMY
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 function TFormatDescriptor.IsEmpty: Boolean;
2429 begin
2430   result := (fFormat = tfEmpty);
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 function TFormatDescriptor.HasAlpha: Boolean;
2435 begin
2436   result := (fRange.a > 0);
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2441 begin
2442   result := false;
2443
2444   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2445     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2446
2447   if (aRedMask   <> RedMask) then
2448     exit;
2449   if (aGreenMask <> GreenMask) then
2450     exit;
2451   if (aBlueMask  <> BlueMask) then
2452     exit;
2453   if (aAlphaMask <> AlphaMask) then
2454     exit;
2455   result := true;
2456 end;
2457
2458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2460 begin
2461   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2462   aPixel.Data   := fRange;
2463   aPixel.Range  := fRange;
2464   aPixel.Format := fFormat;
2465 end;
2466
2467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2468 constructor TFormatDescriptor.Create;
2469 begin
2470   inherited Create;
2471
2472   fFormat       := tfEmpty;
2473   fWithAlpha    := tfEmpty;
2474   fWithoutAlpha := tfEmpty;
2475   fRGBInverted  := tfEmpty;
2476   fUncompressed := tfEmpty;
2477   fPixelSize    := 0.0;
2478   fIsCompressed := false;
2479
2480   fglFormat         := 0;
2481   fglInternalFormat := 0;
2482   fglDataFormat     := 0;
2483
2484   FillChar(fRange, 0, SizeOf(fRange));
2485   FillChar(fShift, 0, SizeOf(fShift));
2486 end;
2487
2488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2492 begin
2493   aData^ := aPixel.Data.a;
2494   inc(aData);
2495 end;
2496
2497 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2498 begin
2499   aPixel.Data.r := 0;
2500   aPixel.Data.g := 0;
2501   aPixel.Data.b := 0;
2502   aPixel.Data.a := aData^;
2503   inc(aData^);
2504 end;
2505
2506 constructor TfdAlpha_UB1.Create;
2507 begin
2508   inherited Create;
2509   fPixelSize        := 1.0;
2510   fRange.a          := $FF;
2511   fglFormat         := GL_ALPHA;
2512   fglDataFormat     := GL_UNSIGNED_BYTE;
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2519 begin
2520   aData^ := LuminanceWeight(aPixel);
2521   inc(aData);
2522 end;
2523
2524 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2525 begin
2526   aPixel.Data.r := aData^;
2527   aPixel.Data.g := aData^;
2528   aPixel.Data.b := aData^;
2529   aPixel.Data.a := 0;
2530   inc(aData);
2531 end;
2532
2533 constructor TfdLuminance_UB1.Create;
2534 begin
2535   inherited Create;
2536   fPixelSize        := 1.0;
2537   fRange.r          := $FF;
2538   fRange.g          := $FF;
2539   fRange.b          := $FF;
2540   fglFormat         := GL_LUMINANCE;
2541   fglDataFormat     := GL_UNSIGNED_BYTE;
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2548 var
2549   i: Integer;
2550 begin
2551   aData^ := 0;
2552   for i := 0 to 3 do
2553     if (fRange.arr[i] > 0) then
2554       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2555   inc(aData);
2556 end;
2557
2558 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2559 var
2560   i: Integer;
2561 begin
2562   for i := 0 to 3 do
2563     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2564   inc(aData);
2565 end;
2566
2567 constructor TfdUniversal_UB1.Create;
2568 begin
2569   inherited Create;
2570   fPixelSize := 1.0;
2571 end;
2572
2573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2574 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2577 begin
2578   inherited Map(aPixel, aData, aMapData);
2579   aData^ := aPixel.Data.a;
2580   inc(aData);
2581 end;
2582
2583 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2584 begin
2585   inherited Unmap(aData, aPixel, aMapData);
2586   aPixel.Data.a := aData^;
2587   inc(aData);
2588 end;
2589
2590 constructor TfdLuminanceAlpha_UB2.Create;
2591 begin
2592   inherited Create;
2593   fPixelSize        := 2.0;
2594   fRange.a          := $FF;
2595   fShift.a          :=   8;
2596   fglFormat         := GL_LUMINANCE_ALPHA;
2597   fglDataFormat     := GL_UNSIGNED_BYTE;
2598 end;
2599
2600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2601 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2604 begin
2605   aData^ := aPixel.Data.r;
2606   inc(aData);
2607   aData^ := aPixel.Data.g;
2608   inc(aData);
2609   aData^ := aPixel.Data.b;
2610   inc(aData);
2611 end;
2612
2613 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2614 begin
2615   aPixel.Data.r := aData^;
2616   inc(aData);
2617   aPixel.Data.g := aData^;
2618   inc(aData);
2619   aPixel.Data.b := aData^;
2620   inc(aData);
2621   aPixel.Data.a := 0;
2622 end;
2623
2624 constructor TfdRGB_UB3.Create;
2625 begin
2626   inherited Create;
2627   fPixelSize        := 3.0;
2628   fRange.r          := $FF;
2629   fRange.g          := $FF;
2630   fRange.b          := $FF;
2631   fShift.r          :=   0;
2632   fShift.g          :=   8;
2633   fShift.b          :=  16;
2634   fglFormat         := GL_RGB;
2635   fglDataFormat     := GL_UNSIGNED_BYTE;
2636 end;
2637
2638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2642 begin
2643   aData^ := aPixel.Data.b;
2644   inc(aData);
2645   aData^ := aPixel.Data.g;
2646   inc(aData);
2647   aData^ := aPixel.Data.r;
2648   inc(aData);
2649 end;
2650
2651 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2652 begin
2653   aPixel.Data.b := aData^;
2654   inc(aData);
2655   aPixel.Data.g := aData^;
2656   inc(aData);
2657   aPixel.Data.r := aData^;
2658   inc(aData);
2659   aPixel.Data.a := 0;
2660 end;
2661
2662 constructor TfdBGR_UB3.Create;
2663 begin
2664   fPixelSize        := 3.0;
2665   fRange.r          := $FF;
2666   fRange.g          := $FF;
2667   fRange.b          := $FF;
2668   fShift.r          :=  16;
2669   fShift.g          :=   8;
2670   fShift.b          :=   0;
2671   fglFormat         := GL_BGR;
2672   fglDataFormat     := GL_UNSIGNED_BYTE;
2673 end;
2674
2675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2679 begin
2680   inherited Map(aPixel, aData, aMapData);
2681   aData^ := aPixel.Data.a;
2682   inc(aData);
2683 end;
2684
2685 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2686 begin
2687   inherited Unmap(aData, aPixel, aMapData);
2688   aPixel.Data.a := aData^;
2689   inc(aData);
2690 end;
2691
2692 constructor TfdRGBA_UB4.Create;
2693 begin
2694   inherited Create;
2695   fPixelSize        := 4.0;
2696   fRange.a          := $FF;
2697   fShift.a          :=  24;
2698   fglFormat         := GL_RGBA;
2699   fglDataFormat     := GL_UNSIGNED_BYTE;
2700 end;
2701
2702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2703 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2706 begin
2707   inherited Map(aPixel, aData, aMapData);
2708   aData^ := aPixel.Data.a;
2709   inc(aData);
2710 end;
2711
2712 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2713 begin
2714   inherited Unmap(aData, aPixel, aMapData);
2715   aPixel.Data.a := aData^;
2716   inc(aData);
2717 end;
2718
2719 constructor TfdBGRA_UB4.Create;
2720 begin
2721   inherited Create;
2722   fPixelSize        := 4.0;
2723   fRange.a          := $FF;
2724   fShift.a          :=  24;
2725   fglFormat         := GL_BGRA;
2726   fglDataFormat     := GL_UNSIGNED_BYTE;
2727 end;
2728
2729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2733 begin
2734   PWord(aData)^ := aPixel.Data.a;
2735   inc(aData, 2);
2736 end;
2737
2738 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2739 begin
2740   aPixel.Data.r := 0;
2741   aPixel.Data.g := 0;
2742   aPixel.Data.b := 0;
2743   aPixel.Data.a := PWord(aData)^;
2744   inc(aData, 2);
2745 end;
2746
2747 constructor TfdAlpha_US1.Create;
2748 begin
2749   inherited Create;
2750   fPixelSize        := 2.0;
2751   fRange.a          := $FFFF;
2752   fglFormat         := GL_ALPHA;
2753   fglDataFormat     := GL_UNSIGNED_SHORT;
2754 end;
2755
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2760 begin
2761   PWord(aData)^ := LuminanceWeight(aPixel);
2762   inc(aData, 2);
2763 end;
2764
2765 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2766 begin
2767   aPixel.Data.r := PWord(aData)^;
2768   aPixel.Data.g := PWord(aData)^;
2769   aPixel.Data.b := PWord(aData)^;
2770   aPixel.Data.a := 0;
2771   inc(aData, 2);
2772 end;
2773
2774 constructor TfdLuminance_US1.Create;
2775 begin
2776   inherited Create;
2777   fPixelSize        := 2.0;
2778   fRange.r          := $FFFF;
2779   fRange.g          := $FFFF;
2780   fRange.b          := $FFFF;
2781   fglFormat         := GL_LUMINANCE;
2782   fglDataFormat     := GL_UNSIGNED_SHORT;
2783 end;
2784
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2789 var
2790   i: Integer;
2791 begin
2792   PWord(aData)^ := 0;
2793   for i := 0 to 3 do
2794     if (fRange.arr[i] > 0) then
2795       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2796   inc(aData, 2);
2797 end;
2798
2799 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2800 var
2801   i: Integer;
2802 begin
2803   for i := 0 to 3 do
2804     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2805   inc(aData, 2);
2806 end;
2807
2808 constructor TfdUniversal_US1.Create;
2809 begin
2810   inherited Create;
2811   fPixelSize := 2.0;
2812 end;
2813
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2818 begin
2819   PWord(aData)^ := DepthWeight(aPixel);
2820   inc(aData, 2);
2821 end;
2822
2823 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2824 begin
2825   aPixel.Data.r := PWord(aData)^;
2826   aPixel.Data.g := PWord(aData)^;
2827   aPixel.Data.b := PWord(aData)^;
2828   aPixel.Data.a := 0;
2829   inc(aData, 2);
2830 end;
2831
2832 constructor TfdDepth_US1.Create;
2833 begin
2834   inherited Create;
2835   fPixelSize        := 2.0;
2836   fRange.r          := $FFFF;
2837   fRange.g          := $FFFF;
2838   fRange.b          := $FFFF;
2839   fglFormat         := GL_DEPTH_COMPONENT;
2840   fglDataFormat     := GL_UNSIGNED_SHORT;
2841 end;
2842
2843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2844 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2847 begin
2848   inherited Map(aPixel, aData, aMapData);
2849   PWord(aData)^ := aPixel.Data.a;
2850   inc(aData, 2);
2851 end;
2852
2853 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2854 begin
2855   inherited Unmap(aData, aPixel, aMapData);
2856   aPixel.Data.a := PWord(aData)^;
2857   inc(aData, 2);
2858 end;
2859
2860 constructor TfdLuminanceAlpha_US2.Create;
2861 begin
2862   inherited Create;
2863   fPixelSize        :=   4.0;
2864   fRange.a          := $FFFF;
2865   fShift.a          :=    16;
2866   fglFormat         := GL_LUMINANCE_ALPHA;
2867   fglDataFormat     := GL_UNSIGNED_SHORT;
2868 end;
2869
2870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2871 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2874 begin
2875   PWord(aData)^ := aPixel.Data.r;
2876   inc(aData, 2);
2877   PWord(aData)^ := aPixel.Data.g;
2878   inc(aData, 2);
2879   PWord(aData)^ := aPixel.Data.b;
2880   inc(aData, 2);
2881 end;
2882
2883 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2884 begin
2885   aPixel.Data.r := PWord(aData)^;
2886   inc(aData, 2);
2887   aPixel.Data.g := PWord(aData)^;
2888   inc(aData, 2);
2889   aPixel.Data.b := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.a := 0;
2892 end;
2893
2894 constructor TfdRGB_US3.Create;
2895 begin
2896   inherited Create;
2897   fPixelSize        :=   6.0;
2898   fRange.r          := $FFFF;
2899   fRange.g          := $FFFF;
2900   fRange.b          := $FFFF;
2901   fShift.r          :=     0;
2902   fShift.g          :=    16;
2903   fShift.b          :=    32;
2904   fglFormat         := GL_RGB;
2905   fglDataFormat     := GL_UNSIGNED_SHORT;
2906 end;
2907
2908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2909 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2912 begin
2913   PWord(aData)^ := aPixel.Data.b;
2914   inc(aData, 2);
2915   PWord(aData)^ := aPixel.Data.g;
2916   inc(aData, 2);
2917   PWord(aData)^ := aPixel.Data.r;
2918   inc(aData, 2);
2919 end;
2920
2921 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2922 begin
2923   aPixel.Data.b := PWord(aData)^;
2924   inc(aData, 2);
2925   aPixel.Data.g := PWord(aData)^;
2926   inc(aData, 2);
2927   aPixel.Data.r := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.a := 0;
2930 end;
2931
2932 constructor TfdBGR_US3.Create;
2933 begin
2934   inherited Create;
2935   fPixelSize        :=   6.0;
2936   fRange.r          := $FFFF;
2937   fRange.g          := $FFFF;
2938   fRange.b          := $FFFF;
2939   fShift.r          :=    32;
2940   fShift.g          :=    16;
2941   fShift.b          :=     0;
2942   fglFormat         := GL_BGR;
2943   fglDataFormat     := GL_UNSIGNED_SHORT;
2944 end;
2945
2946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2947 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2950 begin
2951   inherited Map(aPixel, aData, aMapData);
2952   PWord(aData)^ := aPixel.Data.a;
2953   inc(aData, 2);
2954 end;
2955
2956 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2957 begin
2958   inherited Unmap(aData, aPixel, aMapData);
2959   aPixel.Data.a := PWord(aData)^;
2960   inc(aData, 2);
2961 end;
2962
2963 constructor TfdRGBA_US4.Create;
2964 begin
2965   inherited Create;
2966   fPixelSize        :=   8.0;
2967   fRange.a          := $FFFF;
2968   fShift.a          :=    48;
2969   fglFormat         := GL_RGBA;
2970   fglDataFormat     := GL_UNSIGNED_SHORT;
2971 end;
2972
2973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2974 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2977 begin
2978   inherited Map(aPixel, aData, aMapData);
2979   PWord(aData)^ := aPixel.Data.a;
2980   inc(aData, 2);
2981 end;
2982
2983 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2984 begin
2985   inherited Unmap(aData, aPixel, aMapData);
2986   aPixel.Data.a := PWord(aData)^;
2987   inc(aData, 2);
2988 end;
2989
2990 constructor TfdBGRA_US4.Create;
2991 begin
2992   inherited Create;
2993   fPixelSize        :=   8.0;
2994   fRange.a          := $FFFF;
2995   fShift.a          :=    48;
2996   fglFormat         := GL_BGRA;
2997   fglDataFormat     := GL_UNSIGNED_SHORT;
2998 end;
2999
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3004 var
3005   i: Integer;
3006 begin
3007   PCardinal(aData)^ := 0;
3008   for i := 0 to 3 do
3009     if (fRange.arr[i] > 0) then
3010       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3011   inc(aData, 4);
3012 end;
3013
3014 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3015 var
3016   i: Integer;
3017 begin
3018   for i := 0 to 3 do
3019     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3020   inc(aData, 2);
3021 end;
3022
3023 constructor TfdUniversal_UI1.Create;
3024 begin
3025   inherited Create;
3026   fPixelSize := 4.0;
3027 end;
3028
3029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3030 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3033 begin
3034   PCardinal(aData)^ := DepthWeight(aPixel);
3035   inc(aData, 4);
3036 end;
3037
3038 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3039 begin
3040   aPixel.Data.r := PCardinal(aData)^;
3041   aPixel.Data.g := PCardinal(aData)^;
3042   aPixel.Data.b := PCardinal(aData)^;
3043   aPixel.Data.a := 0;
3044   inc(aData, 4);
3045 end;
3046
3047 constructor TfdDepth_UI1.Create;
3048 begin
3049   inherited Create;
3050   fPixelSize        := 4.0;
3051   fRange.r          := $FFFFFFFF;
3052   fRange.g          := $FFFFFFFF;
3053   fRange.b          := $FFFFFFFF;
3054   fglFormat         := GL_DEPTH_COMPONENT;
3055   fglDataFormat     := GL_UNSIGNED_INT;
3056 end;
3057
3058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3061 constructor TfdAlpha4.Create;
3062 begin
3063   inherited Create;
3064   fFormat           := tfAlpha4;
3065   fWithAlpha        := tfAlpha4;
3066   fglInternalFormat := GL_ALPHA4;
3067 end;
3068
3069 constructor TfdAlpha8.Create;
3070 begin
3071   inherited Create;
3072   fFormat           := tfAlpha8;
3073   fWithAlpha        := tfAlpha8;
3074   fglInternalFormat := GL_ALPHA8;
3075 end;
3076
3077 constructor TfdAlpha12.Create;
3078 begin
3079   inherited Create;
3080   fFormat           := tfAlpha12;
3081   fWithAlpha        := tfAlpha12;
3082   fglInternalFormat := GL_ALPHA12;
3083 end;
3084
3085 constructor TfdAlpha16.Create;
3086 begin
3087   inherited Create;
3088   fFormat           := tfAlpha16;
3089   fWithAlpha        := tfAlpha16;
3090   fglInternalFormat := GL_ALPHA16;
3091 end;
3092
3093 constructor TfdLuminance4.Create;
3094 begin
3095   inherited Create;
3096   fFormat           := tfLuminance4;
3097   fWithAlpha        := tfLuminance4Alpha4;
3098   fWithoutAlpha     := tfLuminance4;
3099   fglInternalFormat := GL_LUMINANCE4;
3100 end;
3101
3102 constructor TfdLuminance8.Create;
3103 begin
3104   inherited Create;
3105   fFormat           := tfLuminance8;
3106   fWithAlpha        := tfLuminance8Alpha8;
3107   fWithoutAlpha     := tfLuminance8;
3108   fglInternalFormat := GL_LUMINANCE8;
3109 end;
3110
3111 constructor TfdLuminance12.Create;
3112 begin
3113   inherited Create;
3114   fFormat           := tfLuminance12;
3115   fWithAlpha        := tfLuminance12Alpha12;
3116   fWithoutAlpha     := tfLuminance12;
3117   fglInternalFormat := GL_LUMINANCE12;
3118 end;
3119
3120 constructor TfdLuminance16.Create;
3121 begin
3122   inherited Create;
3123   fFormat           := tfLuminance16;
3124   fWithAlpha        := tfLuminance16Alpha16;
3125   fWithoutAlpha     := tfLuminance16;
3126   fglInternalFormat := GL_LUMINANCE16;
3127 end;
3128
3129 constructor TfdLuminance4Alpha4.Create;
3130 begin
3131   inherited Create;
3132   fFormat           := tfLuminance4Alpha4;
3133   fWithAlpha        := tfLuminance4Alpha4;
3134   fWithoutAlpha     := tfLuminance4;
3135   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3136 end;
3137
3138 constructor TfdLuminance6Alpha2.Create;
3139 begin
3140   inherited Create;
3141   fFormat           := tfLuminance6Alpha2;
3142   fWithAlpha        := tfLuminance6Alpha2;
3143   fWithoutAlpha     := tfLuminance8;
3144   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3145 end;
3146
3147 constructor TfdLuminance8Alpha8.Create;
3148 begin
3149   inherited Create;
3150   fFormat           := tfLuminance8Alpha8;
3151   fWithAlpha        := tfLuminance8Alpha8;
3152   fWithoutAlpha     := tfLuminance8;
3153   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3154 end;
3155
3156 constructor TfdLuminance12Alpha4.Create;
3157 begin
3158   inherited Create;
3159   fFormat           := tfLuminance12Alpha4;
3160   fWithAlpha        := tfLuminance12Alpha4;
3161   fWithoutAlpha     := tfLuminance12;
3162   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3163 end;
3164
3165 constructor TfdLuminance12Alpha12.Create;
3166 begin
3167   inherited Create;
3168   fFormat           := tfLuminance12Alpha12;
3169   fWithAlpha        := tfLuminance12Alpha12;
3170   fWithoutAlpha     := tfLuminance12;
3171   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3172 end;
3173
3174 constructor TfdLuminance16Alpha16.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfLuminance16Alpha16;
3178   fWithAlpha        := tfLuminance16Alpha16;
3179   fWithoutAlpha     := tfLuminance16;
3180   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3181 end;
3182
3183 constructor TfdR3G3B2.Create;
3184 begin
3185   inherited Create;
3186   fFormat           := tfR3G3B2;
3187   fWithAlpha        := tfRGBA2;
3188   fWithoutAlpha     := tfR3G3B2;
3189   fRange.r          := $7;
3190   fRange.g          := $7;
3191   fRange.b          := $3;
3192   fShift.r          :=  0;
3193   fShift.g          :=  3;
3194   fShift.b          :=  6;
3195   fglFormat         := GL_RGB;
3196   fglInternalFormat := GL_R3_G3_B2;
3197   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3198 end;
3199
3200 constructor TfdRGB4.Create;
3201 begin
3202   inherited Create;
3203   fFormat           := tfRGB4;
3204   fWithAlpha        := tfRGBA4;
3205   fWithoutAlpha     := tfRGB4;
3206   fRGBInverted      := tfBGR4;
3207   fRange.r          := $F;
3208   fRange.g          := $F;
3209   fRange.b          := $F;
3210   fShift.r          :=  0;
3211   fShift.g          :=  4;
3212   fShift.b          :=  8;
3213   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3214   fglInternalFormat := GL_RGB4;
3215   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3216 end;
3217
3218 constructor TfdR5G6B5.Create;
3219 begin
3220   inherited Create;
3221   fFormat           := tfR5G6B5;
3222   fWithAlpha        := tfRGBA4;
3223   fWithoutAlpha     := tfR5G6B5;
3224   fRGBInverted      := tfB5G6R5;
3225   fRange.r          := $1F;
3226   fRange.g          := $3F;
3227   fRange.b          := $1F;
3228   fShift.r          :=   0;
3229   fShift.g          :=   5;
3230   fShift.b          :=  11;
3231   fglFormat         := GL_RGB;
3232   fglInternalFormat := GL_RGB565;
3233   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3234 end;
3235
3236 constructor TfdRGB5.Create;
3237 begin
3238   inherited Create;
3239   fFormat           := tfRGB5;
3240   fWithAlpha        := tfRGB5A1;
3241   fWithoutAlpha     := tfRGB5;
3242   fRGBInverted      := tfBGR5;
3243   fRange.r          := $1F;
3244   fRange.g          := $1F;
3245   fRange.b          := $1F;
3246   fShift.r          :=   0;
3247   fShift.g          :=   5;
3248   fShift.b          :=  10;
3249   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3250   fglInternalFormat := GL_RGB5;
3251   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3252 end;
3253
3254 constructor TfdRGB8.Create;
3255 begin
3256   inherited Create;
3257   fFormat           := tfRGB8;
3258   fWithAlpha        := tfRGBA8;
3259   fWithoutAlpha     := tfRGB8;
3260   fRGBInverted      := tfBGR8;
3261   fglInternalFormat := GL_RGB8;
3262 end;
3263
3264 constructor TfdRGB10.Create;
3265 begin
3266   inherited Create;
3267   fFormat           := tfRGB10;
3268   fWithAlpha        := tfRGB10A2;
3269   fWithoutAlpha     := tfRGB10;
3270   fRGBInverted      := tfBGR10;
3271   fRange.r          := $3FF;
3272   fRange.g          := $3FF;
3273   fRange.b          := $3FF;
3274   fShift.r          :=    0;
3275   fShift.g          :=   10;
3276   fShift.b          :=   20;
3277   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3278   fglInternalFormat := GL_RGB10;
3279   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3280 end;
3281
3282 constructor TfdRGB12.Create;
3283 begin
3284   inherited Create;
3285   fFormat           := tfRGB12;
3286   fWithAlpha        := tfRGBA12;
3287   fWithoutAlpha     := tfRGB12;
3288   fRGBInverted      := tfBGR12;
3289   fglInternalFormat := GL_RGB12;
3290 end;
3291
3292 constructor TfdRGB16.Create;
3293 begin
3294   inherited Create;
3295   fFormat           := tfRGB16;
3296   fWithAlpha        := tfRGBA16;
3297   fWithoutAlpha     := tfRGB16;
3298   fRGBInverted      := tfBGR16;
3299   fglInternalFormat := GL_RGB16;
3300 end;
3301
3302 constructor TfdRGBA2.Create;
3303 begin
3304   inherited Create;
3305   fFormat           := tfRGBA2;
3306   fWithAlpha        := tfRGBA2;
3307   fWithoutAlpha     := tfR3G3B2;
3308   fRGBInverted      := tfBGRA2;
3309   fglInternalFormat := GL_RGBA2;
3310 end;
3311
3312 constructor TfdRGBA4.Create;
3313 begin
3314   inherited Create;
3315   fFormat           := tfRGBA4;
3316   fWithAlpha        := tfRGBA4;
3317   fWithoutAlpha     := tfRGB4;
3318   fRGBInverted      := tfBGRA4;
3319   fRange.r          := $F;
3320   fRange.g          := $F;
3321   fRange.b          := $F;
3322   fRange.a          := $F;
3323   fShift.r          :=  0;
3324   fShift.g          :=  4;
3325   fShift.b          :=  8;
3326   fShift.a          := 12;
3327   fglFormat         := GL_RGBA;
3328   fglInternalFormat := GL_RGBA4;
3329   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3330 end;
3331
3332 constructor TfdRGB5A1.Create;
3333 begin
3334   inherited Create;
3335   fFormat           := tfRGB5A1;
3336   fWithAlpha        := tfRGB5A1;
3337   fWithoutAlpha     := tfRGB5;
3338   fRGBInverted      := tfBGR5A1;
3339   fRange.r          := $1F;
3340   fRange.g          := $1F;
3341   fRange.b          := $1F;
3342   fRange.a          := $01;
3343   fShift.r          :=   0;
3344   fShift.g          :=   5;
3345   fShift.b          :=  10;
3346   fShift.a          :=  15;
3347   fglFormat         := GL_RGBA;
3348   fglInternalFormat := GL_RGB5_A1;
3349   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3350 end;
3351
3352 constructor TfdRGBA8.Create;
3353 begin
3354   inherited Create;
3355   fFormat           := tfRGBA8;
3356   fWithAlpha        := tfRGBA8;
3357   fWithoutAlpha     := tfRGB8;
3358   fRGBInverted      := tfBGRA8;
3359   fglInternalFormat := GL_RGBA8;
3360 end;
3361
3362 constructor TfdRGB10A2.Create;
3363 begin
3364   inherited Create;
3365   fFormat           := tfRGB10A2;
3366   fWithAlpha        := tfRGB10A2;
3367   fWithoutAlpha     := tfRGB10;
3368   fRGBInverted      := tfBGR10A2;
3369   fRange.r          := $3FF;
3370   fRange.g          := $3FF;
3371   fRange.b          := $3FF;
3372   fRange.a          := $003;
3373   fShift.r          :=    0;
3374   fShift.g          :=   10;
3375   fShift.b          :=   20;
3376   fShift.a          :=   30;
3377   fglFormat         := GL_RGBA;
3378   fglInternalFormat := GL_RGB10_A2;
3379   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3380 end;
3381
3382 constructor TfdRGBA12.Create;
3383 begin
3384   inherited Create;
3385   fFormat           := tfRGBA12;
3386   fWithAlpha        := tfRGBA12;
3387   fWithoutAlpha     := tfRGB12;
3388   fRGBInverted      := tfBGRA12;
3389   fglInternalFormat := GL_RGBA12;
3390 end;
3391
3392 constructor TfdRGBA16.Create;
3393 begin
3394   inherited Create;
3395   fFormat           := tfRGBA16;
3396   fWithAlpha        := tfRGBA16;
3397   fWithoutAlpha     := tfRGB16;
3398   fRGBInverted      := tfBGRA16;
3399   fglInternalFormat := GL_RGBA16;
3400 end;
3401
3402 constructor TfdBGR4.Create;
3403 begin
3404   inherited Create;
3405   fPixelSize        := 2.0;
3406   fFormat           := tfBGR4;
3407   fWithAlpha        := tfBGRA4;
3408   fWithoutAlpha     := tfBGR4;
3409   fRGBInverted      := tfRGB4;
3410   fRange.r          := $F;
3411   fRange.g          := $F;
3412   fRange.b          := $F;
3413   fRange.a          := $0;
3414   fShift.r          :=  8;
3415   fShift.g          :=  4;
3416   fShift.b          :=  0;
3417   fShift.a          :=  0;
3418   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3419   fglInternalFormat := GL_RGB4;
3420   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3421 end;
3422
3423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3426 constructor TfdB5G6R5.Create;
3427 begin
3428   inherited Create;
3429   fFormat           := tfB5G6R5;
3430   fWithAlpha        := tfBGRA4;
3431   fWithoutAlpha     := tfB5G6R5;
3432   fRGBInverted      := tfR5G6B5;
3433   fRange.r          := $1F;
3434   fRange.g          := $3F;
3435   fRange.b          := $1F;
3436   fShift.r          :=  11;
3437   fShift.g          :=   5;
3438   fShift.b          :=   0;
3439   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3440   fglInternalFormat := GL_RGB8;
3441   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3442 end;
3443
3444 constructor TfdBGR5.Create;
3445 begin
3446   inherited Create;
3447   fPixelSize        := 2.0;
3448   fFormat           := tfBGR5;
3449   fWithAlpha        := tfBGR5A1;
3450   fWithoutAlpha     := tfBGR5;
3451   fRGBInverted      := tfRGB5;
3452   fRange.r          := $1F;
3453   fRange.g          := $1F;
3454   fRange.b          := $1F;
3455   fRange.a          := $00;
3456   fShift.r          :=  10;
3457   fShift.g          :=   5;
3458   fShift.b          :=   0;
3459   fShift.a          :=   0;
3460   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3461   fglInternalFormat := GL_RGB5;
3462   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3463 end;
3464
3465 constructor TfdBGR8.Create;
3466 begin
3467   inherited Create;
3468   fFormat           := tfBGR8;
3469   fWithAlpha        := tfBGRA8;
3470   fWithoutAlpha     := tfBGR8;
3471   fRGBInverted      := tfRGB8;
3472   fglInternalFormat := GL_RGB8;
3473 end;
3474
3475 constructor TfdBGR10.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGR10;
3479   fWithAlpha        := tfBGR10A2;
3480   fWithoutAlpha     := tfBGR10;
3481   fRGBInverted      := tfRGB10;
3482   fRange.r          := $3FF;
3483   fRange.g          := $3FF;
3484   fRange.b          := $3FF;
3485   fRange.a          := $000;
3486   fShift.r          :=   20;
3487   fShift.g          :=   10;
3488   fShift.b          :=    0;
3489   fShift.a          :=    0;
3490   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3491   fglInternalFormat := GL_RGB10;
3492   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3493 end;
3494
3495 constructor TfdBGR12.Create;
3496 begin
3497   inherited Create;
3498   fFormat           := tfBGR12;
3499   fWithAlpha        := tfBGRA12;
3500   fWithoutAlpha     := tfBGR12;
3501   fRGBInverted      := tfRGB12;
3502   fglInternalFormat := GL_RGB12;
3503 end;
3504
3505 constructor TfdBGR16.Create;
3506 begin
3507   inherited Create;
3508   fFormat           := tfBGR16;
3509   fWithAlpha        := tfBGRA16;
3510   fWithoutAlpha     := tfBGR16;
3511   fRGBInverted      := tfRGB16;
3512   fglInternalFormat := GL_RGB16;
3513 end;
3514
3515 constructor TfdBGRA2.Create;
3516 begin
3517   inherited Create;
3518   fFormat           := tfBGRA2;
3519   fWithAlpha        := tfBGRA4;
3520   fWithoutAlpha     := tfBGR4;
3521   fRGBInverted      := tfRGBA2;
3522   fglInternalFormat := GL_RGBA2;
3523 end;
3524
3525 constructor TfdBGRA4.Create;
3526 begin
3527   inherited Create;
3528   fFormat           := tfBGRA4;
3529   fWithAlpha        := tfBGRA4;
3530   fWithoutAlpha     := tfBGR4;
3531   fRGBInverted      := tfRGBA4;
3532   fRange.r          := $F;
3533   fRange.g          := $F;
3534   fRange.b          := $F;
3535   fRange.a          := $F;
3536   fShift.r          :=  8;
3537   fShift.g          :=  4;
3538   fShift.b          :=  0;
3539   fShift.a          := 12;
3540   fglFormat         := GL_BGRA;
3541   fglInternalFormat := GL_RGBA4;
3542   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3543 end;
3544
3545 constructor TfdBGR5A1.Create;
3546 begin
3547   inherited Create;
3548   fFormat           := tfBGR5A1;
3549   fWithAlpha        := tfBGR5A1;
3550   fWithoutAlpha     := tfBGR5;
3551   fRGBInverted      := tfRGB5A1;
3552   fRange.r          := $1F;
3553   fRange.g          := $1F;
3554   fRange.b          := $1F;
3555   fRange.a          := $01;
3556   fShift.r          :=  10;
3557   fShift.g          :=   5;
3558   fShift.b          :=   0;
3559   fShift.a          :=  15;
3560   fglFormat         := GL_BGRA;
3561   fglInternalFormat := GL_RGB5_A1;
3562   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3563 end;
3564
3565 constructor TfdBGRA8.Create;
3566 begin
3567   inherited Create;
3568   fFormat           := tfBGRA8;
3569   fWithAlpha        := tfBGRA8;
3570   fWithoutAlpha     := tfBGR8;
3571   fRGBInverted      := tfRGBA8;
3572   fglInternalFormat := GL_RGBA8;
3573 end;
3574
3575 constructor TfdBGR10A2.Create;
3576 begin
3577   inherited Create;
3578   fFormat           := tfBGR10A2;
3579   fWithAlpha        := tfBGR10A2;
3580   fWithoutAlpha     := tfBGR10;
3581   fRGBInverted      := tfRGB10A2;
3582   fRange.r          := $3FF;
3583   fRange.g          := $3FF;
3584   fRange.b          := $3FF;
3585   fRange.a          := $003;
3586   fShift.r          :=   20;
3587   fShift.g          :=   10;
3588   fShift.b          :=    0;
3589   fShift.a          :=   30;
3590   fglFormat         := GL_BGRA;
3591   fglInternalFormat := GL_RGB10_A2;
3592   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3593 end;
3594
3595 constructor TfdBGRA12.Create;
3596 begin
3597   inherited Create;
3598   fFormat           := tfBGRA12;
3599   fWithAlpha        := tfBGRA12;
3600   fWithoutAlpha     := tfBGR12;
3601   fRGBInverted      := tfRGBA12;
3602   fglInternalFormat := GL_RGBA12;
3603 end;
3604
3605 constructor TfdBGRA16.Create;
3606 begin
3607   inherited Create;
3608   fFormat           := tfBGRA16;
3609   fWithAlpha        := tfBGRA16;
3610   fWithoutAlpha     := tfBGR16;
3611   fRGBInverted      := tfRGBA16;
3612   fglInternalFormat := GL_RGBA16;
3613 end;
3614
3615 constructor TfdDepth16.Create;
3616 begin
3617   inherited Create;
3618   fFormat           := tfDepth16;
3619   fWithAlpha        := tfEmpty;
3620   fWithoutAlpha     := tfDepth16;
3621   fglInternalFormat := GL_DEPTH_COMPONENT16;
3622 end;
3623
3624 constructor TfdDepth24.Create;
3625 begin
3626   inherited Create;
3627   fFormat           := tfDepth24;
3628   fWithAlpha        := tfEmpty;
3629   fWithoutAlpha     := tfDepth24;
3630   fglInternalFormat := GL_DEPTH_COMPONENT24;
3631 end;
3632
3633 constructor TfdDepth32.Create;
3634 begin
3635   inherited Create;
3636   fFormat           := tfDepth32;
3637   fWithAlpha        := tfEmpty;
3638   fWithoutAlpha     := tfDepth32;
3639   fglInternalFormat := GL_DEPTH_COMPONENT32;
3640 end;
3641
3642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3643 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3646 begin
3647   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3648 end;
3649
3650 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3651 begin
3652   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3653 end;
3654
3655 constructor TfdS3tcDtx1RGBA.Create;
3656 begin
3657   inherited Create;
3658   fFormat           := tfS3tcDtx1RGBA;
3659   fWithAlpha        := tfS3tcDtx1RGBA;
3660   fUncompressed     := tfRGB5A1;
3661   fPixelSize        := 0.5;
3662   fIsCompressed     := true;
3663   fglFormat         := GL_COMPRESSED_RGBA;
3664   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3665   fglDataFormat     := GL_UNSIGNED_BYTE;
3666 end;
3667
3668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3669 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3672 begin
3673   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3674 end;
3675
3676 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3677 begin
3678   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3679 end;
3680
3681 constructor TfdS3tcDtx3RGBA.Create;
3682 begin
3683   inherited Create;
3684   fFormat           := tfS3tcDtx3RGBA;
3685   fWithAlpha        := tfS3tcDtx3RGBA;
3686   fUncompressed     := tfRGBA8;
3687   fPixelSize        := 1.0;
3688   fIsCompressed     := true;
3689   fglFormat         := GL_COMPRESSED_RGBA;
3690   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3691   fglDataFormat     := GL_UNSIGNED_BYTE;
3692 end;
3693
3694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3695 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3698 begin
3699   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3700 end;
3701
3702 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3703 begin
3704   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3705 end;
3706
3707 constructor TfdS3tcDtx5RGBA.Create;
3708 begin
3709   inherited Create;
3710   fFormat           := tfS3tcDtx3RGBA;
3711   fWithAlpha        := tfS3tcDtx3RGBA;
3712   fUncompressed     := tfRGBA8;
3713   fPixelSize        := 1.0;
3714   fIsCompressed     := true;
3715   fglFormat         := GL_COMPRESSED_RGBA;
3716   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3717   fglDataFormat     := GL_UNSIGNED_BYTE;
3718 end;
3719
3720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3721 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 class procedure TFormatDescriptor.Init;
3724 begin
3725   if not Assigned(FormatDescriptorCS) then
3726     FormatDescriptorCS := TCriticalSection.Create;
3727 end;
3728
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3731 begin
3732   FormatDescriptorCS.Enter;
3733   try
3734     result := FormatDescriptors[aFormat];
3735     if not Assigned(result) then begin
3736       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3737       FormatDescriptors[aFormat] := result;
3738     end;
3739   finally
3740     FormatDescriptorCS.Leave;
3741   end;
3742 end;
3743
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3746 begin
3747   result := Get(Get(aFormat).WithAlpha);
3748 end;
3749
3750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3751 class procedure TFormatDescriptor.Clear;
3752 var
3753   f: TglBitmapFormat;
3754 begin
3755   FormatDescriptorCS.Enter;
3756   try
3757     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3758       FreeAndNil(FormatDescriptors[f]);
3759   finally
3760     FormatDescriptorCS.Leave;
3761   end;
3762 end;
3763
3764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3765 class procedure TFormatDescriptor.Finalize;
3766 begin
3767   Clear;
3768   FreeAndNil(FormatDescriptorCS);
3769 end;
3770
3771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3772 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3775 begin
3776   Update(aValue, fRange.r, fShift.r);
3777 end;
3778
3779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3780 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3781 begin
3782   Update(aValue, fRange.g, fShift.g);
3783 end;
3784
3785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3786 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3787 begin
3788   Update(aValue, fRange.b, fShift.b);
3789 end;
3790
3791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3793 begin
3794   Update(aValue, fRange.a, fShift.a);
3795 end;
3796
3797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3798 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3799   aShift: Byte);
3800 begin
3801   aShift := 0;
3802   aRange := 0;
3803   if (aMask = 0) then
3804     exit;
3805   while (aMask > 0) and ((aMask and 1) = 0) do begin
3806     inc(aShift);
3807     aMask := aMask shr 1;
3808   end;
3809   aRange := 1;
3810   while (aMask > 0) do begin
3811     aRange := aRange shl 1;
3812     aMask  := aMask  shr 1;
3813   end;
3814   dec(aRange);
3815
3816   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3817 end;
3818
3819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3820 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3821 var
3822   data: QWord;
3823   s: Integer;
3824 begin
3825   data :=
3826     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3827     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3828     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3829     ((aPixel.Data.a and fRange.a) shl fShift.a);
3830   s := Round(fPixelSize);
3831   case s of
3832     1:           aData^  := data;
3833     2:     PWord(aData)^ := data;
3834     4: PCardinal(aData)^ := data;
3835     8:    PQWord(aData)^ := data;
3836   else
3837     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3838   end;
3839   inc(aData, s);
3840 end;
3841
3842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3843 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3844 var
3845   data: QWord;
3846   s, i: Integer;
3847 begin
3848   s := Round(fPixelSize);
3849   case s of
3850     1: data :=           aData^;
3851     2: data :=     PWord(aData)^;
3852     4: data := PCardinal(aData)^;
3853     8: data :=    PQWord(aData)^;
3854   else
3855     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3856   end;
3857   for i := 0 to 3 do
3858     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3859   inc(aData, s);
3860 end;
3861
3862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3863 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 procedure TbmpColorTableFormat.CreateColorTable;
3866 var
3867   i: Integer;
3868 begin
3869   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3870     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3871
3872   if (Format = tfLuminance4) then
3873     SetLength(fColorTable, 16)
3874   else
3875     SetLength(fColorTable, 256);
3876
3877   case Format of
3878     tfLuminance4: begin
3879       for i := 0 to High(fColorTable) do begin
3880         fColorTable[i].r := 16 * i;
3881         fColorTable[i].g := 16 * i;
3882         fColorTable[i].b := 16 * i;
3883         fColorTable[i].a := 0;
3884       end;
3885     end;
3886
3887     tfLuminance8: begin
3888       for i := 0 to High(fColorTable) do begin
3889         fColorTable[i].r := i;
3890         fColorTable[i].g := i;
3891         fColorTable[i].b := i;
3892         fColorTable[i].a := 0;
3893       end;
3894     end;
3895
3896     tfR3G3B2: begin
3897       for i := 0 to High(fColorTable) do begin
3898         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3899         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3900         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3901         fColorTable[i].a := 0;
3902       end;
3903     end;
3904   end;
3905 end;
3906
3907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3908 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3909 var
3910   d: Byte;
3911 begin
3912   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3913     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3914
3915   case Format of
3916     tfLuminance4: begin
3917       if (aMapData = nil) then
3918         aData^ := 0;
3919       d := LuminanceWeight(aPixel) and Range.r;
3920       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3921       inc(aMapData, 4);
3922       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3923         inc(aData);
3924         aMapData := nil;
3925       end;
3926     end;
3927
3928     tfLuminance8: begin
3929       aData^ := LuminanceWeight(aPixel) and Range.r;
3930       inc(aData);
3931     end;
3932
3933     tfR3G3B2: begin
3934       aData^ := Round(
3935         ((aPixel.Data.r and Range.r) shl Shift.r) or
3936         ((aPixel.Data.g and Range.g) shl Shift.g) or
3937         ((aPixel.Data.b and Range.b) shl Shift.b));
3938       inc(aData);
3939     end;
3940   end;
3941 end;
3942
3943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3944 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3945 var
3946   idx: QWord;
3947   s: Integer;
3948   bits: Byte;
3949   f: Single;
3950 begin
3951   s    := Trunc(fPixelSize);
3952   f    := fPixelSize - s;
3953   bits := Round(8 * f);
3954   case s of
3955     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
3956     1: idx :=           aData^;
3957     2: idx :=     PWord(aData)^;
3958     4: idx := PCardinal(aData)^;
3959     8: idx :=    PQWord(aData)^;
3960   else
3961     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3962   end;
3963   if (idx >= Length(fColorTable)) then
3964     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3965   with fColorTable[idx] do begin
3966     aPixel.Data.r := r;
3967     aPixel.Data.g := g;
3968     aPixel.Data.b := b;
3969     aPixel.Data.a := a;
3970   end;
3971   inc(aMapData, bits);
3972   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3973     inc(aData, 1);
3974     dec(aMapData, 8);
3975   end;
3976   inc(aData, s);
3977 end;
3978
3979 destructor TbmpColorTableFormat.Destroy;
3980 begin
3981   SetLength(fColorTable, 0);
3982   inherited Destroy;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3988 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3989 var
3990   i: Integer;
3991 begin
3992   for i := 0 to 3 do begin
3993     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3994       if (aSourceFD.Range.arr[i] > 0) then
3995         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3996       else
3997         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3998     end;
3999   end;
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4004 begin
4005   with aFuncRec do begin
4006     if (Source.Range.r   > 0) then
4007       Dest.Data.r := Source.Data.r;
4008     if (Source.Range.g > 0) then
4009       Dest.Data.g := Source.Data.g;
4010     if (Source.Range.b  > 0) then
4011       Dest.Data.b := Source.Data.b;
4012     if (Source.Range.a > 0) then
4013       Dest.Data.a := Source.Data.a;
4014   end;
4015 end;
4016
4017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4018 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4019 var
4020   i: Integer;
4021 begin
4022   with aFuncRec do begin
4023     for i := 0 to 3 do
4024       if (Source.Range.arr[i] > 0) then
4025         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4026   end;
4027 end;
4028
4029 type
4030   TShiftData = packed record
4031     case Integer of
4032       0: (r, g, b, a: SmallInt);
4033       1: (arr: array[0..3] of SmallInt);
4034   end;
4035   PShiftData = ^TShiftData;
4036
4037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4038 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4039 var
4040   i: Integer;
4041 begin
4042   with aFuncRec do
4043     for i := 0 to 3 do
4044       if (Source.Range.arr[i] > 0) then
4045         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4046 end;
4047
4048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4049 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4050 begin
4051   with aFuncRec do begin
4052     Dest.Data := Source.Data;
4053     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4054       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4055       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4056       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4057     end;
4058     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4059       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4060     end;
4061   end;
4062 end;
4063
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4066 var
4067   i: Integer;
4068 begin
4069   with aFuncRec do begin
4070     for i := 0 to 3 do
4071       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4072   end;
4073 end;
4074
4075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4076 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4077 var
4078   Temp: Single;
4079 begin
4080   with FuncRec do begin
4081     if (FuncRec.Args = nil) then begin //source has no alpha
4082       Temp :=
4083         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4084         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4085         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4086       Dest.Data.a := Round(Dest.Range.a * Temp);
4087     end else
4088       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4089   end;
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4094 type
4095   PglBitmapPixelData = ^TglBitmapPixelData;
4096 begin
4097   with FuncRec do begin
4098     Dest.Data.r := Source.Data.r;
4099     Dest.Data.g := Source.Data.g;
4100     Dest.Data.b := Source.Data.b;
4101
4102     with PglBitmapPixelData(Args)^ do
4103       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4104           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4105           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4106         Dest.Data.a := 0
4107       else
4108         Dest.Data.a := Dest.Range.a;
4109   end;
4110 end;
4111
4112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4114 begin
4115   with FuncRec do begin
4116     Dest.Data.r := Source.Data.r;
4117     Dest.Data.g := Source.Data.g;
4118     Dest.Data.b := Source.Data.b;
4119     Dest.Data.a := PCardinal(Args)^;
4120   end;
4121 end;
4122
4123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4124 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4125 type
4126   PRGBPix = ^TRGBPix;
4127   TRGBPix = array [0..2] of byte;
4128 var
4129   Temp: Byte;
4130 begin
4131   while aWidth > 0 do begin
4132     Temp := PRGBPix(aData)^[0];
4133     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4134     PRGBPix(aData)^[2] := Temp;
4135
4136     if aHasAlpha then
4137       Inc(aData, 4)
4138     else
4139       Inc(aData, 3);
4140     dec(aWidth);
4141   end;
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 function TglBitmap.GetWidth: Integer;
4148 begin
4149   if (ffX in fDimension.Fields) then
4150     result := fDimension.X
4151   else
4152     result := -1;
4153 end;
4154
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 function TglBitmap.GetHeight: Integer;
4157 begin
4158   if (ffY in fDimension.Fields) then
4159     result := fDimension.Y
4160   else
4161     result := -1;
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 function TglBitmap.GetFileWidth: Integer;
4166 begin
4167   result := Max(1, Width);
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 function TglBitmap.GetFileHeight: Integer;
4172 begin
4173   result := Max(1, Height);
4174 end;
4175
4176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4177 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4178 begin
4179   if fCustomData = aValue then
4180     exit;
4181   fCustomData := aValue;
4182 end;
4183
4184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4185 procedure TglBitmap.SetCustomName(const aValue: String);
4186 begin
4187   if fCustomName = aValue then
4188     exit;
4189   fCustomName := aValue;
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4194 begin
4195   if fCustomNameW = aValue then
4196     exit;
4197   fCustomNameW := aValue;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4202 begin
4203   if fDeleteTextureOnFree = aValue then
4204     exit;
4205   fDeleteTextureOnFree := aValue;
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4210 begin
4211   if fFormat = aValue then
4212     exit;
4213   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4214     raise EglBitmapUnsupportedFormat.Create(Format);
4215   SetDataPointer(Data, aValue, Width, Height);
4216 end;
4217
4218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4219 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4220 begin
4221   if fFreeDataAfterGenTexture = aValue then
4222     exit;
4223   fFreeDataAfterGenTexture := aValue;
4224 end;
4225
4226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4227 procedure TglBitmap.SetID(const aValue: Cardinal);
4228 begin
4229   if fID = aValue then
4230     exit;
4231   fID := aValue;
4232 end;
4233
4234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4235 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4236 begin
4237   if fMipMap = aValue then
4238     exit;
4239   fMipMap := aValue;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4244 begin
4245   if fTarget = aValue then
4246     exit;
4247   fTarget := aValue;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4252 var
4253   MaxAnisotropic: Integer;
4254 begin
4255   fAnisotropic := aValue;
4256   if (ID > 0) then begin
4257     if GL_EXT_texture_filter_anisotropic then begin
4258       if fAnisotropic > 0 then begin
4259         Bind(false);
4260         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4261         if aValue > MaxAnisotropic then
4262           fAnisotropic := MaxAnisotropic;
4263         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4264       end;
4265     end else begin
4266       fAnisotropic := 0;
4267     end;
4268   end;
4269 end;
4270
4271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4272 procedure TglBitmap.CreateID;
4273 begin
4274   if (ID <> 0) then
4275     glDeleteTextures(1, @fID);
4276   glGenTextures(1, @fID);
4277   Bind(false);
4278 end;
4279
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4282 begin
4283   // Set Up Parameters
4284   SetWrap(fWrapS, fWrapT, fWrapR);
4285   SetFilter(fFilterMin, fFilterMag);
4286   SetAnisotropic(fAnisotropic);
4287   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4288
4289   // Mip Maps Generation Mode
4290   aBuildWithGlu := false;
4291   if (MipMap = mmMipmap) then begin
4292     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4293       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4294     else
4295       aBuildWithGlu := true;
4296   end else if (MipMap = mmMipmapGlu) then
4297     aBuildWithGlu := true;
4298 end;
4299
4300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4301 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4302   const aWidth: Integer; const aHeight: Integer);
4303 var
4304   s: Single;
4305 begin
4306   if (Data <> aData) then begin
4307     if (Assigned(Data)) then
4308       FreeMem(Data);
4309     fData := aData;
4310   end;
4311
4312   FillChar(fDimension, SizeOf(fDimension), 0);
4313   if not Assigned(fData) then begin
4314     fFormat    := tfEmpty;
4315     fPixelSize := 0;
4316     fRowSize   := 0;
4317   end else begin
4318     if aWidth <> -1 then begin
4319       fDimension.Fields := fDimension.Fields + [ffX];
4320       fDimension.X := aWidth;
4321     end;
4322
4323     if aHeight <> -1 then begin
4324       fDimension.Fields := fDimension.Fields + [ffY];
4325       fDimension.Y := aHeight;
4326     end;
4327
4328     s := TFormatDescriptor.Get(aFormat).PixelSize;
4329     fFormat    := aFormat;
4330     fPixelSize := Ceil(s);
4331     fRowSize   := Ceil(s * aWidth);
4332   end;
4333 end;
4334
4335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4336 function TglBitmap.FlipHorz: Boolean;
4337 begin
4338   result := false;
4339 end;
4340
4341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4342 function TglBitmap.FlipVert: Boolean;
4343 begin
4344   result := false;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4350 procedure TglBitmap.AfterConstruction;
4351 begin
4352   inherited AfterConstruction;
4353
4354   fID         := 0;
4355   fTarget     := 0;
4356   fIsResident := false;
4357
4358   fFormat                  := glBitmapGetDefaultFormat;
4359   fMipMap                  := glBitmapDefaultMipmap;
4360   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4361   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4362
4363   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4364   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4365 end;
4366
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 procedure TglBitmap.BeforeDestruction;
4369 begin
4370   SetDataPointer(nil, tfEmpty);
4371   if (fID > 0) and fDeleteTextureOnFree then
4372     glDeleteTextures(1, @fID);
4373   inherited BeforeDestruction;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TglBitmap.LoadFromFile(const aFilename: String);
4378 var
4379   fs: TFileStream;
4380 begin
4381   if not FileExists(aFilename) then
4382     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4383   fFilename := aFilename;
4384   fs := TFileStream.Create(fFilename, fmOpenRead);
4385   try
4386     fs.Position := 0;
4387     LoadFromStream(fs);
4388   finally
4389     fs.Free;
4390   end;
4391 end;
4392
4393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4394 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4395 begin
4396   {$IFDEF GLB_SUPPORT_PNG_READ}
4397   if not LoadPNG(aStream) then
4398   {$ENDIF}
4399   {$IFDEF GLB_SUPPORT_JPEG_READ}
4400   if not LoadJPEG(aStream) then
4401   {$ENDIF}
4402   if not LoadDDS(aStream) then
4403   if not LoadTGA(aStream) then
4404   if not LoadBMP(aStream) then
4405     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4406 end;
4407
4408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4409 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4410   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4411 var
4412   tmpData: PByte;
4413   size: Integer;
4414 begin
4415   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4416   GetMem(tmpData, size);
4417   try
4418     FillChar(tmpData^, size, #$FF);
4419     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4420   except
4421     FreeMem(tmpData);
4422     raise;
4423   end;
4424   AddFunc(Self, aFunc, false, Format, aArgs);
4425 end;
4426
4427 {$IFDEF GLB_DELPHI}
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4430 var
4431   rs: TResourceStream;
4432   TempPos: Integer;
4433   ResTypeStr: String;
4434   TempResType: PChar;
4435 begin
4436   if not Assigned(ResType) then begin
4437     TempPos     := Pos('.', Resource);
4438     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4439     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4440     TempResType := PChar(ResTypeStr);
4441   end else
4442     TempResType := ResType
4443
4444   rs := TResourceStream.Create(Instance, Resource, TempResType);
4445   try
4446     LoadFromStream(rs);
4447   finally
4448     rs.Free;
4449   end;
4450 end;
4451
4452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4453 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4454 var
4455   rs: TResourceStream;
4456 begin
4457   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4458   try
4459     LoadFromStream(rs);
4460   finally
4461     rs.Free;
4462   end;
4463 end;
4464 {$ENDIF}
4465
4466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4468 var
4469   fs: TFileStream;
4470 begin
4471   fs := TFileStream.Create(aFileName, fmCreate);
4472   try
4473     fs.Position := 0;
4474     SaveToStream(fs, aFileType);
4475   finally
4476     fs.Free;
4477   end;
4478 end;
4479
4480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4481 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4482 begin
4483   case aFileType of
4484     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4485     ftPNG:  SavePNG(aStream);
4486     {$ENDIF}
4487     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4488     ftJPEG: SaveJPEG(aStream);
4489     {$ENDIF}
4490     ftDDS:  SaveDDS(aStream);
4491     ftTGA:  SaveTGA(aStream);
4492     ftBMP:  SaveBMP(aStream);
4493   end;
4494 end;
4495
4496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4497 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4498 begin
4499   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4500 end;
4501
4502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4503 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4504   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4505 var
4506   DestData, TmpData, SourceData: pByte;
4507   TempHeight, TempWidth: Integer;
4508   SourceFD, DestFD: TFormatDescriptor;
4509   SourceMD, DestMD: Pointer;
4510
4511   FuncRec: TglBitmapFunctionRec;
4512 begin
4513   Assert(Assigned(Data));
4514   Assert(Assigned(aSource));
4515   Assert(Assigned(aSource.Data));
4516
4517   result := false;
4518   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4519     SourceFD := TFormatDescriptor.Get(aSource.Format);
4520     DestFD   := TFormatDescriptor.Get(aFormat);
4521
4522     // inkompatible Formats so CreateTemp
4523     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4524       aCreateTemp := true;
4525
4526     // Values
4527     TempHeight := Max(1, aSource.Height);
4528     TempWidth  := Max(1, aSource.Width);
4529
4530     FuncRec.Sender := Self;
4531     FuncRec.Args   := aArgs;
4532
4533     TmpData := nil;
4534     if aCreateTemp then begin
4535       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4536       DestData := TmpData;
4537     end else
4538       DestData := Data;
4539
4540     try
4541       SourceFD.PreparePixel(FuncRec.Source);
4542       DestFD.PreparePixel  (FuncRec.Dest);
4543
4544       SourceMD := SourceFD.CreateMappingData;
4545       DestMD   := DestFD.CreateMappingData;
4546
4547       FuncRec.Size            := aSource.Dimension;
4548       FuncRec.Position.Fields := FuncRec.Size.Fields;
4549
4550       try
4551         SourceData := aSource.Data;
4552         FuncRec.Position.Y := 0;
4553         while FuncRec.Position.Y < TempHeight do begin
4554           FuncRec.Position.X := 0;
4555           while FuncRec.Position.X < TempWidth do begin
4556             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4557             aFunc(FuncRec);
4558             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4559             inc(FuncRec.Position.X);
4560           end;
4561           inc(FuncRec.Position.Y);
4562         end;
4563
4564         // Updating Image or InternalFormat
4565         if aCreateTemp then
4566           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4567         else if (aFormat <> fFormat) then
4568           Format := aFormat;
4569
4570         result := true;
4571       finally
4572         SourceFD.FreeMappingData(SourceMD);
4573         DestFD.FreeMappingData(DestMD);
4574       end;
4575     except
4576       if aCreateTemp then
4577         FreeMem(TmpData);
4578       raise;
4579     end;
4580   end;
4581 end;
4582
4583 {$IFDEF GLB_SDL}
4584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4585 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4586 var
4587   Row, RowSize: Integer;
4588   SourceData, TmpData: PByte;
4589   TempDepth: Integer;
4590   FormatDesc: TFormatDescriptor;
4591
4592   function GetRowPointer(Row: Integer): pByte;
4593   begin
4594     result := aSurface.pixels;
4595     Inc(result, Row * RowSize);
4596   end;
4597
4598 begin
4599   result := false;
4600
4601   FormatDesc := TFormatDescriptor.Get(Format);
4602   if FormatDesc.IsCompressed then
4603     raise EglBitmapUnsupportedFormat.Create(Format);
4604
4605   if Assigned(Data) then begin
4606     case Trunc(FormatDesc.PixelSize) of
4607       1: TempDepth :=  8;
4608       2: TempDepth := 16;
4609       3: TempDepth := 24;
4610       4: TempDepth := 32;
4611     else
4612       raise EglBitmapUnsupportedFormat.Create(Format);
4613     end;
4614
4615     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4616       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4617     SourceData := Data;
4618     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4619
4620     for Row := 0 to FileHeight-1 do begin
4621       TmpData := GetRowPointer(Row);
4622       if Assigned(TmpData) then begin
4623         Move(SourceData^, TmpData^, RowSize);
4624         inc(SourceData, RowSize);
4625       end;
4626     end;
4627     result := true;
4628   end;
4629 end;
4630
4631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4632 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4633 var
4634   pSource, pData, pTempData: PByte;
4635   Row, RowSize, TempWidth, TempHeight: Integer;
4636   IntFormat: TglBitmapFormat;
4637   FormatDesc: TFormatDescriptor;
4638
4639   function GetRowPointer(Row: Integer): pByte;
4640   begin
4641     result := aSurface^.pixels;
4642     Inc(result, Row * RowSize);
4643   end;
4644
4645 begin
4646   result := false;
4647   if (Assigned(aSurface)) then begin
4648     with aSurface^.format^ do begin
4649       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4650         FormatDesc := TFormatDescriptor.Get(IntFormat);
4651         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4652           break;
4653       end;
4654       if (IntFormat = tfEmpty) then
4655         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4656     end;
4657
4658     TempWidth  := aSurface^.w;
4659     TempHeight := aSurface^.h;
4660     RowSize := FormatDesc.GetSize(TempWidth, 1);
4661     GetMem(pData, TempHeight * RowSize);
4662     try
4663       pTempData := pData;
4664       for Row := 0 to TempHeight -1 do begin
4665         pSource := GetRowPointer(Row);
4666         if (Assigned(pSource)) then begin
4667           Move(pSource^, pTempData^, RowSize);
4668           Inc(pTempData, RowSize);
4669         end;
4670       end;
4671       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4672       result := true;
4673     except
4674       FreeMem(pData);
4675       raise;
4676     end;
4677   end;
4678 end;
4679
4680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4681 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4682 var
4683   Row, Col, AlphaInterleave: Integer;
4684   pSource, pDest: PByte;
4685
4686   function GetRowPointer(Row: Integer): pByte;
4687   begin
4688     result := aSurface.pixels;
4689     Inc(result, Row * Width);
4690   end;
4691
4692 begin
4693   result := false;
4694   if Assigned(Data) then begin
4695     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4696       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4697
4698       AlphaInterleave := 0;
4699       case Format of
4700         tfLuminance8Alpha8:
4701           AlphaInterleave := 1;
4702         tfBGRA8, tfRGBA8:
4703           AlphaInterleave := 3;
4704       end;
4705
4706       pSource := Data;
4707       for Row := 0 to Height -1 do begin
4708         pDest := GetRowPointer(Row);
4709         if Assigned(pDest) then begin
4710           for Col := 0 to Width -1 do begin
4711             Inc(pSource, AlphaInterleave);
4712             pDest^ := pSource^;
4713             Inc(pDest);
4714             Inc(pSource);
4715           end;
4716         end;
4717       end;
4718       result := true;
4719     end;
4720   end;
4721 end;
4722
4723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4724 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4725 var
4726   bmp: TglBitmap2D;
4727 begin
4728   bmp := TglBitmap2D.Create;
4729   try
4730     bmp.AssignFromSurface(aSurface);
4731     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4732   finally
4733     bmp.Free;
4734   end;
4735 end;
4736 {$ENDIF}
4737
4738 {$IFDEF GLB_DELPHI}
4739 //TODO rework & test
4740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4741 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4742 var
4743   Row: Integer;
4744   pSource, pData: PByte;
4745 begin
4746   result := false;
4747   if Assigned(Data) then begin
4748     if Assigned(aBitmap) then begin
4749       aBitmap.Width  := Width;
4750       aBitmap.Height := Height;
4751
4752       case Format of
4753         tfAlpha8, ifLuminance, ifDepth8:
4754           begin
4755             Bitmap.PixelFormat := pf8bit;
4756             Bitmap.Palette := CreateGrayPalette;
4757           end;
4758         ifRGB5A1:
4759           Bitmap.PixelFormat := pf15bit;
4760         ifR5G6B5:
4761           Bitmap.PixelFormat := pf16bit;
4762         ifRGB8, ifBGR8:
4763           Bitmap.PixelFormat := pf24bit;
4764         ifRGBA8, ifBGRA8:
4765           Bitmap.PixelFormat := pf32bit;
4766         else
4767           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4768       end;
4769
4770       pSource := Data;
4771       for Row := 0 to FileHeight -1 do begin
4772         pData := Bitmap.Scanline[Row];
4773
4774         Move(pSource^, pData^, fRowSize);
4775         Inc(pSource, fRowSize);
4776
4777         // swap RGB(A) to BGR(A)
4778         if InternalFormat in [ifRGB8, ifRGBA8] then
4779           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4780       end;
4781
4782       result := true;
4783     end;
4784   end;
4785 end;
4786
4787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4788 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4789 var
4790   pSource, pData, pTempData: PByte;
4791   Row, RowSize, TempWidth, TempHeight: Integer;
4792   IntFormat: TglBitmapInternalFormat;
4793 begin
4794   result := false;
4795
4796   if (Assigned(Bitmap)) then begin
4797     case Bitmap.PixelFormat of
4798       pf8bit:
4799         IntFormat := ifLuminance;
4800       pf15bit:
4801         IntFormat := ifRGB5A1;
4802       pf16bit:
4803         IntFormat := ifR5G6B5;
4804       pf24bit:
4805         IntFormat := ifBGR8;
4806       pf32bit:
4807         IntFormat := ifBGRA8;
4808       else
4809         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4810     end;
4811
4812     TempWidth := Bitmap.Width;
4813     TempHeight := Bitmap.Height;
4814
4815     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4816
4817     GetMem(pData, TempHeight * RowSize);
4818     try
4819       pTempData := pData;
4820
4821       for Row := 0 to TempHeight -1 do begin
4822         pSource := Bitmap.Scanline[Row];
4823
4824         if (Assigned(pSource)) then begin
4825           Move(pSource^, pTempData^, RowSize);
4826           Inc(pTempData, RowSize);
4827         end;
4828       end;
4829
4830       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4831
4832       result := true;
4833     except
4834       FreeMem(pData);
4835       raise;
4836     end;
4837   end;
4838 end;
4839
4840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4841 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4842 var
4843   Row, Col, AlphaInterleave: Integer;
4844   pSource, pDest: PByte;
4845 begin
4846   result := false;
4847
4848   if Assigned(Data) then begin
4849     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4850       if Assigned(Bitmap) then begin
4851         Bitmap.PixelFormat := pf8bit;
4852         Bitmap.Palette := CreateGrayPalette;
4853         Bitmap.Width := Width;
4854         Bitmap.Height := Height;
4855
4856         case InternalFormat of
4857           ifLuminanceAlpha:
4858             AlphaInterleave := 1;
4859           ifRGBA8, ifBGRA8:
4860             AlphaInterleave := 3;
4861           else
4862             AlphaInterleave := 0;
4863         end;
4864
4865         // Copy Data
4866         pSource := Data;
4867
4868         for Row := 0 to Height -1 do begin
4869           pDest := Bitmap.Scanline[Row];
4870
4871           if Assigned(pDest) then begin
4872             for Col := 0 to Width -1 do begin
4873               Inc(pSource, AlphaInterleave);
4874               pDest^ := pSource^;
4875               Inc(pDest);
4876               Inc(pSource);
4877             end;
4878           end;
4879         end;
4880
4881         result := true;
4882       end;
4883     end;
4884   end;
4885 end;
4886
4887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4888 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4889 var
4890   tex: TglBitmap2D;
4891 begin
4892   tex := TglBitmap2D.Create;
4893   try
4894     tex.AssignFromBitmap(Bitmap);
4895     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4896   finally
4897     tex.Free;
4898   end;
4899 end;
4900
4901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4902 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4903   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4904 var
4905   RS: TResourceStream;
4906   TempPos: Integer;
4907   ResTypeStr: String;
4908   TempResType: PChar;
4909 begin
4910   if Assigned(ResType) then
4911     TempResType := ResType
4912   else
4913     begin
4914       TempPos := Pos('.', Resource);
4915       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4916       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4917       TempResType := PChar(ResTypeStr);
4918     end;
4919
4920   RS := TResourceStream.Create(Instance, Resource, TempResType);
4921   try
4922     result := AddAlphaFromStream(RS, Func, CustomData);
4923   finally
4924     RS.Free;
4925   end;
4926 end;
4927
4928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4929 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4930   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4931 var
4932   RS: TResourceStream;
4933 begin
4934   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4935   try
4936     result := AddAlphaFromStream(RS, Func, CustomData);
4937   finally
4938     RS.Free;
4939   end;
4940 end;
4941 {$ENDIF}
4942
4943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4944 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4945 begin
4946   if TFormatDescriptor.Get(Format).IsCompressed then
4947     raise EglBitmapUnsupportedFormat.Create(Format);
4948   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4949 end;
4950
4951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4952 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4953 var
4954   FS: TFileStream;
4955 begin
4956   FS := TFileStream.Create(FileName, fmOpenRead);
4957   try
4958     result := AddAlphaFromStream(FS, aFunc, aArgs);
4959   finally
4960     FS.Free;
4961   end;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4966 var
4967   tex: TglBitmap2D;
4968 begin
4969   tex := TglBitmap2D.Create(aStream);
4970   try
4971     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4972   finally
4973     tex.Free;
4974   end;
4975 end;
4976
4977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4978 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4979 var
4980   DestData, DestData2, SourceData: pByte;
4981   TempHeight, TempWidth: Integer;
4982   SourceFD, DestFD: TFormatDescriptor;
4983   SourceMD, DestMD, DestMD2: Pointer;
4984
4985   FuncRec: TglBitmapFunctionRec;
4986 begin
4987   result := false;
4988
4989   Assert(Assigned(Data));
4990   Assert(Assigned(aBitmap));
4991   Assert(Assigned(aBitmap.Data));
4992
4993   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4994     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4995
4996     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4997     DestFD   := TFormatDescriptor.Get(Format);
4998
4999     if not Assigned(aFunc) then begin
5000       aFunc        := glBitmapAlphaFunc;
5001       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5002     end else
5003       FuncRec.Args := aArgs;
5004
5005     // Values
5006     TempHeight := aBitmap.FileHeight;
5007     TempWidth  := aBitmap.FileWidth;
5008
5009     FuncRec.Sender          := Self;
5010     FuncRec.Size            := Dimension;
5011     FuncRec.Position.Fields := FuncRec.Size.Fields;
5012
5013     DestData   := Data;
5014     DestData2  := Data;
5015     SourceData := aBitmap.Data;
5016
5017     // Mapping
5018     SourceFD.PreparePixel(FuncRec.Source);
5019     DestFD.PreparePixel  (FuncRec.Dest);
5020
5021     SourceMD := SourceFD.CreateMappingData;
5022     DestMD   := DestFD.CreateMappingData;
5023     DestMD2  := DestFD.CreateMappingData;
5024     try
5025       FuncRec.Position.Y := 0;
5026       while FuncRec.Position.Y < TempHeight do begin
5027         FuncRec.Position.X := 0;
5028         while FuncRec.Position.X < TempWidth do begin
5029           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5030           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5031           aFunc(FuncRec);
5032           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5033           inc(FuncRec.Position.X);
5034         end;
5035         inc(FuncRec.Position.Y);
5036       end;
5037     finally
5038       SourceFD.FreeMappingData(SourceMD);
5039       DestFD.FreeMappingData(DestMD);
5040       DestFD.FreeMappingData(DestMD2);
5041     end;
5042   end;
5043 end;
5044
5045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5046 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5047 begin
5048   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5049 end;
5050
5051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5052 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5053 var
5054   PixelData: TglBitmapPixelData;
5055 begin
5056   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5057   result := AddAlphaFromColorKeyFloat(
5058     aRed   / PixelData.Range.r,
5059     aGreen / PixelData.Range.g,
5060     aBlue  / PixelData.Range.b,
5061     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5062 end;
5063
5064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5065 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5066 var
5067   values: array[0..2] of Single;
5068   tmp: Cardinal;
5069   i: Integer;
5070   PixelData: TglBitmapPixelData;
5071 begin
5072   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5073   with PixelData do begin
5074     values[0] := aRed;
5075     values[1] := aGreen;
5076     values[2] := aBlue;
5077
5078     for i := 0 to 2 do begin
5079       tmp          := Trunc(Range.arr[i] * aDeviation);
5080       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5081       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5082     end;
5083     Data.a  := 0;
5084     Range.a := 0;
5085   end;
5086   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5087 end;
5088
5089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5090 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5091 begin
5092   result := AddAlphaFromValueFloat(aAlpha / $FF);
5093 end;
5094
5095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5096 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5097 var
5098   PixelData: TglBitmapPixelData;
5099 begin
5100   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5101   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5102 end;
5103
5104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5105 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5106 var
5107   PixelData: TglBitmapPixelData;
5108 begin
5109   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5110   with PixelData do
5111     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5112   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5113 end;
5114
5115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5116 function TglBitmap.RemoveAlpha: Boolean;
5117 var
5118   FormatDesc: TFormatDescriptor;
5119 begin
5120   result := false;
5121   FormatDesc := TFormatDescriptor.Get(Format);
5122   if Assigned(Data) then begin
5123     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5124       raise EglBitmapUnsupportedFormat.Create(Format);
5125     result := ConvertTo(FormatDesc.WithoutAlpha);
5126   end;
5127 end;
5128
5129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5130 function TglBitmap.Clone: TglBitmap;
5131 var
5132   Temp: TglBitmap;
5133   TempPtr: PByte;
5134   Size: Integer;
5135 begin
5136   result := nil;
5137   Temp := (ClassType.Create as TglBitmap);
5138   try
5139     // copy texture data if assigned
5140     if Assigned(Data) then begin
5141       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5142       GetMem(TempPtr, Size);
5143       try
5144         Move(Data^, TempPtr^, Size);
5145         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5146       except
5147         FreeMem(TempPtr);
5148         raise;
5149       end;
5150     end else
5151       Temp.SetDataPointer(nil, Format, Width, Height);
5152
5153         // copy properties
5154     Temp.fID                      := ID;
5155     Temp.fTarget                  := Target;
5156     Temp.fFormat                  := Format;
5157     Temp.fMipMap                  := MipMap;
5158     Temp.fAnisotropic             := Anisotropic;
5159     Temp.fBorderColor             := fBorderColor;
5160     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5161     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5162     Temp.fFilterMin               := fFilterMin;
5163     Temp.fFilterMag               := fFilterMag;
5164     Temp.fWrapS                   := fWrapS;
5165     Temp.fWrapT                   := fWrapT;
5166     Temp.fWrapR                   := fWrapR;
5167     Temp.fFilename                := fFilename;
5168     Temp.fCustomName              := fCustomName;
5169     Temp.fCustomNameW             := fCustomNameW;
5170     Temp.fCustomData              := fCustomData;
5171
5172     result := Temp;
5173   except
5174     FreeAndNil(Temp);
5175     raise;
5176   end;
5177 end;
5178
5179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5180 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5181 var
5182   SourceFD, DestFD: TFormatDescriptor;
5183   SourcePD, DestPD: TglBitmapPixelData;
5184   ShiftData: TShiftData;
5185
5186   function CanCopyDirect: Boolean;
5187   begin
5188     result :=
5189       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5190       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5191       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5192       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5193   end;
5194
5195   function CanShift: Boolean;
5196   begin
5197     result :=
5198       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5199       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5200       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5201       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5202   end;
5203
5204   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5205   begin
5206     result := 0;
5207     while (aSource > aDest) and (aSource > 0) do begin
5208       inc(result);
5209       aSource := aSource shr 1;
5210     end;
5211   end;
5212
5213 begin
5214   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5215     SourceFD := TFormatDescriptor.Get(Format);
5216     DestFD   := TFormatDescriptor.Get(aFormat);
5217
5218     SourceFD.PreparePixel(SourcePD);
5219     DestFD.PreparePixel  (DestPD);
5220
5221     if CanCopyDirect then
5222       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5223     else if CanShift then begin
5224       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5225       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5226       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5227       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5228       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5229     end else
5230       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5231   end else
5232     result := true;
5233 end;
5234
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5237 begin
5238   if aUseRGB or aUseAlpha then
5239     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5240       ((PtrInt(aUseAlpha) and 1) shl 1) or
5241        (PtrInt(aUseRGB)   and 1)      ));
5242 end;
5243
5244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5245 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5246 begin
5247   fBorderColor[0] := aRed;
5248   fBorderColor[1] := aGreen;
5249   fBorderColor[2] := aBlue;
5250   fBorderColor[3] := aAlpha;
5251   if (ID > 0) then begin
5252     Bind(false);
5253     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5254   end;
5255 end;
5256
5257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5258 procedure TglBitmap.FreeData;
5259 begin
5260   SetDataPointer(nil, tfEmpty);
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5265   const aAlpha: Byte);
5266 begin
5267   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5268 end;
5269
5270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5271 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5272 var
5273   PixelData: TglBitmapPixelData;
5274 begin
5275   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5276   FillWithColorFloat(
5277     aRed   / PixelData.Range.r,
5278     aGreen / PixelData.Range.g,
5279     aBlue  / PixelData.Range.b,
5280     aAlpha / PixelData.Range.a);
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5285 var
5286   PixelData: TglBitmapPixelData;
5287 begin
5288   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5289   with PixelData do begin
5290     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5291     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5292     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5293     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5294   end;
5295   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5300 begin
5301   //check MIN filter
5302   case aMin of
5303     GL_NEAREST:
5304       fFilterMin := GL_NEAREST;
5305     GL_LINEAR:
5306       fFilterMin := GL_LINEAR;
5307     GL_NEAREST_MIPMAP_NEAREST:
5308       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5309     GL_LINEAR_MIPMAP_NEAREST:
5310       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5311     GL_NEAREST_MIPMAP_LINEAR:
5312       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5313     GL_LINEAR_MIPMAP_LINEAR:
5314       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5315     else
5316       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5317   end;
5318
5319   //check MAG filter
5320   case aMag of
5321     GL_NEAREST:
5322       fFilterMag := GL_NEAREST;
5323     GL_LINEAR:
5324       fFilterMag := GL_LINEAR;
5325     else
5326       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5327   end;
5328
5329   //apply filter
5330   if (ID > 0) then begin
5331     Bind(false);
5332     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5333
5334     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5335       case fFilterMin of
5336         GL_NEAREST, GL_LINEAR:
5337           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5338         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5339           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5340         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5341           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5342       end;
5343     end else
5344       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5345   end;
5346 end;
5347
5348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5349 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5350
5351   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5352   begin
5353     case aValue of
5354       GL_CLAMP:
5355         aTarget := GL_CLAMP;
5356
5357       GL_REPEAT:
5358         aTarget := GL_REPEAT;
5359
5360       GL_CLAMP_TO_EDGE: begin
5361         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5362           aTarget := GL_CLAMP_TO_EDGE
5363         else
5364           aTarget := GL_CLAMP;
5365       end;
5366
5367       GL_CLAMP_TO_BORDER: begin
5368         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5369           aTarget := GL_CLAMP_TO_BORDER
5370         else
5371           aTarget := GL_CLAMP;
5372       end;
5373
5374       GL_MIRRORED_REPEAT: begin
5375         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5376           aTarget := GL_MIRRORED_REPEAT
5377         else
5378           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5379       end;
5380     else
5381       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5382     end;
5383   end;
5384
5385 begin
5386   CheckAndSetWrap(S, fWrapS);
5387   CheckAndSetWrap(T, fWrapT);
5388   CheckAndSetWrap(R, fWrapR);
5389
5390   if (ID > 0) then begin
5391     Bind(false);
5392     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5393     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5394     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5395   end;
5396 end;
5397
5398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5399 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5400 begin
5401   if aEnableTextureUnit then
5402     glEnable(Target);
5403   if (ID > 0) then
5404     glBindTexture(Target, ID);
5405 end;
5406
5407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5408 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5409 begin
5410   if aDisableTextureUnit then
5411     glDisable(Target);
5412   glBindTexture(Target, 0);
5413 end;
5414
5415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 constructor TglBitmap.Create;
5417 begin
5418 {$IFDEF GLB_NATIVE_OGL}
5419   glbReadOpenGLExtensions;
5420 {$ENDIF}
5421   if (ClassType = TglBitmap) then
5422     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5423   inherited Create;
5424 end;
5425
5426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5427 constructor TglBitmap.Create(const aFileName: String);
5428 begin
5429   Create;
5430   LoadFromFile(FileName);
5431 end;
5432
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 constructor TglBitmap.Create(const aStream: TStream);
5435 begin
5436   Create;
5437   LoadFromStream(aStream);
5438 end;
5439
5440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5441 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5442 var
5443   Image: PByte;
5444   ImageSize: Integer;
5445 begin
5446   Create;
5447   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5448   GetMem(Image, ImageSize);
5449   try
5450     FillChar(Image^, ImageSize, #$FF);
5451     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5452   except
5453     FreeMem(Image);
5454     raise;
5455   end;
5456 end;
5457
5458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5459 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5460   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5461 begin
5462   Create;
5463   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5464 end;
5465
5466 {$IFDEF GLB_DELPHI}
5467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5468 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5469 begin
5470   Create;
5471   LoadFromResource(aInstance, aResource, aResType);
5472 end;
5473
5474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5475 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5476 begin
5477   Create;
5478   LoadFromResourceID(aInstance, aResourceID, aResType);
5479 end;
5480 {$ENDIF}
5481
5482 {$IFDEF GLB_SUPPORT_PNG_READ}
5483 {$IF DEFINED(GLB_SDL_IMAGE)}
5484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5485 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5487 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5488 var
5489   Surface: PSDL_Surface;
5490   RWops: PSDL_RWops;
5491 begin
5492   result := false;
5493   RWops := glBitmapCreateRWops(aStream);
5494   try
5495     if IMG_isPNG(RWops) > 0 then begin
5496       Surface := IMG_LoadPNG_RW(RWops);
5497       try
5498         AssignFromSurface(Surface);
5499         result := true;
5500       finally
5501         SDL_FreeSurface(Surface);
5502       end;
5503     end;
5504   finally
5505     SDL_FreeRW(RWops);
5506   end;
5507 end;
5508
5509 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5512 begin
5513   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5514 end;
5515
5516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5517 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5518 var
5519   StreamPos: Int64;
5520   signature: array [0..7] of byte;
5521   png: png_structp;
5522   png_info: png_infop;
5523
5524   TempHeight, TempWidth: Integer;
5525   Format: TglBitmapFormat;
5526
5527   png_data: pByte;
5528   png_rows: array of pByte;
5529   Row, LineSize: Integer;
5530 begin
5531   result := false;
5532
5533   if not init_libPNG then
5534     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5535
5536   try
5537     // signature
5538     StreamPos := aStream.Position;
5539     aStream.Read(signature{%H-}, 8);
5540     aStream.Position := StreamPos;
5541
5542     if png_check_sig(@signature, 8) <> 0 then begin
5543       // png read struct
5544       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5545       if png = nil then
5546         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5547
5548       // png info
5549       png_info := png_create_info_struct(png);
5550       if png_info = nil then begin
5551         png_destroy_read_struct(@png, nil, nil);
5552         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5553       end;
5554
5555       // set read callback
5556       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5557
5558       // read informations
5559       png_read_info(png, png_info);
5560
5561       // size
5562       TempHeight := png_get_image_height(png, png_info);
5563       TempWidth := png_get_image_width(png, png_info);
5564
5565       // format
5566       case png_get_color_type(png, png_info) of
5567         PNG_COLOR_TYPE_GRAY:
5568           Format := tfLuminance8;
5569         PNG_COLOR_TYPE_GRAY_ALPHA:
5570           Format := tfLuminance8Alpha8;
5571         PNG_COLOR_TYPE_RGB:
5572           Format := tfRGB8;
5573         PNG_COLOR_TYPE_RGB_ALPHA:
5574           Format := tfRGBA8;
5575         else
5576           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5577       end;
5578
5579       // cut upper 8 bit from 16 bit formats
5580       if png_get_bit_depth(png, png_info) > 8 then
5581         png_set_strip_16(png);
5582
5583       // expand bitdepth smaller than 8
5584       if png_get_bit_depth(png, png_info) < 8 then
5585         png_set_expand(png);
5586
5587       // allocating mem for scanlines
5588       LineSize := png_get_rowbytes(png, png_info);
5589       GetMem(png_data, TempHeight * LineSize);
5590       try
5591         SetLength(png_rows, TempHeight);
5592         for Row := Low(png_rows) to High(png_rows) do begin
5593           png_rows[Row] := png_data;
5594           Inc(png_rows[Row], Row * LineSize);
5595         end;
5596
5597         // read complete image into scanlines
5598         png_read_image(png, @png_rows[0]);
5599
5600         // read end
5601         png_read_end(png, png_info);
5602
5603         // destroy read struct
5604         png_destroy_read_struct(@png, @png_info, nil);
5605
5606         SetLength(png_rows, 0);
5607
5608         // set new data
5609         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5610
5611         result := true;
5612       except
5613         FreeMem(png_data);
5614         raise;
5615       end;
5616     end;
5617   finally
5618     quit_libPNG;
5619   end;
5620 end;
5621
5622 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5624 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5625 var
5626   StreamPos: Int64;
5627   Png: TPNGObject;
5628   Header: String[8];
5629   Row, Col, PixSize, LineSize: Integer;
5630   NewImage, pSource, pDest, pAlpha: pByte;
5631   PngFormat: TglBitmapFormat;
5632   FormatDesc: TFormatDescriptor;
5633
5634 const
5635   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5636
5637 begin
5638   result := false;
5639
5640   StreamPos := aStream.Position;
5641   aStream.Read(Header[0], SizeOf(Header));
5642   aStream.Position := StreamPos;
5643
5644   {Test if the header matches}
5645   if Header = PngHeader then begin
5646     Png := TPNGObject.Create;
5647     try
5648       Png.LoadFromStream(aStream);
5649
5650       case Png.Header.ColorType of
5651         COLOR_GRAYSCALE:
5652           PngFormat := tfLuminance8;
5653         COLOR_GRAYSCALEALPHA:
5654           PngFormat := tfLuminance8Alpha8;
5655         COLOR_RGB:
5656           PngFormat := tfBGR8;
5657         COLOR_RGBALPHA:
5658           PngFormat := tfBGRA8;
5659         else
5660           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5661       end;
5662
5663       FormatDesc := TFormatDescriptor.Get(PngFormat);
5664       PixSize    := Round(FormatDesc.PixelSize);
5665       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5666
5667       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5668       try
5669         pDest := NewImage;
5670
5671         case Png.Header.ColorType of
5672           COLOR_RGB, COLOR_GRAYSCALE:
5673             begin
5674               for Row := 0 to Png.Height -1 do begin
5675                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5676                 Inc(pDest, LineSize);
5677               end;
5678             end;
5679           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5680             begin
5681               PixSize := PixSize -1;
5682
5683               for Row := 0 to Png.Height -1 do begin
5684                 pSource := Png.Scanline[Row];
5685                 pAlpha := pByte(Png.AlphaScanline[Row]);
5686
5687                 for Col := 0 to Png.Width -1 do begin
5688                   Move (pSource^, pDest^, PixSize);
5689                   Inc(pSource, PixSize);
5690                   Inc(pDest, PixSize);
5691
5692                   pDest^ := pAlpha^;
5693                   inc(pAlpha);
5694                   Inc(pDest);
5695                 end;
5696               end;
5697             end;
5698           else
5699             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5700         end;
5701
5702         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
5703
5704         result := true;
5705       except
5706         FreeMem(NewImage);
5707         raise;
5708       end;
5709     finally
5710       Png.Free;
5711     end;
5712   end;
5713 end;
5714 {$IFEND}
5715 {$ENDIF}
5716
5717 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5718 {$IFDEF GLB_LIB_PNG}
5719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5720 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5721 begin
5722   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5723 end;
5724 {$ENDIF}
5725
5726 {$IF DEFINED(GLB_LIB_PNG)}
5727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5728 procedure TglBitmap.SavePNG(const aStream: TStream);
5729 var
5730   png: png_structp;
5731   png_info: png_infop;
5732   png_rows: array of pByte;
5733   LineSize: Integer;
5734   ColorType: Integer;
5735   Row: Integer;
5736   FormatDesc: TFormatDescriptor;
5737 begin
5738   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5739     raise EglBitmapUnsupportedFormat.Create(Format);
5740
5741   if not init_libPNG then
5742     raise Exception.Create('unable to initialize libPNG.');
5743
5744   try
5745     case Format of
5746       tfAlpha8, tfLuminance8:
5747         ColorType := PNG_COLOR_TYPE_GRAY;
5748       tfLuminance8Alpha8:
5749         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5750       tfBGR8, tfRGB8:
5751         ColorType := PNG_COLOR_TYPE_RGB;
5752       tfBGRA8, tfRGBA8:
5753         ColorType := PNG_COLOR_TYPE_RGBA;
5754       else
5755         raise EglBitmapUnsupportedFormat.Create(Format);
5756     end;
5757
5758     FormatDesc := TFormatDescriptor.Get(Format);
5759     LineSize := FormatDesc.GetSize(Width, 1);
5760
5761     // creating array for scanline
5762     SetLength(png_rows, Height);
5763     try
5764       for Row := 0 to Height - 1 do begin
5765         png_rows[Row] := Data;
5766         Inc(png_rows[Row], Row * LineSize)
5767       end;
5768
5769       // write struct
5770       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5771       if png = nil then
5772         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5773
5774       // create png info
5775       png_info := png_create_info_struct(png);
5776       if png_info = nil then begin
5777         png_destroy_write_struct(@png, nil);
5778         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5779       end;
5780
5781       // set read callback
5782       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5783
5784       // set compression
5785       png_set_compression_level(png, 6);
5786
5787       if Format in [tfBGR8, tfBGRA8] then
5788         png_set_bgr(png);
5789
5790       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5791       png_write_info(png, png_info);
5792       png_write_image(png, @png_rows[0]);
5793       png_write_end(png, png_info);
5794       png_destroy_write_struct(@png, @png_info);
5795     finally
5796       SetLength(png_rows, 0);
5797     end;
5798   finally
5799     quit_libPNG;
5800   end;
5801 end;
5802
5803 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5805 procedure TglBitmap.SavePNG(const aStream: TStream);
5806 var
5807   Png: TPNGObject;
5808
5809   pSource, pDest: pByte;
5810   X, Y, PixSize: Integer;
5811   ColorType: Cardinal;
5812   Alpha: Boolean;
5813
5814   pTemp: pByte;
5815   Temp: Byte;
5816 begin
5817   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5818     raise EglBitmapUnsupportedFormat.Create(Format);
5819
5820   case Format of
5821     tfAlpha8, tfLuminance8: begin
5822       ColorType := COLOR_GRAYSCALE;
5823       PixSize   := 1;
5824       Alpha     := false;
5825     end;
5826     tfLuminance8Alpha8: begin
5827       ColorType := COLOR_GRAYSCALEALPHA;
5828       PixSize   := 1;
5829       Alpha     := true;
5830     end;
5831     tfBGR8, tfRGB8: begin
5832       ColorType := COLOR_RGB;
5833       PixSize   := 3;
5834       Alpha     := false;
5835     end;
5836     tfBGRA8, tfRGBA8: begin
5837       ColorType := COLOR_RGBALPHA;
5838       PixSize   := 3;
5839       Alpha     := true
5840     end;
5841   else
5842     raise EglBitmapUnsupportedFormat.Create(Format);
5843   end;
5844
5845   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5846   try
5847     // Copy ImageData
5848     pSource := Data;
5849     for Y := 0 to Height -1 do begin
5850       pDest := png.ScanLine[Y];
5851       for X := 0 to Width -1 do begin
5852         Move(pSource^, pDest^, PixSize);
5853         Inc(pDest, PixSize);
5854         Inc(pSource, PixSize);
5855         if Alpha then begin
5856           png.AlphaScanline[Y]^[X] := pSource^;
5857           Inc(pSource);
5858         end;
5859       end;
5860
5861       // convert RGB line to BGR
5862       if Format in [tfRGB8, tfRGBA8] then begin
5863         pTemp := png.ScanLine[Y];
5864         for X := 0 to Width -1 do begin
5865           Temp := pByteArray(pTemp)^[0];
5866           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5867           pByteArray(pTemp)^[2] := Temp;
5868           Inc(pTemp, 3);
5869         end;
5870       end;
5871     end;
5872
5873     // Save to Stream
5874     Png.CompressionLevel := 6;
5875     Png.SaveToStream(aStream);
5876   finally
5877     FreeAndNil(Png);
5878   end;
5879 end;
5880 {$IFEND}
5881 {$ENDIF}
5882
5883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5884 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5886 {$IFDEF GLB_LIB_JPEG}
5887 type
5888   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5889   glBitmap_libJPEG_source_mgr = record
5890     pub: jpeg_source_mgr;
5891
5892     SrcStream: TStream;
5893     SrcBuffer: array [1..4096] of byte;
5894   end;
5895
5896   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5897   glBitmap_libJPEG_dest_mgr = record
5898     pub: jpeg_destination_mgr;
5899
5900     DestStream: TStream;
5901     DestBuffer: array [1..4096] of byte;
5902   end;
5903
5904 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5905 begin
5906   //DUMMY
5907 end;
5908
5909
5910 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5911 begin
5912   //DUMMY
5913 end;
5914
5915
5916 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5917 begin
5918   //DUMMY
5919 end;
5920
5921 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5922 begin
5923   //DUMMY
5924 end;
5925
5926
5927 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5928 begin
5929   //DUMMY
5930 end;
5931
5932
5933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5934 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5935 var
5936   src: glBitmap_libJPEG_source_mgr_ptr;
5937   bytes: integer;
5938 begin
5939   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5940
5941   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5942         if (bytes <= 0) then begin
5943                 src^.SrcBuffer[1] := $FF;
5944                 src^.SrcBuffer[2] := JPEG_EOI;
5945                 bytes := 2;
5946         end;
5947
5948         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5949         src^.pub.bytes_in_buffer := bytes;
5950
5951   result := true;
5952 end;
5953
5954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5955 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5956 var
5957   src: glBitmap_libJPEG_source_mgr_ptr;
5958 begin
5959   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5960
5961   if num_bytes > 0 then begin
5962     // wanted byte isn't in buffer so set stream position and read buffer
5963     if num_bytes > src^.pub.bytes_in_buffer then begin
5964       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5965       src^.pub.fill_input_buffer(cinfo);
5966     end else begin
5967       // wanted byte is in buffer so only skip
5968                 inc(src^.pub.next_input_byte, num_bytes);
5969                 dec(src^.pub.bytes_in_buffer, num_bytes);
5970     end;
5971   end;
5972 end;
5973
5974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5975 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5976 var
5977   dest: glBitmap_libJPEG_dest_mgr_ptr;
5978 begin
5979   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5980
5981   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5982     // write complete buffer
5983     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5984
5985     // reset buffer
5986     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5987     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5988   end;
5989
5990   result := true;
5991 end;
5992
5993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5994 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5995 var
5996   Idx: Integer;
5997   dest: glBitmap_libJPEG_dest_mgr_ptr;
5998 begin
5999   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6000
6001   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6002     // check for endblock
6003     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6004       // write endblock
6005       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6006
6007       // leave
6008       break;
6009     end else
6010       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6011   end;
6012 end;
6013 {$ENDIF}
6014
6015 {$IFDEF GLB_SUPPORT_JPEG_READ}
6016 {$IF DEFINED(GLB_SDL_IMAGE)}
6017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6018 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6019 var
6020   Surface: PSDL_Surface;
6021   RWops: PSDL_RWops;
6022 begin
6023   result := false;
6024
6025   RWops := glBitmapCreateRWops(aStream);
6026   try
6027     if IMG_isJPG(RWops) > 0 then begin
6028       Surface := IMG_LoadJPG_RW(RWops);
6029       try
6030         AssignFromSurface(Surface);
6031         result := true;
6032       finally
6033         SDL_FreeSurface(Surface);
6034       end;
6035     end;
6036   finally
6037     SDL_FreeRW(RWops);
6038   end;
6039 end;
6040
6041 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6043 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6044 var
6045   StreamPos: Int64;
6046   Temp: array[0..1]of Byte;
6047
6048   jpeg: jpeg_decompress_struct;
6049   jpeg_err: jpeg_error_mgr;
6050
6051   IntFormat: TglBitmapFormat;
6052   pImage: pByte;
6053   TempHeight, TempWidth: Integer;
6054
6055   pTemp: pByte;
6056   Row: Integer;
6057
6058   FormatDesc: TFormatDescriptor;
6059 begin
6060   result := false;
6061
6062   if not init_libJPEG then
6063     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6064
6065   try
6066     // reading first two bytes to test file and set cursor back to begin
6067     StreamPos := aStream.Position;
6068     aStream.Read({%H-}Temp[0], 2);
6069     aStream.Position := StreamPos;
6070
6071     // if Bitmap then read file.
6072     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6073       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6074       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6075
6076       // error managment
6077       jpeg.err := jpeg_std_error(@jpeg_err);
6078       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6079       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6080
6081       // decompression struct
6082       jpeg_create_decompress(@jpeg);
6083
6084       // allocation space for streaming methods
6085       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6086
6087       // seeting up custom functions
6088       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6089         pub.init_source       := glBitmap_libJPEG_init_source;
6090         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6091         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6092         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6093         pub.term_source       := glBitmap_libJPEG_term_source;
6094
6095         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6096         pub.next_input_byte := nil;   // until buffer loaded
6097
6098         SrcStream := aStream;
6099       end;
6100
6101       // set global decoding state
6102       jpeg.global_state := DSTATE_START;
6103
6104       // read header of jpeg
6105       jpeg_read_header(@jpeg, false);
6106
6107       // setting output parameter
6108       case jpeg.jpeg_color_space of
6109         JCS_GRAYSCALE:
6110           begin
6111             jpeg.out_color_space := JCS_GRAYSCALE;
6112             IntFormat := tfLuminance8;
6113           end;
6114         else
6115           jpeg.out_color_space := JCS_RGB;
6116           IntFormat := tfRGB8;
6117       end;
6118
6119       // reading image
6120       jpeg_start_decompress(@jpeg);
6121
6122       TempHeight := jpeg.output_height;
6123       TempWidth := jpeg.output_width;
6124
6125       FormatDesc := TFormatDescriptor.Get(IntFormat);
6126
6127       // creating new image
6128       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6129       try
6130         pTemp := pImage;
6131
6132         for Row := 0 to TempHeight -1 do begin
6133           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6134           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6135         end;
6136
6137         // finish decompression
6138         jpeg_finish_decompress(@jpeg);
6139
6140         // destroy decompression
6141         jpeg_destroy_decompress(@jpeg);
6142
6143         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6144
6145         result := true;
6146       except
6147         FreeMem(pImage);
6148         raise;
6149       end;
6150     end;
6151   finally
6152     quit_libJPEG;
6153   end;
6154 end;
6155
6156 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6158 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6159 var
6160   bmp: TBitmap;
6161   jpg: TJPEGImage;
6162   StreamPos: Int64;
6163   Temp: array[0..1]of Byte;
6164 begin
6165   result := false;
6166
6167   // reading first two bytes to test file and set cursor back to begin
6168   StreamPos := Stream.Position;
6169   Stream.Read(Temp[0], 2);
6170   Stream.Position := StreamPos;
6171
6172   // if Bitmap then read file.
6173   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6174     bmp := TBitmap.Create;
6175     try
6176       jpg := TJPEGImage.Create;
6177       try
6178         jpg.LoadFromStream(Stream);
6179         bmp.Assign(jpg);
6180         result := AssignFromBitmap(bmp);
6181       finally
6182         jpg.Free;
6183       end;
6184     finally
6185       bmp.Free;
6186     end;
6187   end;
6188 end;
6189 {$IFEND}
6190 {$ENDIF}
6191
6192 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6193 {$IF DEFINED(GLB_LIB_JPEG)}
6194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6195 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6196 var
6197   jpeg: jpeg_compress_struct;
6198   jpeg_err: jpeg_error_mgr;
6199   Row: Integer;
6200   pTemp, pTemp2: pByte;
6201
6202   procedure CopyRow(pDest, pSource: pByte);
6203   var
6204     X: Integer;
6205   begin
6206     for X := 0 to Width - 1 do begin
6207       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6208       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6209       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6210       Inc(pDest, 3);
6211       Inc(pSource, 3);
6212     end;
6213   end;
6214
6215 begin
6216   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6217     raise EglBitmapUnsupportedFormat.Create(Format);
6218
6219   if not init_libJPEG then
6220     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6221
6222   try
6223     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6224     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6225
6226     // error managment
6227     jpeg.err := jpeg_std_error(@jpeg_err);
6228     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6229     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6230
6231     // compression struct
6232     jpeg_create_compress(@jpeg);
6233
6234     // allocation space for streaming methods
6235     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6236
6237     // seeting up custom functions
6238     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6239       pub.init_destination    := glBitmap_libJPEG_init_destination;
6240       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6241       pub.term_destination    := glBitmap_libJPEG_term_destination;
6242
6243       pub.next_output_byte  := @DestBuffer[1];
6244       pub.free_in_buffer    := Length(DestBuffer);
6245
6246       DestStream := aStream;
6247     end;
6248
6249     // very important state
6250     jpeg.global_state := CSTATE_START;
6251     jpeg.image_width  := Width;
6252     jpeg.image_height := Height;
6253     case Format of
6254       tfAlpha8, tfLuminance8: begin
6255         jpeg.input_components := 1;
6256         jpeg.in_color_space   := JCS_GRAYSCALE;
6257       end;
6258       tfRGB8, tfBGR8: begin
6259         jpeg.input_components := 3;
6260         jpeg.in_color_space   := JCS_RGB;
6261       end;
6262     end;
6263
6264     jpeg_set_defaults(@jpeg);
6265     jpeg_set_quality(@jpeg, 95, true);
6266     jpeg_start_compress(@jpeg, true);
6267     pTemp := Data;
6268
6269     if Format = tfBGR8 then
6270       GetMem(pTemp2, fRowSize)
6271     else
6272       pTemp2 := pTemp;
6273
6274     try
6275       for Row := 0 to jpeg.image_height -1 do begin
6276         // prepare row
6277         if Format = tfBGR8 then
6278           CopyRow(pTemp2, pTemp)
6279         else
6280           pTemp2 := pTemp;
6281
6282         // write row
6283         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6284         inc(pTemp, fRowSize);
6285       end;
6286     finally
6287       // free memory
6288       if Format = tfBGR8 then
6289         FreeMem(pTemp2);
6290     end;
6291     jpeg_finish_compress(@jpeg);
6292     jpeg_destroy_compress(@jpeg);
6293   finally
6294     quit_libJPEG;
6295   end;
6296 end;
6297
6298 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6300 procedure TglBitmap.SaveJPEG(Stream: TStream);
6301 var
6302   Bmp: TBitmap;
6303   Jpg: TJPEGImage;
6304 begin
6305   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6306     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6307
6308   Bmp := TBitmap.Create;
6309   try
6310     Jpg := TJPEGImage.Create;
6311     try
6312       AssignToBitmap(Bmp);
6313       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6314         Jpg.Grayscale := true;
6315         Jpg.PixelFormat := jf8Bit;
6316       end;
6317       Jpg.Assign(Bmp);
6318       Jpg.SaveToStream(Stream);
6319     finally
6320       FreeAndNil(Jpg);
6321     end;
6322   finally
6323     FreeAndNil(Bmp);
6324   end;
6325 end;
6326 {$ENDIF}
6327 {$ENDIF}
6328
6329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6330 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6331 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6332 const
6333   BMP_MAGIC          = $4D42;
6334
6335   BMP_COMP_RGB       = 0;
6336   BMP_COMP_RLE8      = 1;
6337   BMP_COMP_RLE4      = 2;
6338   BMP_COMP_BITFIELDS = 3;
6339
6340 type
6341   TBMPHeader = packed record
6342     bfType: Word;
6343     bfSize: Cardinal;
6344     bfReserved1: Word;
6345     bfReserved2: Word;
6346     bfOffBits: Cardinal;
6347   end;
6348
6349   TBMPInfo = packed record
6350     biSize: Cardinal;
6351     biWidth: Longint;
6352     biHeight: Longint;
6353     biPlanes: Word;
6354     biBitCount: Word;
6355     biCompression: Cardinal;
6356     biSizeImage: Cardinal;
6357     biXPelsPerMeter: Longint;
6358     biYPelsPerMeter: Longint;
6359     biClrUsed: Cardinal;
6360     biClrImportant: Cardinal;
6361   end;
6362
6363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6364 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6365
6366   //////////////////////////////////////////////////////////////////////////////////////////////////
6367   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6368   begin
6369     result := tfEmpty;
6370     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6371     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6372
6373     //Read Compression
6374     case aInfo.biCompression of
6375       BMP_COMP_RLE4,
6376       BMP_COMP_RLE8: begin
6377         raise EglBitmapException.Create('RLE compression is not supported');
6378       end;
6379       BMP_COMP_BITFIELDS: begin
6380         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6381           aStream.Read(aMask.r, SizeOf(aMask.r));
6382           aStream.Read(aMask.g, SizeOf(aMask.g));
6383           aStream.Read(aMask.b, SizeOf(aMask.b));
6384           aStream.Read(aMask.a, SizeOf(aMask.a));
6385         end else
6386           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6387       end;
6388     end;
6389
6390     //get suitable format
6391     case aInfo.biBitCount of
6392        8: result := tfLuminance8;
6393       16: result := tfBGR5;
6394       24: result := tfBGR8;
6395       32: result := tfBGRA8;
6396     end;
6397   end;
6398
6399   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6400   var
6401     i, c: Integer;
6402     ColorTable: TbmpColorTable;
6403   begin
6404     result := nil;
6405     if (aInfo.biBitCount >= 16) then
6406       exit;
6407     aFormat := tfLuminance8;
6408     c := aInfo.biClrUsed;
6409     if (c = 0) then
6410       c := 1 shl aInfo.biBitCount;
6411     SetLength(ColorTable, c);
6412     for i := 0 to c-1 do begin
6413       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6414       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6415         aFormat := tfRGB8;
6416     end;
6417
6418     result := TbmpColorTableFormat.Create;
6419     result.PixelSize  := aInfo.biBitCount / 8;
6420     result.ColorTable := ColorTable;
6421     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6422   end;
6423
6424   //////////////////////////////////////////////////////////////////////////////////////////////////
6425   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6426     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6427   var
6428     TmpFormat: TglBitmapFormat;
6429     FormatDesc: TFormatDescriptor;
6430   begin
6431     result := nil;
6432     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6433       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6434         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6435         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6436           aFormat := FormatDesc.Format;
6437           exit;
6438         end;
6439       end;
6440
6441       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6442         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6443       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6444         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6445
6446       result := TbmpBitfieldFormat.Create;
6447       result.PixelSize := aInfo.biBitCount / 8;
6448       result.RedMask   := aMask.r;
6449       result.GreenMask := aMask.g;
6450       result.BlueMask  := aMask.b;
6451       result.AlphaMask := aMask.a;
6452     end;
6453   end;
6454
6455 var
6456   //simple types
6457   StartPos: Int64;
6458   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6459   PaddingBuff: Cardinal;
6460   LineBuf, ImageData, TmpData: PByte;
6461   SourceMD, DestMD: Pointer;
6462   BmpFormat: TglBitmapFormat;
6463
6464   //records
6465   Mask: TglBitmapColorRec;
6466   Header: TBMPHeader;
6467   Info: TBMPInfo;
6468
6469   //classes
6470   SpecialFormat: TFormatDescriptor;
6471   FormatDesc: TFormatDescriptor;
6472
6473   //////////////////////////////////////////////////////////////////////////////////////////////////
6474   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6475   var
6476     i: Integer;
6477     Pixel: TglBitmapPixelData;
6478   begin
6479     aStream.Read(aLineBuf^, rbLineSize);
6480     SpecialFormat.PreparePixel(Pixel);
6481     for i := 0 to Info.biWidth-1 do begin
6482       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6483       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6484       FormatDesc.Map(Pixel, aData, DestMD);
6485     end;
6486   end;
6487
6488 begin
6489   result        := false;
6490   BmpFormat     := tfEmpty;
6491   SpecialFormat := nil;
6492   LineBuf       := nil;
6493   SourceMD      := nil;
6494   DestMD        := nil;
6495
6496   // Header
6497   StartPos := aStream.Position;
6498   aStream.Read(Header{%H-}, SizeOf(Header));
6499
6500   if Header.bfType = BMP_MAGIC then begin
6501     try try
6502       BmpFormat        := ReadInfo(Info, Mask);
6503       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6504       if not Assigned(SpecialFormat) then
6505         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6506       aStream.Position := StartPos + Header.bfOffBits;
6507
6508       if (BmpFormat <> tfEmpty) then begin
6509         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6510         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6511         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6512         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6513
6514         //get Memory
6515         DestMD    := FormatDesc.CreateMappingData;
6516         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6517         GetMem(ImageData, ImageSize);
6518         if Assigned(SpecialFormat) then begin
6519           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6520           SourceMD := SpecialFormat.CreateMappingData;
6521         end;
6522
6523         //read Data
6524         try try
6525           FillChar(ImageData^, ImageSize, $FF);
6526           TmpData := ImageData;
6527           if (Info.biHeight > 0) then
6528             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6529           for i := 0 to Abs(Info.biHeight)-1 do begin
6530             if Assigned(SpecialFormat) then
6531               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6532             else
6533               aStream.Read(TmpData^, wbLineSize);   //else only read data
6534             if (Info.biHeight > 0) then
6535               dec(TmpData, wbLineSize)
6536             else
6537               inc(TmpData, wbLineSize);
6538             aStream.Read(PaddingBuff{%H-}, Padding);
6539           end;
6540           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6541           result := true;
6542         finally
6543           if Assigned(LineBuf) then
6544             FreeMem(LineBuf);
6545           if Assigned(SourceMD) then
6546             SpecialFormat.FreeMappingData(SourceMD);
6547           FormatDesc.FreeMappingData(DestMD);
6548         end;
6549         except
6550           FreeMem(ImageData);
6551           raise;
6552         end;
6553       end else
6554         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6555     except
6556       aStream.Position := StartPos;
6557       raise;
6558     end;
6559     finally
6560       FreeAndNil(SpecialFormat);
6561     end;
6562   end
6563     else aStream.Position := StartPos;
6564 end;
6565
6566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6567 procedure TglBitmap.SaveBMP(const aStream: TStream);
6568 var
6569   Header: TBMPHeader;
6570   Info: TBMPInfo;
6571   Converter: TbmpColorTableFormat;
6572   FormatDesc: TFormatDescriptor;
6573   SourceFD, DestFD: Pointer;
6574   pData, srcData, dstData, ConvertBuffer: pByte;
6575
6576   Pixel: TglBitmapPixelData;
6577   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6578   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6579
6580   PaddingBuff: Cardinal;
6581
6582   function GetLineWidth : Integer;
6583   begin
6584     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6585   end;
6586
6587 begin
6588   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6589     raise EglBitmapUnsupportedFormat.Create(Format);
6590
6591   Converter  := nil;
6592   FormatDesc := TFormatDescriptor.Get(Format);
6593   ImageSize  := FormatDesc.GetSize(Dimension);
6594
6595   FillChar(Header{%H-}, SizeOf(Header), 0);
6596   Header.bfType      := BMP_MAGIC;
6597   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6598   Header.bfReserved1 := 0;
6599   Header.bfReserved2 := 0;
6600   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6601
6602   FillChar(Info{%H-}, SizeOf(Info), 0);
6603   Info.biSize        := SizeOf(Info);
6604   Info.biWidth       := Width;
6605   Info.biHeight      := Height;
6606   Info.biPlanes      := 1;
6607   Info.biCompression := BMP_COMP_RGB;
6608   Info.biSizeImage   := ImageSize;
6609
6610   try
6611     case Format of
6612       tfLuminance4: begin
6613         Info.biBitCount  := 4;
6614         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6615         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6616         Converter           := TbmpColorTableFormat.Create;
6617         Converter.PixelSize := 0.5;
6618         Converter.Format    := Format;
6619         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6620         Converter.CreateColorTable;
6621       end;
6622
6623       tfR3G3B2, tfLuminance8: begin
6624         Info.biBitCount  :=  8;
6625         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6626         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6627         Converter           := TbmpColorTableFormat.Create;
6628         Converter.PixelSize := 1;
6629         Converter.Format    := Format;
6630         if (Format = tfR3G3B2) then begin
6631           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6632           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6633         end else
6634           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6635         Converter.CreateColorTable;
6636       end;
6637
6638       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6639       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6640         Info.biBitCount    := 16;
6641         Info.biCompression := BMP_COMP_BITFIELDS;
6642       end;
6643
6644       tfBGR8, tfRGB8: begin
6645         Info.biBitCount := 24;
6646       end;
6647
6648       tfRGB10, tfRGB10A2, tfRGBA8,
6649       tfBGR10, tfBGR10A2, tfBGRA8: begin
6650         Info.biBitCount    := 32;
6651         Info.biCompression := BMP_COMP_BITFIELDS;
6652       end;
6653     else
6654       raise EglBitmapUnsupportedFormat.Create(Format);
6655     end;
6656     Info.biXPelsPerMeter := 2835;
6657     Info.biYPelsPerMeter := 2835;
6658
6659     // prepare bitmasks
6660     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6661       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6662       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6663
6664       RedMask    := FormatDesc.RedMask;
6665       GreenMask  := FormatDesc.GreenMask;
6666       BlueMask   := FormatDesc.BlueMask;
6667       AlphaMask  := FormatDesc.AlphaMask;
6668     end;
6669
6670     // headers
6671     aStream.Write(Header, SizeOf(Header));
6672     aStream.Write(Info, SizeOf(Info));
6673
6674     // colortable
6675     if Assigned(Converter) then
6676       aStream.Write(Converter.ColorTable[0].b,
6677         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6678
6679     // bitmasks
6680     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6681       aStream.Write(RedMask,   SizeOf(Cardinal));
6682       aStream.Write(GreenMask, SizeOf(Cardinal));
6683       aStream.Write(BlueMask,  SizeOf(Cardinal));
6684       aStream.Write(AlphaMask, SizeOf(Cardinal));
6685     end;
6686
6687     // image data
6688     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6689     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6690     Padding     := GetLineWidth - wbLineSize;
6691     PaddingBuff := 0;
6692
6693     pData := Data;
6694     inc(pData, (Height-1) * rbLineSize);
6695
6696     // prepare row buffer. But only for RGB because RGBA supports color masks
6697     // so it's possible to change color within the image.
6698     if Assigned(Converter) then begin
6699       FormatDesc.PreparePixel(Pixel);
6700       GetMem(ConvertBuffer, wbLineSize);
6701       SourceFD := FormatDesc.CreateMappingData;
6702       DestFD   := Converter.CreateMappingData;
6703     end else
6704       ConvertBuffer := nil;
6705
6706     try
6707       for LineIdx := 0 to Height - 1 do begin
6708         // preparing row
6709         if Assigned(Converter) then begin
6710           srcData := pData;
6711           dstData := ConvertBuffer;
6712           for PixelIdx := 0 to Info.biWidth-1 do begin
6713             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6714             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6715             Converter.Map(Pixel, dstData, DestFD);
6716           end;
6717           aStream.Write(ConvertBuffer^, wbLineSize);
6718         end else begin
6719           aStream.Write(pData^, rbLineSize);
6720         end;
6721         dec(pData, rbLineSize);
6722         if (Padding > 0) then
6723           aStream.Write(PaddingBuff, Padding);
6724       end;
6725     finally
6726       // destroy row buffer
6727       if Assigned(ConvertBuffer) then begin
6728         FormatDesc.FreeMappingData(SourceFD);
6729         Converter.FreeMappingData(DestFD);
6730         FreeMem(ConvertBuffer);
6731       end;
6732     end;
6733   finally
6734     if Assigned(Converter) then
6735       Converter.Free;
6736   end;
6737 end;
6738
6739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6740 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6742 type
6743   TTGAHeader = packed record
6744     ImageID: Byte;
6745     ColorMapType: Byte;
6746     ImageType: Byte;
6747     //ColorMapSpec: Array[0..4] of Byte;
6748     ColorMapStart: Word;
6749     ColorMapLength: Word;
6750     ColorMapEntrySize: Byte;
6751     OrigX: Word;
6752     OrigY: Word;
6753     Width: Word;
6754     Height: Word;
6755     Bpp: Byte;
6756     ImageDesc: Byte;
6757   end;
6758
6759 const
6760   TGA_UNCOMPRESSED_RGB  =  2;
6761   TGA_UNCOMPRESSED_GRAY =  3;
6762   TGA_COMPRESSED_RGB    = 10;
6763   TGA_COMPRESSED_GRAY   = 11;
6764
6765   TGA_NONE_COLOR_TABLE  = 0;
6766
6767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6768 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6769 var
6770   Header: TTGAHeader;
6771   ImageData: System.PByte;
6772   StartPosition: Int64;
6773   PixelSize, LineSize: Integer;
6774   tgaFormat: TglBitmapFormat;
6775   FormatDesc: TFormatDescriptor;
6776   Counter: packed record
6777     X, Y: packed record
6778       low, high, dir: Integer;
6779     end;
6780   end;
6781
6782 const
6783   CACHE_SIZE = $4000;
6784
6785   ////////////////////////////////////////////////////////////////////////////////////////
6786   procedure ReadUncompressed;
6787   var
6788     i, j: Integer;
6789     buf, tmp1, tmp2: System.PByte;
6790   begin
6791     buf := nil;
6792     if (Counter.X.dir < 0) then
6793       buf := GetMem(LineSize);
6794     try
6795       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6796         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6797         if (Counter.X.dir < 0) then begin               //flip X
6798           aStream.Read(buf^, LineSize);
6799           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6800           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6801             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6802               tmp1^ := tmp2^;
6803               inc(tmp1);
6804               inc(tmp2);
6805             end;
6806             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6807           end;
6808         end else
6809           aStream.Read(tmp1^, LineSize);
6810         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6811       end;
6812     finally
6813       if Assigned(buf) then
6814         FreeMem(buf);
6815     end;
6816   end;
6817
6818   ////////////////////////////////////////////////////////////////////////////////////////
6819   procedure ReadCompressed;
6820
6821     /////////////////////////////////////////////////////////////////
6822     var
6823       TmpData: System.PByte;
6824       LinePixelsRead: Integer;
6825     procedure CheckLine;
6826     begin
6827       if (LinePixelsRead >= Header.Width) then begin
6828         LinePixelsRead := 0;
6829         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6830         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6831         if (Counter.X.dir < 0) then                       //if x flipped then
6832           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6833       end;
6834     end;
6835
6836     /////////////////////////////////////////////////////////////////
6837     var
6838       Cache: PByte;
6839       CacheSize, CachePos: Integer;
6840     procedure CachedRead(out Buffer; Count: Integer);
6841     var
6842       BytesRead: Integer;
6843     begin
6844       if (CachePos + Count > CacheSize) then begin
6845         //if buffer overflow save non read bytes
6846         BytesRead := 0;
6847         if (CacheSize - CachePos > 0) then begin
6848           BytesRead := CacheSize - CachePos;
6849           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6850           inc(CachePos, BytesRead);
6851         end;
6852
6853         //load cache from file
6854         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6855         aStream.Read(Cache^, CacheSize);
6856         CachePos := 0;
6857
6858         //read rest of requested bytes
6859         if (Count - BytesRead > 0) then begin
6860           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6861           inc(CachePos, Count - BytesRead);
6862         end;
6863       end else begin
6864         //if no buffer overflow just read the data
6865         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6866         inc(CachePos, Count);
6867       end;
6868     end;
6869
6870     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6871     begin
6872       case PixelSize of
6873         1: begin
6874           aBuffer^ := aData^;
6875           inc(aBuffer, Counter.X.dir);
6876         end;
6877         2: begin
6878           PWord(aBuffer)^ := PWord(aData)^;
6879           inc(aBuffer, 2 * Counter.X.dir);
6880         end;
6881         3: begin
6882           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6883           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6884           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6885           inc(aBuffer, 3 * Counter.X.dir);
6886         end;
6887         4: begin
6888           PCardinal(aBuffer)^ := PCardinal(aData)^;
6889           inc(aBuffer, 4 * Counter.X.dir);
6890         end;
6891       end;
6892     end;
6893
6894   var
6895     TotalPixelsToRead, TotalPixelsRead: Integer;
6896     Temp: Byte;
6897     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6898     PixelRepeat: Boolean;
6899     PixelsToRead, PixelCount: Integer;
6900   begin
6901     CacheSize := 0;
6902     CachePos  := 0;
6903
6904     TotalPixelsToRead := Header.Width * Header.Height;
6905     TotalPixelsRead   := 0;
6906     LinePixelsRead    := 0;
6907
6908     GetMem(Cache, CACHE_SIZE);
6909     try
6910       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6911       if (Counter.X.dir < 0) then                       //if x flipped then
6912         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6913
6914       repeat
6915         //read CommandByte
6916         CachedRead(Temp, 1);
6917         PixelRepeat  := (Temp and $80) > 0;
6918         PixelsToRead := (Temp and $7F) + 1;
6919         inc(TotalPixelsRead, PixelsToRead);
6920
6921         if PixelRepeat then
6922           CachedRead(buf[0], PixelSize);
6923         while (PixelsToRead > 0) do begin
6924           CheckLine;
6925           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6926           while (PixelCount > 0) do begin
6927             if not PixelRepeat then
6928               CachedRead(buf[0], PixelSize);
6929             PixelToBuffer(@buf[0], TmpData);
6930             inc(LinePixelsRead);
6931             dec(PixelsToRead);
6932             dec(PixelCount);
6933           end;
6934         end;
6935       until (TotalPixelsRead >= TotalPixelsToRead);
6936     finally
6937       FreeMem(Cache);
6938     end;
6939   end;
6940
6941   function IsGrayFormat: Boolean;
6942   begin
6943     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6944   end;
6945
6946 begin
6947   result := false;
6948
6949   // reading header to test file and set cursor back to begin
6950   StartPosition := aStream.Position;
6951   aStream.Read(Header{%H-}, SizeOf(Header));
6952
6953   // no colormapped files
6954   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6955     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6956   begin
6957     try
6958       if Header.ImageID <> 0 then       // skip image ID
6959         aStream.Position := aStream.Position + Header.ImageID;
6960
6961       case Header.Bpp of
6962          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6963                0: tgaFormat := tfLuminance8;
6964                8: tgaFormat := tfAlpha8;
6965             end;
6966
6967         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6968                0: tgaFormat := tfLuminance16;
6969                8: tgaFormat := tfLuminance8Alpha8;
6970             end else case (Header.ImageDesc and $F) of
6971                0: tgaFormat := tfBGR5;
6972                1: tgaFormat := tfBGR5A1;
6973                4: tgaFormat := tfBGRA4;
6974             end;
6975
6976         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6977                0: tgaFormat := tfBGR8;
6978             end;
6979
6980         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6981                2: tgaFormat := tfBGR10A2;
6982                8: tgaFormat := tfBGRA8;
6983             end;
6984       end;
6985
6986       if (tgaFormat = tfEmpty) then
6987         raise EglBitmapException.Create('LoadTga - unsupported format');
6988
6989       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6990       PixelSize  := FormatDesc.GetSize(1, 1);
6991       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6992
6993       GetMem(ImageData, LineSize * Header.Height);
6994       try
6995         //column direction
6996         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6997           Counter.X.low  := Header.Height-1;;
6998           Counter.X.high := 0;
6999           Counter.X.dir  := -1;
7000         end else begin
7001           Counter.X.low  := 0;
7002           Counter.X.high := Header.Height-1;
7003           Counter.X.dir  := 1;
7004         end;
7005
7006         // Row direction
7007         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7008           Counter.Y.low  := 0;
7009           Counter.Y.high := Header.Height-1;
7010           Counter.Y.dir  := 1;
7011         end else begin
7012           Counter.Y.low  := Header.Height-1;;
7013           Counter.Y.high := 0;
7014           Counter.Y.dir  := -1;
7015         end;
7016
7017         // Read Image
7018         case Header.ImageType of
7019           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7020             ReadUncompressed;
7021           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7022             ReadCompressed;
7023         end;
7024
7025         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7026         result := true;
7027       except
7028         FreeMem(ImageData);
7029         raise;
7030       end;
7031     finally
7032       aStream.Position := StartPosition;
7033     end;
7034   end
7035     else aStream.Position := StartPosition;
7036 end;
7037
7038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7039 procedure TglBitmap.SaveTGA(const aStream: TStream);
7040 var
7041   Header: TTGAHeader;
7042   LineSize, Size, x, y: Integer;
7043   Pixel: TglBitmapPixelData;
7044   LineBuf, SourceData, DestData: PByte;
7045   SourceMD, DestMD: Pointer;
7046   FormatDesc: TFormatDescriptor;
7047   Converter: TFormatDescriptor;
7048 begin
7049   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7050     raise EglBitmapUnsupportedFormat.Create(Format);
7051
7052   //prepare header
7053   FillChar(Header{%H-}, SizeOf(Header), 0);
7054
7055   //set ImageType
7056   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7057                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7058     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7059   else
7060     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7061
7062   //set BitsPerPixel
7063   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7064     Header.Bpp := 8
7065   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7066                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7067     Header.Bpp := 16
7068   else if (Format in [tfBGR8, tfRGB8]) then
7069     Header.Bpp := 24
7070   else
7071     Header.Bpp := 32;
7072
7073   //set AlphaBitCount
7074   case Format of
7075     tfRGB5A1, tfBGR5A1:
7076       Header.ImageDesc := 1 and $F;
7077     tfRGB10A2, tfBGR10A2:
7078       Header.ImageDesc := 2 and $F;
7079     tfRGBA4, tfBGRA4:
7080       Header.ImageDesc := 4 and $F;
7081     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7082       Header.ImageDesc := 8 and $F;
7083   end;
7084
7085   Header.Width     := Width;
7086   Header.Height    := Height;
7087   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7088   aStream.Write(Header, SizeOf(Header));
7089
7090   // convert RGB(A) to BGR(A)
7091   Converter  := nil;
7092   FormatDesc := TFormatDescriptor.Get(Format);
7093   Size       := FormatDesc.GetSize(Dimension);
7094   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7095     if (FormatDesc.RGBInverted = tfEmpty) then
7096       raise EglBitmapException.Create('inverted RGB format is empty');
7097     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7098     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7099        (Converter.PixelSize <> FormatDesc.PixelSize) then
7100       raise EglBitmapException.Create('invalid inverted RGB format');
7101   end;
7102
7103   if Assigned(Converter) then begin
7104     LineSize := FormatDesc.GetSize(Width, 1);
7105     LineBuf  := GetMem(LineSize);
7106     SourceMD := FormatDesc.CreateMappingData;
7107     DestMD   := Converter.CreateMappingData;
7108     try
7109       SourceData := Data;
7110       for y := 0 to Height-1 do begin
7111         DestData := LineBuf;
7112         for x := 0 to Width-1 do begin
7113           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7114           Converter.Map(Pixel, DestData, DestMD);
7115         end;
7116         aStream.Write(LineBuf^, LineSize);
7117       end;
7118     finally
7119       FreeMem(LineBuf);
7120       FormatDesc.FreeMappingData(SourceMD);
7121       FormatDesc.FreeMappingData(DestMD);
7122     end;
7123   end else
7124     aStream.Write(Data^, Size);
7125 end;
7126
7127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7128 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7130 const
7131   DDS_MAGIC: Cardinal         = $20534444;
7132
7133   // DDS_header.dwFlags
7134   DDSD_CAPS                   = $00000001;
7135   DDSD_HEIGHT                 = $00000002;
7136   DDSD_WIDTH                  = $00000004;
7137   DDSD_PIXELFORMAT            = $00001000;
7138
7139   // DDS_header.sPixelFormat.dwFlags
7140   DDPF_ALPHAPIXELS            = $00000001;
7141   DDPF_ALPHA                  = $00000002;
7142   DDPF_FOURCC                 = $00000004;
7143   DDPF_RGB                    = $00000040;
7144   DDPF_LUMINANCE              = $00020000;
7145
7146   // DDS_header.sCaps.dwCaps1
7147   DDSCAPS_TEXTURE             = $00001000;
7148
7149   // DDS_header.sCaps.dwCaps2
7150   DDSCAPS2_CUBEMAP            = $00000200;
7151
7152   D3DFMT_DXT1                 = $31545844;
7153   D3DFMT_DXT3                 = $33545844;
7154   D3DFMT_DXT5                 = $35545844;
7155
7156 type
7157   TDDSPixelFormat = packed record
7158     dwSize: Cardinal;
7159     dwFlags: Cardinal;
7160     dwFourCC: Cardinal;
7161     dwRGBBitCount: Cardinal;
7162     dwRBitMask: Cardinal;
7163     dwGBitMask: Cardinal;
7164     dwBBitMask: Cardinal;
7165     dwABitMask: Cardinal;
7166   end;
7167
7168   TDDSCaps = packed record
7169     dwCaps1: Cardinal;
7170     dwCaps2: Cardinal;
7171     dwDDSX: Cardinal;
7172     dwReserved: Cardinal;
7173   end;
7174
7175   TDDSHeader = packed record
7176     dwSize: Cardinal;
7177     dwFlags: Cardinal;
7178     dwHeight: Cardinal;
7179     dwWidth: Cardinal;
7180     dwPitchOrLinearSize: Cardinal;
7181     dwDepth: Cardinal;
7182     dwMipMapCount: Cardinal;
7183     dwReserved: array[0..10] of Cardinal;
7184     PixelFormat: TDDSPixelFormat;
7185     Caps: TDDSCaps;
7186     dwReserved2: Cardinal;
7187   end;
7188
7189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7190 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7191 var
7192   Header: TDDSHeader;
7193   Converter: TbmpBitfieldFormat;
7194
7195   function GetDDSFormat: TglBitmapFormat;
7196   var
7197     fd: TFormatDescriptor;
7198     i: Integer;
7199     Range: TglBitmapColorRec;
7200     match: Boolean;
7201   begin
7202     result := tfEmpty;
7203     with Header.PixelFormat do begin
7204       // Compresses
7205       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7206         case Header.PixelFormat.dwFourCC of
7207           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7208           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7209           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7210         end;
7211       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7212
7213         //find matching format
7214         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7215           fd := TFormatDescriptor.Get(result);
7216           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7217              (8 * fd.PixelSize = dwRGBBitCount) then
7218             exit;
7219         end;
7220
7221         //find format with same Range
7222         Range.r := dwRBitMask;
7223         Range.g := dwGBitMask;
7224         Range.b := dwBBitMask;
7225         Range.a := dwABitMask;
7226         for i := 0 to 3 do begin
7227           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7228             Range.arr[i] := Range.arr[i] shr 1;
7229         end;
7230         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7231           fd := TFormatDescriptor.Get(result);
7232           match := true;
7233           for i := 0 to 3 do
7234             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7235               match := false;
7236               break;
7237             end;
7238           if match then
7239             break;
7240         end;
7241
7242         //no format with same range found -> use default
7243         if (result = tfEmpty) then begin
7244           if (dwABitMask > 0) then
7245             result := tfBGRA8
7246           else
7247             result := tfBGR8;
7248         end;
7249
7250         Converter := TbmpBitfieldFormat.Create;
7251         Converter.RedMask   := dwRBitMask;
7252         Converter.GreenMask := dwGBitMask;
7253         Converter.BlueMask  := dwBBitMask;
7254         Converter.AlphaMask := dwABitMask;
7255         Converter.PixelSize := dwRGBBitCount / 8;
7256       end;
7257     end;
7258   end;
7259
7260 var
7261   StreamPos: Int64;
7262   x, y, LineSize, RowSize, Magic: Cardinal;
7263   NewImage, TmpData, RowData, SrcData: System.PByte;
7264   SourceMD, DestMD: Pointer;
7265   Pixel: TglBitmapPixelData;
7266   ddsFormat: TglBitmapFormat;
7267   FormatDesc: TFormatDescriptor;
7268
7269 begin
7270   result    := false;
7271   Converter := nil;
7272   StreamPos := aStream.Position;
7273
7274   // Magic
7275   aStream.Read(Magic{%H-}, sizeof(Magic));
7276   if (Magic <> DDS_MAGIC) then begin
7277     aStream.Position := StreamPos;
7278     exit;
7279   end;
7280
7281   //Header
7282   aStream.Read(Header{%H-}, sizeof(Header));
7283   if (Header.dwSize <> SizeOf(Header)) or
7284      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7285         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7286   begin
7287     aStream.Position := StreamPos;
7288     exit;
7289   end;
7290
7291   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7292     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7293
7294   ddsFormat := GetDDSFormat;
7295   try
7296     if (ddsFormat = tfEmpty) then
7297       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7298
7299     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7300     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7301     GetMem(NewImage, Header.dwHeight * LineSize);
7302     try
7303       TmpData := NewImage;
7304
7305       //Converter needed
7306       if Assigned(Converter) then begin
7307         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7308         GetMem(RowData, RowSize);
7309         SourceMD := Converter.CreateMappingData;
7310         DestMD   := FormatDesc.CreateMappingData;
7311         try
7312           for y := 0 to Header.dwHeight-1 do begin
7313             TmpData := NewImage + y * LineSize;
7314             SrcData := RowData;
7315             aStream.Read(SrcData^, RowSize);
7316             for x := 0 to Header.dwWidth-1 do begin
7317               Converter.Unmap(SrcData, Pixel, SourceMD);
7318               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7319               FormatDesc.Map(Pixel, TmpData, DestMD);
7320             end;
7321           end;
7322         finally
7323           Converter.FreeMappingData(SourceMD);
7324           FormatDesc.FreeMappingData(DestMD);
7325           FreeMem(RowData);
7326         end;
7327       end else
7328
7329       // Compressed
7330       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7331         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7332         for Y := 0 to Header.dwHeight-1 do begin
7333           aStream.Read(TmpData^, RowSize);
7334           Inc(TmpData, LineSize);
7335         end;
7336       end else
7337
7338       // Uncompressed
7339       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7340         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7341         for Y := 0 to Header.dwHeight-1 do begin
7342           aStream.Read(TmpData^, RowSize);
7343           Inc(TmpData, LineSize);
7344         end;
7345       end else
7346         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7347
7348       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7349       result := true;
7350     except
7351       FreeMem(NewImage);
7352       raise;
7353     end;
7354   finally
7355     FreeAndNil(Converter);
7356   end;
7357 end;
7358
7359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7360 procedure TglBitmap.SaveDDS(const aStream: TStream);
7361 var
7362   Header: TDDSHeader;
7363   FormatDesc: TFormatDescriptor;
7364 begin
7365   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7366     raise EglBitmapUnsupportedFormat.Create(Format);
7367
7368   FormatDesc := TFormatDescriptor.Get(Format);
7369
7370   // Generell
7371   FillChar(Header{%H-}, SizeOf(Header), 0);
7372   Header.dwSize  := SizeOf(Header);
7373   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7374
7375   Header.dwWidth  := Max(1, Width);
7376   Header.dwHeight := Max(1, Height);
7377
7378   // Caps
7379   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7380
7381   // Pixelformat
7382   Header.PixelFormat.dwSize := sizeof(Header);
7383   if (FormatDesc.IsCompressed) then begin
7384     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7385     case Format of
7386       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7387       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7388       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7389     end;
7390   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7391     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7392     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7393     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7394   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7395     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7396     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7397     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7398     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7399   end else begin
7400     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7401     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7402     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7403     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7404     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7405     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7406   end;
7407
7408   if (FormatDesc.HasAlpha) then
7409     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7410
7411   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7412   aStream.Write(Header, SizeOf(Header));
7413   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7414 end;
7415
7416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7417 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7419 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7420 begin
7421   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7422     result := fLines[aIndex]
7423   else
7424     result := nil;
7425 end;
7426
7427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7428 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7429   const aWidth: Integer; const aHeight: Integer);
7430 var
7431   Idx, LineWidth: Integer;
7432 begin
7433   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7434
7435   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7436     (* TODO PixelFuncs
7437     fGetPixelFunc := GetPixel2DUnmap;
7438     fSetPixelFunc := SetPixel2DUnmap;
7439     *)
7440     // Assigning Data
7441     if Assigned(Data) then begin
7442       SetLength(fLines, GetHeight);
7443       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7444
7445       for Idx := 0 to GetHeight -1 do begin
7446         fLines[Idx] := Data;
7447         Inc(fLines[Idx], Idx * LineWidth);
7448       end;
7449     end
7450       else SetLength(fLines, 0);
7451   end else begin
7452     SetLength(fLines, 0);
7453     (*
7454     fSetPixelFunc := nil;
7455
7456     case Format of
7457       ifDXT1:
7458         fGetPixelFunc := GetPixel2DDXT1;
7459       ifDXT3:
7460         fGetPixelFunc := GetPixel2DDXT3;
7461       ifDXT5:
7462         fGetPixelFunc := GetPixel2DDXT5;
7463       else
7464         fGetPixelFunc := nil;
7465     end;
7466     *)
7467   end;
7468 end;
7469
7470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7471 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7472 var
7473   FormatDesc: TFormatDescriptor;
7474 begin
7475   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7476
7477   FormatDesc := TFormatDescriptor.Get(Format);
7478   if FormatDesc.IsCompressed then begin
7479     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7480   end else if aBuildWithGlu then begin
7481     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7482       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7483   end else begin
7484     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7485       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7486   end;
7487
7488   // Freigeben
7489   if (FreeDataAfterGenTexture) then
7490     FreeData;
7491 end;
7492
7493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7494 procedure TglBitmap2D.AfterConstruction;
7495 begin
7496   inherited;
7497   Target := GL_TEXTURE_2D;
7498 end;
7499
7500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7501 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7502 var
7503   Temp: pByte;
7504   Size, w, h: Integer;
7505   FormatDesc: TFormatDescriptor;
7506 begin
7507   FormatDesc := TFormatDescriptor.Get(Format);
7508   if FormatDesc.IsCompressed then
7509     raise EglBitmapUnsupportedFormat.Create(Format);
7510
7511   w    := aRight  - aLeft;
7512   h    := aBottom - aTop;
7513   Size := FormatDesc.GetSize(w, h);
7514   GetMem(Temp, Size);
7515   try
7516     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7517     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7518     SetDataPointer(Temp, Format, w, h);
7519     FlipVert;
7520   except
7521     FreeMem(Temp);
7522     raise;
7523   end;
7524 end;
7525
7526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7527 procedure TglBitmap2D.GetDataFromTexture;
7528 var
7529   Temp: PByte;
7530   TempWidth, TempHeight: Integer;
7531   TempIntFormat: Cardinal;
7532   IntFormat, f: TglBitmapFormat;
7533   FormatDesc: TFormatDescriptor;
7534 begin
7535   Bind;
7536
7537   // Request Data
7538   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7539   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7540   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7541
7542   IntFormat := tfEmpty;
7543   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7544     FormatDesc := TFormatDescriptor.Get(f);
7545     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7546       IntFormat := FormatDesc.Format;
7547       break;
7548     end;
7549   end;
7550
7551   // Getting data from OpenGL
7552   FormatDesc := TFormatDescriptor.Get(IntFormat);
7553   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7554   try
7555     if FormatDesc.IsCompressed then
7556       glGetCompressedTexImage(Target, 0, Temp)
7557     else
7558      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7559     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7560   except
7561     FreeMem(Temp);
7562     raise;
7563   end;
7564 end;
7565
7566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7567 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7568 var
7569   BuildWithGlu, PotTex, TexRec: Boolean;
7570   TexSize: Integer;
7571 begin
7572   if Assigned(Data) then begin
7573     // Check Texture Size
7574     if (aTestTextureSize) then begin
7575       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7576
7577       if ((Height > TexSize) or (Width > TexSize)) then
7578         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7579
7580       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7581       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7582
7583       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7584         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7585     end;
7586
7587     CreateId;
7588     SetupParameters(BuildWithGlu);
7589     UploadData(Target, BuildWithGlu);
7590     glAreTexturesResident(1, @fID, @fIsResident);
7591   end;
7592 end;
7593
7594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7595 function TglBitmap2D.FlipHorz: Boolean;
7596 var
7597   Col, Row: Integer;
7598   TempDestData, DestData, SourceData: PByte;
7599   ImgSize: Integer;
7600 begin
7601   result := inherited FlipHorz;
7602   if Assigned(Data) then begin
7603     SourceData := Data;
7604     ImgSize := Height * fRowSize;
7605     GetMem(DestData, ImgSize);
7606     try
7607       TempDestData := DestData;
7608       Dec(TempDestData, fRowSize + fPixelSize);
7609       for Row := 0 to Height -1 do begin
7610         Inc(TempDestData, fRowSize * 2);
7611         for Col := 0 to Width -1 do begin
7612           Move(SourceData^, TempDestData^, fPixelSize);
7613           Inc(SourceData, fPixelSize);
7614           Dec(TempDestData, fPixelSize);
7615         end;
7616       end;
7617       SetDataPointer(DestData, Format);
7618       result := true;
7619     except
7620       FreeMem(DestData);
7621       raise;
7622     end;
7623   end;
7624 end;
7625
7626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7627 function TglBitmap2D.FlipVert: Boolean;
7628 var
7629   Row: Integer;
7630   TempDestData, DestData, SourceData: PByte;
7631 begin
7632   result := inherited FlipVert;
7633   if Assigned(Data) then begin
7634     SourceData := Data;
7635     GetMem(DestData, Height * fRowSize);
7636     try
7637       TempDestData := DestData;
7638       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7639       for Row := 0 to Height -1 do begin
7640         Move(SourceData^, TempDestData^, fRowSize);
7641         Dec(TempDestData, fRowSize);
7642         Inc(SourceData, fRowSize);
7643       end;
7644       SetDataPointer(DestData, Format);
7645       result := true;
7646     except
7647       FreeMem(DestData);
7648       raise;
7649     end;
7650   end;
7651 end;
7652
7653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7654 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7656 type
7657   TMatrixItem = record
7658     X, Y: Integer;
7659     W: Single;
7660   end;
7661
7662   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7663   TglBitmapToNormalMapRec = Record
7664     Scale: Single;
7665     Heights: array of Single;
7666     MatrixU : array of TMatrixItem;
7667     MatrixV : array of TMatrixItem;
7668   end;
7669
7670 const
7671   ONE_OVER_255 = 1 / 255;
7672
7673   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7674 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7675 var
7676   Val: Single;
7677 begin
7678   with FuncRec do begin
7679     Val :=
7680       Source.Data.r * LUMINANCE_WEIGHT_R +
7681       Source.Data.g * LUMINANCE_WEIGHT_G +
7682       Source.Data.b * LUMINANCE_WEIGHT_B;
7683     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7684   end;
7685 end;
7686
7687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7688 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7689 begin
7690   with FuncRec do
7691     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7692 end;
7693
7694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7695 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7696 type
7697   TVec = Array[0..2] of Single;
7698 var
7699   Idx: Integer;
7700   du, dv: Double;
7701   Len: Single;
7702   Vec: TVec;
7703
7704   function GetHeight(X, Y: Integer): Single;
7705   begin
7706     with FuncRec do begin
7707       X := Max(0, Min(Size.X -1, X));
7708       Y := Max(0, Min(Size.Y -1, Y));
7709       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7710     end;
7711   end;
7712
7713 begin
7714   with FuncRec do begin
7715     with PglBitmapToNormalMapRec(Args)^ do begin
7716       du := 0;
7717       for Idx := Low(MatrixU) to High(MatrixU) do
7718         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7719
7720       dv := 0;
7721       for Idx := Low(MatrixU) to High(MatrixU) do
7722         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7723
7724       Vec[0] := -du * Scale;
7725       Vec[1] := -dv * Scale;
7726       Vec[2] := 1;
7727     end;
7728
7729     // Normalize
7730     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7731     if Len <> 0 then begin
7732       Vec[0] := Vec[0] * Len;
7733       Vec[1] := Vec[1] * Len;
7734       Vec[2] := Vec[2] * Len;
7735     end;
7736
7737     // Farbe zuweisem
7738     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7739     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7740     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7741   end;
7742 end;
7743
7744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7745 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7746 var
7747   Rec: TglBitmapToNormalMapRec;
7748
7749   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7750   begin
7751     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7752       Matrix[Index].X := X;
7753       Matrix[Index].Y := Y;
7754       Matrix[Index].W := W;
7755     end;
7756   end;
7757
7758 begin
7759   if TFormatDescriptor.Get(Format).IsCompressed then
7760     raise EglBitmapUnsupportedFormat.Create(Format);
7761
7762   if aScale > 100 then
7763     Rec.Scale := 100
7764   else if aScale < -100 then
7765     Rec.Scale := -100
7766   else
7767     Rec.Scale := aScale;
7768
7769   SetLength(Rec.Heights, Width * Height);
7770   try
7771     case aFunc of
7772       nm4Samples: begin
7773         SetLength(Rec.MatrixU, 2);
7774         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7775         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7776
7777         SetLength(Rec.MatrixV, 2);
7778         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7779         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7780       end;
7781
7782       nmSobel: begin
7783         SetLength(Rec.MatrixU, 6);
7784         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7785         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7786         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7787         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7788         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7789         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7790
7791         SetLength(Rec.MatrixV, 6);
7792         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7793         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7794         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7795         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7796         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7797         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7798       end;
7799
7800       nm3x3: begin
7801         SetLength(Rec.MatrixU, 6);
7802         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7803         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7804         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7805         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7806         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7807         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7808
7809         SetLength(Rec.MatrixV, 6);
7810         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7811         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7812         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7813         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7814         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7815         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7816       end;
7817
7818       nm5x5: begin
7819         SetLength(Rec.MatrixU, 20);
7820         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7821         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7822         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7823         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7824         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7825         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7826         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7827         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7828         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7829         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7830         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7831         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7832         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7833         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7834         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7835         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7836         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7837         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7838         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7839         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7840
7841         SetLength(Rec.MatrixV, 20);
7842         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7843         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7844         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7845         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7846         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7847         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7848         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7849         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7850         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7851         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7852         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7853         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7854         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7855         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7856         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7857         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7858         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7859         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7860         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7861         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7862       end;
7863     end;
7864
7865     // Daten Sammeln
7866     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7867       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7868     else
7869       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7870     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7871   finally
7872     SetLength(Rec.Heights, 0);
7873   end;
7874 end;
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884 (*
7885 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7886 var
7887   pTemp: pByte;
7888   Size: Integer;
7889 begin
7890   if Height > 1 then begin
7891     // extract first line of the data
7892     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7893     GetMem(pTemp, Size);
7894
7895     Move(Data^, pTemp^, Size);
7896
7897     FreeMem(Data);
7898   end else
7899     pTemp := Data;
7900
7901   // set data pointer
7902   inherited SetDataPointer(pTemp, Format, Width);
7903
7904   if FormatIsUncompressed(Format) then begin
7905     fUnmapFunc := FormatGetUnMapFunc(Format);
7906     fGetPixelFunc := GetPixel1DUnmap;
7907   end;
7908 end;
7909
7910
7911 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7912 var
7913   pTemp: pByte;
7914 begin
7915   pTemp := Data;
7916   Inc(pTemp, Pos.X * fPixelSize);
7917
7918   fUnmapFunc(pTemp, Pixel);
7919 end;
7920
7921
7922 function TglBitmap1D.FlipHorz: Boolean;
7923 var
7924   Col: Integer;
7925   pTempDest, pDest, pSource: pByte;
7926 begin
7927   result := inherited FlipHorz;
7928
7929   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7930     pSource := Data;
7931
7932     GetMem(pDest, fRowSize);
7933     try
7934       pTempDest := pDest;
7935
7936       Inc(pTempDest, fRowSize);
7937       for Col := 0 to Width -1 do begin
7938         Move(pSource^, pTempDest^, fPixelSize);
7939
7940         Inc(pSource, fPixelSize);
7941         Dec(pTempDest, fPixelSize);
7942       end;
7943
7944       SetDataPointer(pDest, InternalFormat);
7945
7946       result := true;
7947     finally
7948       FreeMem(pDest);
7949     end;
7950   end;
7951 end;
7952
7953
7954 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7955 begin
7956   // Upload data
7957   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7958     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7959   else
7960
7961   // Upload data
7962   if BuildWithGlu then
7963     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7964   else
7965     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7966
7967   // Freigeben
7968   if (FreeDataAfterGenTexture) then
7969     FreeData;
7970 end;
7971
7972
7973 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7974 var
7975   BuildWithGlu, TexRec: Boolean;
7976   glFormat, glInternalFormat, glType: Cardinal;
7977   TexSize: Integer;
7978 begin
7979   if Assigned(Data) then begin
7980     // Check Texture Size
7981     if (TestTextureSize) then begin
7982       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7983
7984       if (Width > TexSize) then
7985         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7986
7987       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7988                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7989
7990       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7991         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7992     end;
7993
7994     CreateId;
7995
7996     SetupParameters(BuildWithGlu);
7997     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7998
7999     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8000
8001     // Infos sammeln
8002     glAreTexturesResident(1, @fID, @fIsResident);
8003   end;
8004 end;
8005
8006
8007 procedure TglBitmap1D.AfterConstruction;
8008 begin
8009   inherited;
8010
8011   Target := GL_TEXTURE_1D;
8012 end;
8013
8014
8015 { TglBitmapCubeMap }
8016
8017 procedure TglBitmapCubeMap.AfterConstruction;
8018 begin
8019   inherited;
8020
8021   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8022     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8023
8024   SetWrap; // set all to GL_CLAMP_TO_EDGE
8025   Target := GL_TEXTURE_CUBE_MAP;
8026   fGenMode := GL_REFLECTION_MAP;
8027 end;
8028
8029
8030 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8031 begin
8032   inherited Bind (EnableTextureUnit);
8033
8034   if EnableTexCoordsGen then begin
8035     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8036     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8037     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8038     glEnable(GL_TEXTURE_GEN_S);
8039     glEnable(GL_TEXTURE_GEN_T);
8040     glEnable(GL_TEXTURE_GEN_R);
8041   end;
8042 end;
8043
8044
8045 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8046 var
8047   glFormat, glInternalFormat, glType: Cardinal;
8048   BuildWithGlu: Boolean;
8049   TexSize: Integer;
8050 begin
8051   // Check Texture Size
8052   if (TestTextureSize) then begin
8053     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8054
8055     if ((Height > TexSize) or (Width > TexSize)) then
8056       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8057
8058     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8059       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8060   end;
8061
8062   // create Texture
8063   if ID = 0 then begin
8064     CreateID;
8065     SetupParameters(BuildWithGlu);
8066   end;
8067
8068   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8069
8070   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8071 end;
8072
8073
8074 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8075 begin
8076   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8077 end;
8078
8079
8080 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8081   DisableTextureUnit: Boolean);
8082 begin
8083   inherited Unbind (DisableTextureUnit);
8084
8085   if DisableTexCoordsGen then begin
8086     glDisable(GL_TEXTURE_GEN_S);
8087     glDisable(GL_TEXTURE_GEN_T);
8088     glDisable(GL_TEXTURE_GEN_R);
8089   end;
8090 end;
8091
8092
8093 { TglBitmapNormalMap }
8094
8095 type
8096   TVec = Array[0..2] of Single;
8097   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8098
8099   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8100   TglBitmapNormalMapRec = record
8101     HalfSize : Integer;
8102     Func: TglBitmapNormalMapGetVectorFunc;
8103   end;
8104
8105
8106 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8107 begin
8108   Vec[0] := HalfSize;
8109   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8110   Vec[2] := - (Position.X + 0.5 - HalfSize);
8111 end;
8112
8113
8114 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8115 begin
8116   Vec[0] := - HalfSize;
8117   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8118   Vec[2] := Position.X + 0.5 - HalfSize;
8119 end;
8120
8121
8122 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8123 begin
8124   Vec[0] := Position.X + 0.5 - HalfSize;
8125   Vec[1] := HalfSize;
8126   Vec[2] := Position.Y + 0.5 - HalfSize;
8127 end;
8128
8129
8130 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8131 begin
8132   Vec[0] := Position.X + 0.5 - HalfSize;
8133   Vec[1] := - HalfSize;
8134   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8135 end;
8136
8137
8138 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8139 begin
8140   Vec[0] := Position.X + 0.5 - HalfSize;
8141   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8142   Vec[2] := HalfSize;
8143 end;
8144
8145
8146 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8147 begin
8148   Vec[0] := - (Position.X + 0.5 - HalfSize);
8149   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8150   Vec[2] := - HalfSize;
8151 end;
8152
8153
8154 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8155 var
8156   Vec : TVec;
8157   Len: Single;
8158 begin
8159   with FuncRec do begin
8160     with PglBitmapNormalMapRec (CustomData)^ do begin
8161       Func(Vec, Position, HalfSize);
8162
8163       // Normalize
8164       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8165       if Len <> 0 then begin
8166         Vec[0] := Vec[0] * Len;
8167         Vec[1] := Vec[1] * Len;
8168         Vec[2] := Vec[2] * Len;
8169       end;
8170
8171       // Scale Vector and AddVectro
8172       Vec[0] := Vec[0] * 0.5 + 0.5;
8173       Vec[1] := Vec[1] * 0.5 + 0.5;
8174       Vec[2] := Vec[2] * 0.5 + 0.5;
8175     end;
8176
8177     // Set Color
8178     Dest.Red   := Round(Vec[0] * 255);
8179     Dest.Green := Round(Vec[1] * 255);
8180     Dest.Blue  := Round(Vec[2] * 255);
8181   end;
8182 end;
8183
8184
8185 procedure TglBitmapNormalMap.AfterConstruction;
8186 begin
8187   inherited;
8188
8189   fGenMode := GL_NORMAL_MAP;
8190 end;
8191
8192
8193 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8194   TestTextureSize: Boolean);
8195 var
8196   Rec: TglBitmapNormalMapRec;
8197   SizeRec: TglBitmapPixelPosition;
8198 begin
8199   Rec.HalfSize := Size div 2;
8200
8201   FreeDataAfterGenTexture := false;
8202
8203   SizeRec.Fields := [ffX, ffY];
8204   SizeRec.X := Size;
8205   SizeRec.Y := Size;
8206
8207   // Positive X
8208   Rec.Func := glBitmapNormalMapPosX;
8209   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8210   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8211
8212   // Negative X
8213   Rec.Func := glBitmapNormalMapNegX;
8214   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8215   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8216
8217   // Positive Y
8218   Rec.Func := glBitmapNormalMapPosY;
8219   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8220   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8221
8222   // Negative Y
8223   Rec.Func := glBitmapNormalMapNegY;
8224   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8225   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8226
8227   // Positive Z
8228   Rec.Func := glBitmapNormalMapPosZ;
8229   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8230   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8231
8232   // Negative Z
8233   Rec.Func := glBitmapNormalMapNegZ;
8234   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8235   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8236 end;
8237 *)
8238
8239 initialization
8240   glBitmapSetDefaultFormat(tfEmpty);
8241   glBitmapSetDefaultMipmap(mmMipmap);
8242   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8243   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8244
8245   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8246   glBitmapSetDefaultDeleteTextureOnFree    (true);
8247
8248   TFormatDescriptor.Init;
8249
8250 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8251   OpenGLInitialized := false;
8252   InitOpenGLCS := TCriticalSection.Create;
8253 {$ENDIF}
8254
8255 finalization
8256   TFormatDescriptor.Finalize;
8257
8258 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8259   FreeAndNil(InitOpenGLCS);
8260 {$ENDIF}
8261
8262 end.
8263