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