glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4
   5 modified by Delphi OpenGL Community (http://delphigl.com/)
   6
   7 ------------------------------------------------------------
   8 The contents of this file are used with permission, subject to
   9 the Mozilla Public License Version 1.1 (the "License"); you may
  10 not use this file except in compliance with the License. You may
  11 obtain a copy of the License at
  12 http://www.mozilla.org/MPL/MPL-1.1.html
  13 ------------------------------------------------------------
  14 Version 2.0.3
  15 ------------------------------------------------------------
  16 History
  17 21-03-2010
  18 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19   then it's your problem if that isn't true. This prevents the unit for incompatibility
  20   with newer versions of Delphi.
  21 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23 10-08-2008
  24 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25 - Additional Datapointer for functioninterface now has the name CustomData
  26 24-07-2008
  27 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28 - If you load an texture from an file the property Filename will be set to the name of the file
  29 - Three new properties to attach custom data to the Texture objects
  30   - CustomName  (free for use string)
  31   - CustomNameW (free for use widestring)
  32   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33 27-05-2008
  34 - RLE TGAs loaded much faster
  35 26-05-2008
  36 - fixed some problem with reading RLE TGAs.
  37 21-05-2008
  38 - function clone now only copys data if it's assigned and now it also copies the ID
  39 - it seems that lazarus dont like comments in comments.
  40 01-05-2008
  41 - It's possible to set the id of the texture
  42 - define GLB_NO_NATIVE_GL deactivated by default
  43 27-04-2008
  44 - Now supports the following libraries
  45   - SDL and SDL_image
  46   - libPNG
  47   - libJPEG
  48 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49 - BMPs now loaded manuel
  50 - Large restructuring
  51 - Property DataPtr now has the name Data
  52 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53 - Unused Depth removed
  54 - Function FreeData to freeing image data added
  55 24-10-2007
  56 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57 15-11-2006
  58 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60 - Function ReadOpenGLExtension is now only intern
  61 29-06-2006
  62 - pngimage now disabled by default like all other versions.
  63 26-06-2006
  64 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65 22-06-2006
  66 - Fixed some Problem with Delphi 5
  67 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68 22-03-2006
  69 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70 09-03-2006
  71 - Internal Format ifDepth8 added
  72 - function GrabScreen now supports all uncompressed formats
  73 31-01-2006
  74 - AddAlphaFromglBitmap implemented
  75 29-12-2005
  76 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77 28-12-2005
  78 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79   property Width, Height, Depth are still existing and new property Dimension are avail
  80 11-12-2005
  81 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82 19-10-2005
  83 - Added function GrabScreen to class TglBitmap2D
  84 18-10-2005
  85 - Added support to Save images
  86 - Added function Clone to Clone Instance
  87 11-10-2005
  88 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89   Usefull for Future
  90 - Several speed optimizations
  91 09-10-2005
  92 - Internal structure change. Loading of TGA, PNG and DDS improved.
  93   Data, format and size will now set directly with SetDataPtr.
  94 - AddFunc now works with all Types of Images and Formats
  95 - Some Funtions moved to Baseclass TglBitmap
  96 06-10-2005
  97 - Added Support to decompress DXT3 and DXT5 compressed Images.
  98 - Added Mapping to convert data from one format into an other.
  99 05-10-2005
 100 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
 101   supported Input format (supported by GetPixel) into any uncompresed Format
 102 - Added Support to decompress DXT1 compressed Images.
 103 - SwapColors replaced by ConvertTo
 104 04-10-2005
 105 - Added Support for compressed DDSs
 106 - Added new internal formats (DXT1, DXT3, DXT5)
 107 29-09-2005
 108 - Parameter Components renamed to InternalFormat
 109 23-09-2005
 110 - Some AllocMem replaced with GetMem (little speed change)
 111 - better exception handling. Better protection from memory leaks.
 112 22-09-2005
 113 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 114 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 115 07-09-2005
 116 - Added support for Grayscale textures
 117 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 118 10-07-2005
 119 - Added support for GL_VERSION_2_0
 120 - Added support for GL_EXT_texture_filter_anisotropic
 121 04-07-2005
 122 - Function FillWithColor fills the Image with one Color
 123 - Function LoadNormalMap added
 124 30-06-2005
 125 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 126 - ToNormalMap now supports Sobel (nmSobel) function.
 127 29-06-2005
 128 - support for RLE Compressed RGB TGAs added
 129 28-06-2005
 130 - Class TglBitmapNormalMap added to support Normalmap generation
 131 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 132   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 133 16-06-2005
 134 - Method LoadCubeMapClass removed
 135 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 136 - virtual abstract method GenTexture in class TglBitmap now is protected
 137 12-06-2005
 138 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 139 10-06-2005
 140 - little enhancement for IsPowerOfTwo
 141 - TglBitmap1D.GenTexture now tests NPOT Textures
 142 06-06-2005
 143 - some little name changes. All properties or function with Texture in name are
 144   now without texture in name. We have allways texture so we dosn't name it.
 145 03-06-2005
 146 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 147   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 148 02-06-2005
 149 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 150 25-04-2005
 151 - Function Unbind added
 152 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 153 21-04-2005
 154 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 155 29-03-2005
 156 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 157   To Enable png's use the define pngimage
 158 22-03-2005
 159 - New Functioninterface added
 160 - Function GetPixel added
 161 27-11-2004
 162 - Property BuildMipMaps renamed to MipMap
 163 21-11-2004
 164 - property Name removed.
 165 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 166 22-05-2004
 167 - property name added. Only used in glForms!
 168 26-11-2003
 169 - property FreeDataAfterGenTexture is now available as default (default = true)
 170 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 171 - function MoveMemory replaced with function Move (little speed change)
 172 - several calculations stored in variables (little speed change)
 173 29-09-2003
 174 - property BuildMipsMaps added (default = true)
 175   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 176 - property FreeDataAfterGenTexture added (default = true)
 177   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 178 - parameter DisableOtherTextureUnits of Bind removed
 179 - parameter FreeDataAfterGeneration of GenTextures removed
 180 12-09-2003
 181 - TglBitmap dosn't delete data if class was destroyed (fixed)
 182 09-09-2003
 183 - Bind now enables TextureUnits (by params)
 184 - GenTextures can leave data (by param)
 185 - LoadTextures now optimal
 186 03-09-2003
 187 - Performance optimization in AddFunc
 188 - procedure Bind moved to subclasses
 189 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 190 19-08-2003
 191 - Texturefilter and texturewrap now also as defaults
 192   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 193   Magfilter = GL_LINEAR
 194   Wrap(str) = GL_CLAMP_TO_EDGE
 195 - Added new format tfCompressed to create a compressed texture.
 196 - propertys IsCompressed, TextureSize and IsResident added
 197   IsCompressed and TextureSize only contains data from level 0
 198 18-08-2003
 199 - Added function AddFunc to add PerPixelEffects to Image
 200 - LoadFromFunc now based on AddFunc
 201 - Invert now based on AddFunc
 202 - SwapColors now based on AddFunc
 203 16-08-2003
 204 - Added function FlipHorz
 205 15-08-2003
 206 - Added function LaodFromFunc to create images with function
 207 - Added function FlipVert
 208 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 209 29-07-2003
 210 - Added Alphafunctions to calculate alpha per function
 211 - Added Alpha from ColorKey using alphafunctions
 212 28-07-2003
 213 - First full functionally Version of glBitmap
 214 - Support for 24Bit and 32Bit TGA Pictures added
 215 25-07-2003
 216 - begin of programming
 217 ***********************************************************}
 218 unit glBitmap;
 219
 220 // Please uncomment the defines below to configure the glBitmap to your preferences.
 221 // If you have configured the unit you can uncomment the warning above.
 222 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 223
 224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 225 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 227 // activate to enable build-in OpenGL support with statically linked methods
 228 // use dglOpenGL.pas if not enabled
 229 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 230
 231 // activate to enable build-in OpenGL support with dynamically linked methods
 232 // use dglOpenGL.pas if not enabled
 233 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 234
 235
 236 // activate to enable the support for SDL_surfaces
 237 {.$DEFINE GLB_SDL}
 238
 239 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 240 {.$DEFINE GLB_DELPHI}
 241
 242 // activate to enable the support for TLazIntfImage from Lazarus
 243 {$DEFINE GLB_LAZARUS}
 244
 245
 246
 247 // activate to enable the support of SDL_image to load files. (READ ONLY)
 248 // If you enable SDL_image all other libraries will be ignored!
 249 {.$DEFINE GLB_SDL_IMAGE}
 250
 251
 252
 253 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
 254 // if you enable pngimage the libPNG will be ignored
 255 {.$DEFINE GLB_PNGIMAGE}
 256
 257 // activate to use the libPNG -> http://www.libpng.org/
 258 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
 259 {.$DEFINE GLB_LIB_PNG}
 260
 261
 262
 263 // if you enable delphi jpegs the libJPEG will be ignored
 264 {.$DEFINE GLB_DELPHI_JPEG}
 265
 266 // activate to use the libJPEG -> http://www.ijg.org/
 267 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
 268 {.$DEFINE GLB_LIB_JPEG}
 269
 270
 271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 272 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 274 // Delphi Versions
 275 {$IFDEF fpc}
 276   {$MODE Delphi}
 277
 278   {$IFDEF CPUI386}
 279     {$DEFINE CPU386}
 280     {$ASMMODE INTEL}
 281   {$ENDIF}
 282
 283   {$IFNDEF WINDOWS}
 284     {$linklib c}
 285   {$ENDIF}
 286 {$ENDIF}
 287
 288 // Operation System
 289 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 290   {$DEFINE GLB_WIN}
 291 {$ELSEIF DEFINED(LINUX)}
 292   {$DEFINE GLB_LINUX}
 293 {$IFEND}
 294
 295 // native OpenGL Support
 296 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 297   {$DEFINE GLB_NATIVE_OGL}
 298 {$IFEND}
 299
 300 // checking define combinations
 301 //SDL Image
 302 {$IFDEF GLB_SDL_IMAGE}
 303   {$IFNDEF GLB_SDL}
 304     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 305     {$DEFINE GLB_SDL}
 306   {$ENDIF}
 307   {$IFDEF GLB_PNGIMAGE}
 308     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 309     {$undef GLB_PNGIMAGE}
 310   {$ENDIF}
 311   {$IFDEF GLB_DELPHI_JPEG}
 312     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 313     {$undef GLB_DELPHI_JPEG}
 314   {$ENDIF}
 315   {$IFDEF GLB_LIB_PNG}
 316     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 317     {$undef GLB_LIB_PNG}
 318   {$ENDIF}
 319   {$IFDEF GLB_LIB_JPEG}
 320     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 321     {$undef GLB_LIB_JPEG}
 322   {$ENDIF}
 323
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_JPEG_READ}
 326 {$ENDIF}
 327
 328 // PNG Image
 329 {$IFDEF GLB_PNGIMAGE}
 330   {$IFDEF GLB_LIB_PNG}
 331     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 332     {$undef GLB_LIB_PNG}
 333   {$ENDIF}
 334
 335   {$DEFINE GLB_SUPPORT_PNG_READ}
 336   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 337 {$ENDIF}
 338
 339 // libPNG
 340 {$IFDEF GLB_LIB_PNG}
 341   {$DEFINE GLB_SUPPORT_PNG_READ}
 342   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 343 {$ENDIF}
 344
 345 // JPEG Image
 346 {$IFDEF GLB_DELPHI_JPEG}
 347   {$IFDEF GLB_LIB_JPEG}
 348     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 349     {$undef GLB_LIB_JPEG}
 350   {$ENDIF}
 351
 352   {$DEFINE GLB_SUPPORT_JPEG_READ}
 353   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 354 {$ENDIF}
 355
 356 // libJPEG
 357 {$IFDEF GLB_LIB_JPEG}
 358   {$DEFINE GLB_SUPPORT_JPEG_READ}
 359   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 360 {$ENDIF}
 361
 362 // native OpenGL
 363 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 364   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 365 {$IFEND}
 366
 367 // general options
 368 {$EXTENDEDSYNTAX ON}
 369 {$LONGSTRINGS ON}
 370 {$ALIGN ON}
 371 {$IFNDEF FPC}
 372   {$OPTIMIZATION ON}
 373 {$ENDIF}
 374
 375 interface
 376
 377 uses
 378   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,          {$ENDIF}
 379   {$IF DEFINED(GLB_WIN) AND
 380        DEFINED(GLB_NATIVE_OGL)} windows,            {$IFEND}
 381
 382   {$IFDEF GLB_SDL}              SDL,                {$ENDIF}
 383   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,       {$ENDIF}
 384   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,  {$ENDIF}
 385
 386   {$IFDEF GLB_SDL_IMAGE}        SDL_image,          {$ENDIF}
 387
 388   {$IFDEF GLB_PNGIMAGE}         pngimage,           {$ENDIF}
 389   {$IFDEF GLB_LIB_PNG}          libPNG,             {$ENDIF}
 390
 391   {$IFDEF GLB_DELPHI_JPEG}      JPEG,               {$ENDIF}
 392   {$IFDEF GLB_LIB_JPEG}         libJPEG,            {$ENDIF}
 393
 394   Classes, SysUtils;
 395
 396 {$IFDEF GLB_NATIVE_OGL}
 397 const
 398   GL_TRUE   = 1;
 399   GL_FALSE  = 0;
 400
 401   GL_VERSION    = $1F02;
 402   GL_EXTENSIONS = $1F03;
 403
 404   GL_TEXTURE_1D         = $0DE0;
 405   GL_TEXTURE_2D         = $0DE1;
 406   GL_TEXTURE_RECTANGLE  = $84F5;
 407
 408   GL_TEXTURE_WIDTH            = $1000;
 409   GL_TEXTURE_HEIGHT           = $1001;
 410   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 411
 412   GL_ALPHA    = $1906;
 413   GL_ALPHA4   = $803B;
 414   GL_ALPHA8   = $803C;
 415   GL_ALPHA12  = $803D;
 416   GL_ALPHA16  = $803E;
 417
 418   GL_LUMINANCE    = $1909;
 419   GL_LUMINANCE4   = $803F;
 420   GL_LUMINANCE8   = $8040;
 421   GL_LUMINANCE12  = $8041;
 422   GL_LUMINANCE16  = $8042;
 423
 424   GL_LUMINANCE_ALPHA      = $190A;
 425   GL_LUMINANCE4_ALPHA4    = $8043;
 426   GL_LUMINANCE6_ALPHA2    = $8044;
 427   GL_LUMINANCE8_ALPHA8    = $8045;
 428   GL_LUMINANCE12_ALPHA4   = $8046;
 429   GL_LUMINANCE12_ALPHA12  = $8047;
 430   GL_LUMINANCE16_ALPHA16  = $8048;
 431
 432   GL_RGB      = $1907;
 433   GL_BGR      = $80E0;
 434   GL_R3_G3_B2 = $2A10;
 435   GL_RGB4     = $804F;
 436   GL_RGB5     = $8050;
 437   GL_RGB565   = $8D62;
 438   GL_RGB8     = $8051;
 439   GL_RGB10    = $8052;
 440   GL_RGB12    = $8053;
 441   GL_RGB16    = $8054;
 442
 443   GL_RGBA     = $1908;
 444   GL_BGRA     = $80E1;
 445   GL_RGBA2    = $8055;
 446   GL_RGBA4    = $8056;
 447   GL_RGB5_A1  = $8057;
 448   GL_RGBA8    = $8058;
 449   GL_RGB10_A2 = $8059;
 450   GL_RGBA12   = $805A;
 451   GL_RGBA16   = $805B;
 452
 453   GL_DEPTH_COMPONENT    = $1902;
 454   GL_DEPTH_COMPONENT16  = $81A5;
 455   GL_DEPTH_COMPONENT24  = $81A6;
 456   GL_DEPTH_COMPONENT32  = $81A7;
 457
 458   GL_COMPRESSED_RGB                 = $84ED;
 459   GL_COMPRESSED_RGBA                = $84EE;
 460   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 461   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 462   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 463   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 464
 465   GL_UNSIGNED_BYTE            = $1401;
 466   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 467   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 468
 469   GL_UNSIGNED_SHORT             = $1403;
 470   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 471   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 472   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 473   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 474   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 475   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 476
 477   GL_UNSIGNED_INT                 = $1405;
 478   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 479   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 480   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 481   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 482
 483   { Texture Filter }
 484   GL_TEXTURE_MAG_FILTER     = $2800;
 485   GL_TEXTURE_MIN_FILTER     = $2801;
 486   GL_NEAREST                = $2600;
 487   GL_NEAREST_MIPMAP_NEAREST = $2700;
 488   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 489   GL_LINEAR                 = $2601;
 490   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 491   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 492
 493   { Texture Wrap }
 494   GL_TEXTURE_WRAP_S   = $2802;
 495   GL_TEXTURE_WRAP_T   = $2803;
 496   GL_TEXTURE_WRAP_R   = $8072;
 497   GL_CLAMP            = $2900;
 498   GL_REPEAT           = $2901;
 499   GL_CLAMP_TO_EDGE    = $812F;
 500   GL_CLAMP_TO_BORDER  = $812D;
 501   GL_MIRRORED_REPEAT  = $8370;
 502
 503   { Other }
 504   GL_GENERATE_MIPMAP      = $8191;
 505   GL_TEXTURE_BORDER_COLOR = $1004;
 506   GL_MAX_TEXTURE_SIZE     = $0D33;
 507   GL_PACK_ALIGNMENT       = $0D05;
 508   GL_UNPACK_ALIGNMENT     = $0CF5;
 509
 510   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 511   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 512
 513 {$IF DEFINED(GLB_WIN)}
 514   libglu    = 'glu32.dll';
 515   libopengl = 'opengl32.dll';
 516 {$ELSEIF DEFINED(GLB_LINUX)}
 517   libglu    = 'libGLU.so.1';
 518   libopengl = 'libGL.so.1';
 519 {$IFEND}
 520
 521 type
 522   GLboolean = BYTEBOOL;
 523   GLint     = Integer;
 524   GLsizei   = Integer;
 525   GLuint    = Cardinal;
 526   GLfloat   = Single;
 527   GLenum    = Cardinal;
 528
 529   PGLvoid    = Pointer;
 530   PGLboolean = ^GLboolean;
 531   PGLint     = ^GLint;
 532   PGLuint    = ^GLuint;
 533   PGLfloat   = ^GLfloat;
 534
 535   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 536   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 537   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 538
 539 {$IF DEFINED(GLB_WIN)}
 540   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 541 {$ELSEIF DEFINED(GLB_LINUX)}
 542   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 543   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 544 {$IFEND}
 545
 546 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 547   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 548   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549
 550   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 551   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552
 553   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 554   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 557   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559
 560   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 561   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563
 564   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 565   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 566   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 567
 568   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 569   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 570   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 571
 572   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 573   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 574
 575 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 576   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 577   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 578
 579   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 580   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 581
 582   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 583   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 585   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 586   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588
 589   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 592
 593   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 595   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 596
 597   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 598   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 599   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 600
 601   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 602   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 603 {$IFEND}
 604
 605 var
 606   GL_VERSION_1_2,
 607   GL_VERSION_1_3,
 608   GL_VERSION_1_4,
 609   GL_VERSION_2_0,
 610
 611   GL_SGIS_generate_mipmap,
 612
 613   GL_ARB_texture_border_clamp,
 614   GL_ARB_texture_mirrored_repeat,
 615   GL_ARB_texture_rectangle,
 616   GL_ARB_texture_non_power_of_two,
 617
 618   GL_IBM_texture_mirrored_repeat,
 619
 620   GL_NV_texture_rectangle,
 621
 622   GL_EXT_texture_edge_clamp,
 623   GL_EXT_texture_rectangle,
 624   GL_EXT_texture_filter_anisotropic: Boolean;
 625
 626   glCompressedTexImage1D: TglCompressedTexImage1D;
 627   glCompressedTexImage2D: TglCompressedTexImage2D;
 628   glGetCompressedTexImage: TglGetCompressedTexImage;
 629
 630 {$IF DEFINED(GLB_WIN)}
 631   wglGetProcAddress: TwglGetProcAddress;
 632 {$ELSEIF DEFINED(GLB_LINUX)}
 633   glXGetProcAddress: TglXGetProcAddress;
 634   glXGetProcAddressARB: TglXGetProcAddress;
 635 {$IFEND}
 636
 637 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 638   glEnable: TglEnable;
 639   glDisable: TglDisable;
 640
 641   glGetString: TglGetString;
 642   glGetIntegerv: TglGetIntegerv;
 643
 644   glTexParameteri: TglTexParameteri;
 645   glTexParameterfv: TglTexParameterfv;
 646   glGetTexParameteriv: TglGetTexParameteriv;
 647   glGetTexParameterfv: TglGetTexParameterfv;
 648   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 649   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 650
 651   glGenTextures: TglGenTextures;
 652   glBindTexture: TglBindTexture;
 653   glDeleteTextures: TglDeleteTextures;
 654
 655   glAreTexturesResident: TglAreTexturesResident;
 656   glReadPixels: TglReadPixels;
 657   glPixelStorei: TglPixelStorei;
 658
 659   glTexImage1D: TglTexImage1D;
 660   glTexImage2D: TglTexImage2D;
 661   glGetTexImage: TglGetTexImage;
 662
 663   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 664   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 665 {$ENDIF}
 666 {$ENDIF}
 667
 668 type
 669 ////////////////////////////////////////////////////////////////////////////////////////////////////
 670   TglBitmapFormat = (
 671     tfEmpty = 0, //must be smallest value!
 672
 673     tfAlpha4,
 674     tfAlpha8,
 675     tfAlpha12,
 676     tfAlpha16,
 677
 678     tfLuminance4,
 679     tfLuminance8,
 680     tfLuminance12,
 681     tfLuminance16,
 682
 683     tfLuminance4Alpha4,
 684     tfLuminance6Alpha2,
 685     tfLuminance8Alpha8,
 686     tfLuminance12Alpha4,
 687     tfLuminance12Alpha12,
 688     tfLuminance16Alpha16,
 689
 690     tfR3G3B2,
 691     tfRGB4,
 692     tfR5G6B5,
 693     tfRGB5,
 694     tfRGB8,
 695     tfRGB10,
 696     tfRGB12,
 697     tfRGB16,
 698
 699     tfRGBA2,
 700     tfRGBA4,
 701     tfRGB5A1,
 702     tfRGBA8,
 703     tfRGB10A2,
 704     tfRGBA12,
 705     tfRGBA16,
 706
 707     tfBGR4,
 708     tfB5G6R5,
 709     tfBGR5,
 710     tfBGR8,
 711     tfBGR10,
 712     tfBGR12,
 713     tfBGR16,
 714
 715     tfBGRA2,
 716     tfBGRA4,
 717     tfBGR5A1,
 718     tfBGRA8,
 719     tfBGR10A2,
 720     tfBGRA12,
 721     tfBGRA16,
 722
 723     tfDepth16,
 724     tfDepth24,
 725     tfDepth32,
 726
 727     tfS3tcDtx1RGBA,
 728     tfS3tcDtx3RGBA,
 729     tfS3tcDtx5RGBA
 730   );
 731
 732   TglBitmapFileType = (
 733      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 734      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 735      ftDDS,
 736      ftTGA,
 737      ftBMP);
 738    TglBitmapFileTypes = set of TglBitmapFileType;
 739
 740    TglBitmapMipMap = (
 741      mmNone,
 742      mmMipmap,
 743      mmMipmapGlu);
 744
 745    TglBitmapNormalMapFunc = (
 746      nm4Samples,
 747      nmSobel,
 748      nm3x3,
 749      nm5x5);
 750
 751  ////////////////////////////////////////////////////////////////////////////////////////////////////
 752    EglBitmapException               = class(Exception);
 753    EglBitmapSizeToLargeException    = class(EglBitmapException);
 754    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 755    EglBitmapUnsupportedFormat       = class(EglBitmapException)
 756      constructor Create(const aFormat: TglBitmapFormat); overload;
 757      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 758    end;
 759
 760 ////////////////////////////////////////////////////////////////////////////////////////////////////
 761   TglBitmapColorRec = packed record
 762   case Integer of
 763     0: (r, g, b, a: Cardinal);
 764     1: (arr: array[0..3] of Cardinal);
 765   end;
 766
 767   TglBitmapPixelData = packed record
 768     Data, Range: TglBitmapColorRec;
 769     Format: TglBitmapFormat;
 770   end;
 771   PglBitmapPixelData = ^TglBitmapPixelData;
 772
 773 ////////////////////////////////////////////////////////////////////////////////////////////////////
 774   TglBitmapPixelPositionFields = set of (ffX, ffY);
 775   TglBitmapPixelPosition = record
 776     Fields : TglBitmapPixelPositionFields;
 777     X : Word;
 778     Y : Word;
 779   end;
 780
 781 ////////////////////////////////////////////////////////////////////////////////////////////////////
 782   TglBitmap = class;
 783   TglBitmapFunctionRec = record
 784     Sender:   TglBitmap;
 785     Size:     TglBitmapPixelPosition;
 786     Position: TglBitmapPixelPosition;
 787     Source:   TglBitmapPixelData;
 788     Dest:     TglBitmapPixelData;
 789     Args:     Pointer;
 790   end;
 791   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 792
 793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 794   TglBitmap = class
 795   protected
 796     fID: GLuint;
 797     fTarget: GLuint;
 798     fAnisotropic: Integer;
 799     fDeleteTextureOnFree: Boolean;
 800     fFreeDataAfterGenTexture: Boolean;
 801     fData: PByte;
 802     fIsResident: Boolean;
 803     fBorderColor: array[0..3] of Single;
 804
 805     fDimension: TglBitmapPixelPosition;
 806     fMipMap: TglBitmapMipMap;
 807     fFormat: TglBitmapFormat;
 808
 809     // Mapping
 810     fPixelSize: Integer;
 811     fRowSize: Integer;
 812
 813     // Filtering
 814     fFilterMin: Cardinal;
 815     fFilterMag: Cardinal;
 816
 817     // TexturWarp
 818     fWrapS: Cardinal;
 819     fWrapT: Cardinal;
 820     fWrapR: Cardinal;
 821
 822     // CustomData
 823     fFilename: String;
 824     fCustomName: String;
 825     fCustomNameW: WideString;
 826     fCustomData: Pointer;
 827
 828     //Getter
 829     function GetWidth:  Integer; virtual;
 830     function GetHeight: Integer; virtual;
 831
 832     function GetFileWidth:  Integer; virtual;
 833     function GetFileHeight: Integer; virtual;
 834
 835     //Setter
 836     procedure SetCustomData(const aValue: Pointer);
 837     procedure SetCustomName(const aValue: String);
 838     procedure SetCustomNameW(const aValue: WideString);
 839     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 840     procedure SetFormat(const aValue: TglBitmapFormat);
 841     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 842     procedure SetID(const aValue: Cardinal);
 843     procedure SetMipMap(const aValue: TglBitmapMipMap);
 844     procedure SetTarget(const aValue: Cardinal);
 845     procedure SetAnisotropic(const aValue: Integer);
 846
 847     procedure CreateID;
 848     procedure SetupParameters(out aBuildWithGlu: Boolean);
 849     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 850       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
 851     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 852
 853     function FlipHorz: Boolean; virtual;
 854     function FlipVert: Boolean; virtual;
 855
 856     property Width:  Integer read GetWidth;
 857     property Height: Integer read GetHeight;
 858
 859     property FileWidth:  Integer read GetFileWidth;
 860     property FileHeight: Integer read GetFileHeight;
 861   public
 862     //Properties
 863     property ID:           Cardinal        read fID          write SetID;
 864     property Target:       Cardinal        read fTarget      write SetTarget;
 865     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 866     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 867     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 868
 869     property Filename:    String     read fFilename;
 870     property CustomName:  String     read fCustomName  write SetCustomName;
 871     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 872     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 873
 874     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 875     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 876
 877     property Dimension:  TglBitmapPixelPosition  read fDimension;
 878     property Data:       PByte                   read fData;
 879     property IsResident: Boolean                 read fIsResident;
 880
 881     procedure AfterConstruction; override;
 882     procedure BeforeDestruction; override;
 883
 884     procedure PrepareResType(var aResource: String; var aResType: PChar);
 885
 886     //Load
 887     procedure LoadFromFile(const aFilename: String);
 888     procedure LoadFromStream(const aStream: TStream); virtual;
 889     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 890       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 891     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 892     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 893
 894     //Save
 895     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 896     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 897
 898     //Convert
 899     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 900     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 901       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 902   public
 903     //Alpha & Co
 904     {$IFDEF GLB_SDL}
 905     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 906     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 907     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 908     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 909       const aArgs: Pointer = nil): Boolean;
 910     {$ENDIF}
 911
 912     {$IFDEF GLB_DELPHI}
 913     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 914     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 915     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 916     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 917       const aArgs: Pointer = nil): Boolean;
 918     {$ENDIF}
 919
 920     {$IFDEF GLB_LAZARUS}
 921     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 922     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 923     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 924     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
 925       const aArgs: Pointer = nil): Boolean;
 926     {$ENDIF}
 927
 928     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
 929       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 930     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 931       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 932
 933     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 934     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 935     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 936     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 937
 938     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 939     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 940     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 941
 942     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 943     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 944     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 945
 946     function RemoveAlpha: Boolean; virtual;
 947   public
 948     //Common
 949     function Clone: TglBitmap;
 950     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 951     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 952     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 953     procedure FreeData;
 954
 955     //ColorFill
 956     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 957     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 958     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 959
 960     //TexParameters
 961     procedure SetFilter(const aMin, aMag: Cardinal);
 962     procedure SetWrap(
 963       const S: Cardinal = GL_CLAMP_TO_EDGE;
 964       const T: Cardinal = GL_CLAMP_TO_EDGE;
 965       const R: Cardinal = GL_CLAMP_TO_EDGE);
 966
 967     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 968     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 969
 970     //Constructors
 971     constructor Create; overload;
 972     constructor Create(const aFileName: String); overload;
 973     constructor Create(const aStream: TStream); overload;
 974     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 975     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 976     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 977     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 978   private
 979     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 980     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
 981
 982     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
 983     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
 984
 985     function LoadBMP(const aStream: TStream): Boolean; virtual;
 986     procedure SaveBMP(const aStream: TStream); virtual;
 987
 988     function LoadTGA(const aStream: TStream): Boolean; virtual;
 989     procedure SaveTGA(const aStream: TStream); virtual;
 990
 991     function LoadDDS(const aStream: TStream): Boolean; virtual;
 992     procedure SaveDDS(const aStream: TStream); virtual;
 993   end;
 994
 995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 996   TglBitmap1D = class(TglBitmap)
 997   protected
 998     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 999       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1000     procedure UploadData(const aBuildWithGlu: Boolean);
1001   public
1002     property Width;
1003     procedure AfterConstruction; override;
1004     function FlipHorz: Boolean; override;
1005     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1006   end;
1007
1008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1009   TglBitmap2D = class(TglBitmap)
1010   protected
1011     fLines: array of PByte;
1012     function GetScanline(const aIndex: Integer): Pointer;
1013     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1014       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1015     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1016   public
1017     property Width;
1018     property Height;
1019     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1020
1021     procedure AfterConstruction; override;
1022
1023     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1024     procedure GetDataFromTexture;
1025     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1026
1027     function FlipHorz: Boolean; override;
1028     function FlipVert: Boolean; override;
1029
1030     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1031       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1032   end;
1033
1034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1035   TglBitmapCubeMap = class(TglBitmap2D)
1036   protected
1037     fGenMode: Integer;
1038     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1039   public
1040     procedure AfterConstruction; override;
1041     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1042     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1043     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1044   end;
1045
1046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1047   TglBitmapNormalMap = class(TglBitmapCubeMap)
1048   public
1049     procedure AfterConstruction; override;
1050     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1051   end;
1052
1053 const
1054   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1055
1056 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1057 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1058 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1059 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1060 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1061 procedure glBitmapSetDefaultWrap(
1062   const S: Cardinal = GL_CLAMP_TO_EDGE;
1063   const T: Cardinal = GL_CLAMP_TO_EDGE;
1064   const R: Cardinal = GL_CLAMP_TO_EDGE);
1065
1066 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1067 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1068 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1069 function glBitmapGetDefaultFormat: TglBitmapFormat;
1070 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1071 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1072
1073 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1074 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1075 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1076
1077 var
1078   glBitmapDefaultDeleteTextureOnFree: Boolean;
1079   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1080   glBitmapDefaultFormat: TglBitmapFormat;
1081   glBitmapDefaultMipmap: TglBitmapMipMap;
1082   glBitmapDefaultFilterMin: Cardinal;
1083   glBitmapDefaultFilterMag: Cardinal;
1084   glBitmapDefaultWrapS: Cardinal;
1085   glBitmapDefaultWrapT: Cardinal;
1086   glBitmapDefaultWrapR: Cardinal;
1087
1088 {$IFDEF GLB_DELPHI}
1089 function CreateGrayPalette: HPALETTE;
1090 {$ENDIF}
1091
1092 implementation
1093
1094 uses
1095   Math, syncobjs, typinfo;
1096
1097 type
1098 {$IFNDEF fpc}
1099   QWord   = System.UInt64;
1100   PQWord  = ^QWord;
1101
1102   PtrInt  = Longint;
1103   PtrUInt = DWord;
1104 {$ENDIF}
1105
1106 ////////////////////////////////////////////////////////////////////////////////////////////////////
1107   TShiftRec = packed record
1108   case Integer of
1109     0: (r, g, b, a: Byte);
1110     1: (arr: array[0..3] of Byte);
1111   end;
1112
1113   TFormatDescriptor = class(TObject)
1114   private
1115     function GetRedMask: QWord;
1116     function GetGreenMask: QWord;
1117     function GetBlueMask: QWord;
1118     function GetAlphaMask: QWord;
1119   protected
1120     fFormat: TglBitmapFormat;
1121     fWithAlpha: TglBitmapFormat;
1122     fWithoutAlpha: TglBitmapFormat;
1123     fRGBInverted: TglBitmapFormat;
1124     fUncompressed: TglBitmapFormat;
1125     fPixelSize: Single;
1126     fIsCompressed: Boolean;
1127
1128     fRange: TglBitmapColorRec;
1129     fShift: TShiftRec;
1130
1131     fglFormat:         Cardinal;
1132     fglInternalFormat: Cardinal;
1133     fglDataFormat:     Cardinal;
1134
1135     function GetComponents: Integer; virtual;
1136   public
1137     property Format:       TglBitmapFormat read fFormat;
1138     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1139     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1140     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1141     property Components:   Integer         read GetComponents;
1142     property PixelSize:    Single          read fPixelSize;
1143     property IsCompressed: Boolean         read fIsCompressed;
1144
1145     property glFormat:         Cardinal read fglFormat;
1146     property glInternalFormat: Cardinal read fglInternalFormat;
1147     property glDataFormat:     Cardinal read fglDataFormat;
1148
1149     property Range: TglBitmapColorRec read fRange;
1150     property Shift: TShiftRec         read fShift;
1151
1152     property RedMask:   QWord read GetRedMask;
1153     property GreenMask: QWord read GetGreenMask;
1154     property BlueMask:  QWord read GetBlueMask;
1155     property AlphaMask: QWord read GetAlphaMask;
1156
1157     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1158     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1159
1160     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1161     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1162
1163     function CreateMappingData: Pointer; virtual;
1164     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1165
1166     function IsEmpty:  Boolean; virtual;
1167     function HasAlpha: Boolean; virtual;
1168     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1169
1170     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1171
1172     constructor Create; virtual;
1173   public
1174     class procedure Init;
1175     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1176     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1177     class procedure Clear;
1178     class procedure Finalize;
1179   end;
1180   TFormatDescriptorClass = class of TFormatDescriptor;
1181
1182   TfdEmpty = class(TFormatDescriptor);
1183
1184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1185   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1186     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1187     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1188     constructor Create; override;
1189   end;
1190
1191   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1192     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1193     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1194     constructor Create; override;
1195   end;
1196
1197   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1198     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1199     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1200     constructor Create; override;
1201   end;
1202
1203   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1204     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1205     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1206     constructor Create; override;
1207   end;
1208
1209   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1210     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1211     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1212     constructor Create; override;
1213   end;
1214
1215   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1216     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1217     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1218     constructor Create; override;
1219   end;
1220
1221   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1222     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1223     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1224     constructor Create; override;
1225   end;
1226
1227   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1228     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1229     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1230     constructor Create; override;
1231   end;
1232
1233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1234   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1235     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1236     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1237     constructor Create; override;
1238   end;
1239
1240   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1241     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1242     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1243     constructor Create; override;
1244   end;
1245
1246   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1247     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1248     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1249     constructor Create; override;
1250   end;
1251
1252   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1253     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1254     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1255     constructor Create; override;
1256   end;
1257
1258   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1259     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1260     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1261     constructor Create; override;
1262   end;
1263
1264   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1265     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1266     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1267     constructor Create; override;
1268   end;
1269
1270   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1271     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1272     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1273     constructor Create; override;
1274   end;
1275
1276   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1277     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1278     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1279     constructor Create; override;
1280   end;
1281
1282   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1283     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1284     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1285     constructor Create; override;
1286   end;
1287
1288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1289   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1290     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1291     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1292     constructor Create; override;
1293   end;
1294
1295   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1296     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1297     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1298     constructor Create; override;
1299   end;
1300
1301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1302   TfdAlpha4 = class(TfdAlpha_UB1)
1303     constructor Create; override;
1304   end;
1305
1306   TfdAlpha8 = class(TfdAlpha_UB1)
1307     constructor Create; override;
1308   end;
1309
1310   TfdAlpha12 = class(TfdAlpha_US1)
1311     constructor Create; override;
1312   end;
1313
1314   TfdAlpha16 = class(TfdAlpha_US1)
1315     constructor Create; override;
1316   end;
1317
1318   TfdLuminance4 = class(TfdLuminance_UB1)
1319     constructor Create; override;
1320   end;
1321
1322   TfdLuminance8 = class(TfdLuminance_UB1)
1323     constructor Create; override;
1324   end;
1325
1326   TfdLuminance12 = class(TfdLuminance_US1)
1327     constructor Create; override;
1328   end;
1329
1330   TfdLuminance16 = class(TfdLuminance_US1)
1331     constructor Create; override;
1332   end;
1333
1334   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1335     constructor Create; override;
1336   end;
1337
1338   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1339     constructor Create; override;
1340   end;
1341
1342   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1343     constructor Create; override;
1344   end;
1345
1346   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1347     constructor Create; override;
1348   end;
1349
1350   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1351     constructor Create; override;
1352   end;
1353
1354   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1355     constructor Create; override;
1356   end;
1357
1358   TfdR3G3B2 = class(TfdUniversal_UB1)
1359     constructor Create; override;
1360   end;
1361
1362   TfdRGB4 = class(TfdUniversal_US1)
1363     constructor Create; override;
1364   end;
1365
1366   TfdR5G6B5 = class(TfdUniversal_US1)
1367     constructor Create; override;
1368   end;
1369
1370   TfdRGB5 = class(TfdUniversal_US1)
1371     constructor Create; override;
1372   end;
1373
1374   TfdRGB8 = class(TfdRGB_UB3)
1375     constructor Create; override;
1376   end;
1377
1378   TfdRGB10 = class(TfdUniversal_UI1)
1379     constructor Create; override;
1380   end;
1381
1382   TfdRGB12 = class(TfdRGB_US3)
1383     constructor Create; override;
1384   end;
1385
1386   TfdRGB16 = class(TfdRGB_US3)
1387     constructor Create; override;
1388   end;
1389
1390   TfdRGBA2 = class(TfdRGBA_UB4)
1391     constructor Create; override;
1392   end;
1393
1394   TfdRGBA4 = class(TfdUniversal_US1)
1395     constructor Create; override;
1396   end;
1397
1398   TfdRGB5A1 = class(TfdUniversal_US1)
1399     constructor Create; override;
1400   end;
1401
1402   TfdRGBA8 = class(TfdRGBA_UB4)
1403     constructor Create; override;
1404   end;
1405
1406   TfdRGB10A2 = class(TfdUniversal_UI1)
1407     constructor Create; override;
1408   end;
1409
1410   TfdRGBA12 = class(TfdRGBA_US4)
1411     constructor Create; override;
1412   end;
1413
1414   TfdRGBA16 = class(TfdRGBA_US4)
1415     constructor Create; override;
1416   end;
1417
1418   TfdBGR4 = class(TfdUniversal_US1)
1419     constructor Create; override;
1420   end;
1421
1422   TfdB5G6R5 = class(TfdUniversal_US1)
1423     constructor Create; override;
1424   end;
1425
1426   TfdBGR5 = class(TfdUniversal_US1)
1427     constructor Create; override;
1428   end;
1429
1430   TfdBGR8 = class(TfdBGR_UB3)
1431     constructor Create; override;
1432   end;
1433
1434   TfdBGR10 = class(TfdUniversal_UI1)
1435     constructor Create; override;
1436   end;
1437
1438   TfdBGR12 = class(TfdBGR_US3)
1439     constructor Create; override;
1440   end;
1441
1442   TfdBGR16 = class(TfdBGR_US3)
1443     constructor Create; override;
1444   end;
1445
1446   TfdBGRA2 = class(TfdBGRA_UB4)
1447     constructor Create; override;
1448   end;
1449
1450   TfdBGRA4 = class(TfdUniversal_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdBGR5A1 = class(TfdUniversal_US1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdBGRA8 = class(TfdBGRA_UB4)
1459     constructor Create; override;
1460   end;
1461
1462   TfdBGR10A2 = class(TfdUniversal_UI1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdBGRA12 = class(TfdBGRA_US4)
1467     constructor Create; override;
1468   end;
1469
1470   TfdBGRA16 = class(TfdBGRA_US4)
1471     constructor Create; override;
1472   end;
1473
1474   TfdDepth16 = class(TfdDepth_US1)
1475     constructor Create; override;
1476   end;
1477
1478   TfdDepth24 = class(TfdDepth_UI1)
1479     constructor Create; override;
1480   end;
1481
1482   TfdDepth32 = class(TfdDepth_UI1)
1483     constructor Create; override;
1484   end;
1485
1486   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1487     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1488     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1489     constructor Create; override;
1490   end;
1491
1492   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1493     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1494     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1495     constructor Create; override;
1496   end;
1497
1498   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1499     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1500     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1501     constructor Create; override;
1502   end;
1503
1504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1505   TbmpBitfieldFormat = class(TFormatDescriptor)
1506   private
1507     procedure SetRedMask  (const aValue: QWord);
1508     procedure SetGreenMask(const aValue: QWord);
1509     procedure SetBlueMask (const aValue: QWord);
1510     procedure SetAlphaMask(const aValue: QWord);
1511
1512     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1513   public
1514     property RedMask:   QWord read GetRedMask   write SetRedMask;
1515     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1516     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1517     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1518
1519     property PixelSize: Single read fPixelSize write fPixelSize;
1520
1521     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1522     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1523   end;
1524
1525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1526   TbmpColorTableEnty = packed record
1527     b, g, r, a: Byte;
1528   end;
1529   TbmpColorTable = array of TbmpColorTableEnty;
1530   TbmpColorTableFormat = class(TFormatDescriptor)
1531   private
1532     fColorTable: TbmpColorTable;
1533   public
1534     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1535     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1536     property Range:      TglBitmapColorRec read fRange      write fRange;
1537     property Shift:      TShiftRec         read fShift      write fShift;
1538     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1539
1540     procedure CreateColorTable;
1541
1542     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1543     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1544     destructor Destroy; override;
1545   end;
1546
1547 const
1548   LUMINANCE_WEIGHT_R = 0.30;
1549   LUMINANCE_WEIGHT_G = 0.59;
1550   LUMINANCE_WEIGHT_B = 0.11;
1551
1552   ALPHA_WEIGHT_R = 0.30;
1553   ALPHA_WEIGHT_G = 0.59;
1554   ALPHA_WEIGHT_B = 0.11;
1555
1556   DEPTH_WEIGHT_R = 0.333333333;
1557   DEPTH_WEIGHT_G = 0.333333333;
1558   DEPTH_WEIGHT_B = 0.333333333;
1559
1560   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1561
1562   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1563     TfdEmpty,
1564
1565     TfdAlpha4,
1566     TfdAlpha8,
1567     TfdAlpha12,
1568     TfdAlpha16,
1569
1570     TfdLuminance4,
1571     TfdLuminance8,
1572     TfdLuminance12,
1573     TfdLuminance16,
1574
1575     TfdLuminance4Alpha4,
1576     TfdLuminance6Alpha2,
1577     TfdLuminance8Alpha8,
1578     TfdLuminance12Alpha4,
1579     TfdLuminance12Alpha12,
1580     TfdLuminance16Alpha16,
1581
1582     TfdR3G3B2,
1583     TfdRGB4,
1584     TfdR5G6B5,
1585     TfdRGB5,
1586     TfdRGB8,
1587     TfdRGB10,
1588     TfdRGB12,
1589     TfdRGB16,
1590
1591     TfdRGBA2,
1592     TfdRGBA4,
1593     TfdRGB5A1,
1594     TfdRGBA8,
1595     TfdRGB10A2,
1596     TfdRGBA12,
1597     TfdRGBA16,
1598
1599     TfdBGR4,
1600     TfdB5G6R5,
1601     TfdBGR5,
1602     TfdBGR8,
1603     TfdBGR10,
1604     TfdBGR12,
1605     TfdBGR16,
1606
1607     TfdBGRA2,
1608     TfdBGRA4,
1609     TfdBGR5A1,
1610     TfdBGRA8,
1611     TfdBGR10A2,
1612     TfdBGRA12,
1613     TfdBGRA16,
1614
1615     TfdDepth16,
1616     TfdDepth24,
1617     TfdDepth32,
1618
1619     TfdS3tcDtx1RGBA,
1620     TfdS3tcDtx3RGBA,
1621     TfdS3tcDtx5RGBA
1622   );
1623
1624 var
1625   FormatDescriptorCS: TCriticalSection;
1626   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1627
1628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1629 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1630 begin
1631   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1632 end;
1633
1634 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1635 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1636 begin
1637   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1638 end;
1639
1640 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1641 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1642 begin
1643   result.Fields := [];
1644
1645   if X >= 0 then
1646     result.Fields := result.Fields + [ffX];
1647   if Y >= 0 then
1648     result.Fields := result.Fields + [ffY];
1649
1650   result.X := Max(0, X);
1651   result.Y := Max(0, Y);
1652 end;
1653
1654 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1656 begin
1657   result.r := r;
1658   result.g := g;
1659   result.b := b;
1660   result.a := a;
1661 end;
1662
1663 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1664 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1665 var
1666   i: Integer;
1667 begin
1668   result := false;
1669   for i := 0 to high(r1.arr) do
1670     if (r1.arr[i] <> r2.arr[i]) then
1671       exit;
1672   result := true;
1673 end;
1674
1675 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1676 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1677 begin
1678   result.r := r;
1679   result.g := g;
1680   result.b := b;
1681   result.a := a;
1682 end;
1683
1684 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1685 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1686 begin
1687   result := [];
1688
1689   if (aFormat in [
1690         //4 bbp
1691         tfLuminance4,
1692
1693         //8bpp
1694         tfR3G3B2, tfLuminance8,
1695
1696         //16bpp
1697         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1698         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1699
1700         //24bpp
1701         tfBGR8, tfRGB8,
1702
1703         //32bpp
1704         tfRGB10, tfRGB10A2, tfRGBA8,
1705         tfBGR10, tfBGR10A2, tfBGRA8]) then
1706     result := result + [ftBMP];
1707
1708   if (aFormat in [
1709         //8 bpp
1710         tfLuminance8, tfAlpha8,
1711
1712         //16 bpp
1713         tfLuminance16, tfLuminance8Alpha8,
1714         tfRGB5, tfRGB5A1, tfRGBA4,
1715         tfBGR5, tfBGR5A1, tfBGRA4,
1716
1717         //24 bpp
1718         tfRGB8, tfBGR8,
1719
1720         //32 bpp
1721         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1722     result := result + [ftTGA];
1723
1724   if (aFormat in [
1725         //8 bpp
1726         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1727         tfR3G3B2, tfRGBA2, tfBGRA2,
1728
1729         //16 bpp
1730         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1731         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1732         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1733
1734         //24 bpp
1735         tfRGB8, tfBGR8,
1736
1737         //32 bbp
1738         tfLuminance16Alpha16,
1739         tfRGBA8, tfRGB10A2,
1740         tfBGRA8, tfBGR10A2,
1741
1742         //compressed
1743         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1744     result := result + [ftDDS];
1745
1746   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1747   if aFormat in [
1748       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1749       tfRGB8, tfRGBA8,
1750       tfBGR8, tfBGRA8] then
1751     result := result + [ftPNG];
1752   {$ENDIF}
1753
1754   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1755   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1756     result := result + [ftJPEG];
1757   {$ENDIF}
1758 end;
1759
1760 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1761 function IsPowerOfTwo(aNumber: Integer): Boolean;
1762 begin
1763   while (aNumber and 1) = 0 do
1764     aNumber := aNumber shr 1;
1765   result := aNumber = 1;
1766 end;
1767
1768 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1769 function GetTopMostBit(aBitSet: QWord): Integer;
1770 begin
1771   result := 0;
1772   while aBitSet > 0 do begin
1773     inc(result);
1774     aBitSet := aBitSet shr 1;
1775   end;
1776 end;
1777
1778 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1779 function CountSetBits(aBitSet: QWord): Integer;
1780 begin
1781   result := 0;
1782   while aBitSet > 0 do begin
1783     if (aBitSet and 1) = 1 then
1784       inc(result);
1785     aBitSet := aBitSet shr 1;
1786   end;
1787 end;
1788
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1791 begin
1792   result := Trunc(
1793     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1794     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1795     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1796 end;
1797
1798 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1799 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1800 begin
1801   result := Trunc(
1802     DEPTH_WEIGHT_R * aPixel.Data.r +
1803     DEPTH_WEIGHT_G * aPixel.Data.g +
1804     DEPTH_WEIGHT_B * aPixel.Data.b);
1805 end;
1806
1807 {$IFDEF GLB_NATIVE_OGL}
1808 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1809 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1810 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1811 var
1812   GL_LibHandle: Pointer = nil;
1813
1814 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1815 begin
1816   if not Assigned(aLibHandle) then
1817     aLibHandle := GL_LibHandle;
1818
1819 {$IF DEFINED(GLB_WIN)}
1820   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1821   if Assigned(result) then
1822     exit;
1823
1824   if Assigned(wglGetProcAddress) then
1825     result := wglGetProcAddress(aProcName);
1826 {$ELSEIF DEFINED(GLB_LINUX)}
1827   if Assigned(glXGetProcAddress) then begin
1828     result := glXGetProcAddress(aProcName);
1829     if Assigned(result) then
1830       exit;
1831   end;
1832
1833   if Assigned(glXGetProcAddressARB) then begin
1834     result := glXGetProcAddressARB(aProcName);
1835     if Assigned(result) then
1836       exit;
1837   end;
1838
1839   result := dlsym(aLibHandle, aProcName);
1840 {$IFEND}
1841   if not Assigned(result) then
1842     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1843 end;
1844
1845 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1846 var
1847   GLU_LibHandle: Pointer = nil;
1848   OpenGLInitialized: Boolean;
1849   InitOpenGLCS: TCriticalSection;
1850
1851 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1852 procedure glbInitOpenGL;
1853
1854   ////////////////////////////////////////////////////////////////////////////////
1855   function glbLoadLibrary(const aName: PChar): Pointer;
1856   begin
1857     {$IF DEFINED(GLB_WIN)}
1858     result := {%H-}Pointer(LoadLibrary(aName));
1859     {$ELSEIF DEFINED(GLB_LINUX)}
1860     result := dlopen(Name, RTLD_LAZY);
1861     {$ELSE}
1862     result := nil;
1863     {$IFEND}
1864   end;
1865
1866   ////////////////////////////////////////////////////////////////////////////////
1867   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1868   begin
1869     result := false;
1870     if not Assigned(aLibHandle) then
1871       exit;
1872
1873     {$IF DEFINED(GLB_WIN)}
1874     Result := FreeLibrary({%H-}HINST(aLibHandle));
1875     {$ELSEIF DEFINED(GLB_LINUX)}
1876     Result := dlclose(aLibHandle) = 0;
1877     {$IFEND}
1878   end;
1879
1880 begin
1881   if Assigned(GL_LibHandle) then
1882     glbFreeLibrary(GL_LibHandle);
1883
1884   if Assigned(GLU_LibHandle) then
1885     glbFreeLibrary(GLU_LibHandle);
1886
1887   GL_LibHandle := glbLoadLibrary(libopengl);
1888   if not Assigned(GL_LibHandle) then
1889     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1890
1891   GLU_LibHandle := glbLoadLibrary(libglu);
1892   if not Assigned(GLU_LibHandle) then
1893     raise EglBitmapException.Create('unable to load library: ' + libglu);
1894
1895   try
1896   {$IF DEFINED(GLB_WIN)}
1897     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1898   {$ELSEIF DEFINED(GLB_LINUX)}
1899     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1900     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
1901   {$IFEND}
1902
1903     glEnable := glbGetProcAddress('glEnable');
1904     glDisable := glbGetProcAddress('glDisable');
1905     glGetString := glbGetProcAddress('glGetString');
1906     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1907     glTexParameteri := glbGetProcAddress('glTexParameteri');
1908     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1909     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1910     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1911     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1912     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1913     glGenTextures := glbGetProcAddress('glGenTextures');
1914     glBindTexture := glbGetProcAddress('glBindTexture');
1915     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1916     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1917     glReadPixels := glbGetProcAddress('glReadPixels');
1918     glPixelStorei := glbGetProcAddress('glPixelStorei');
1919     glTexImage1D := glbGetProcAddress('glTexImage1D');
1920     glTexImage2D := glbGetProcAddress('glTexImage2D');
1921     glGetTexImage := glbGetProcAddress('glGetTexImage');
1922
1923     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1924     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1925   finally
1926     glbFreeLibrary(GL_LibHandle);
1927     glbFreeLibrary(GLU_LibHandle);
1928   end;
1929 end;
1930 {$ENDIF}
1931
1932 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1933 procedure glbReadOpenGLExtensions;
1934 var
1935   Buffer: AnsiString;
1936   MajorVersion, MinorVersion: Integer;
1937
1938   ///////////////////////////////////////////////////////////////////////////////////////////
1939   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1940   var
1941     Separator: Integer;
1942   begin
1943     aMinor := 0;
1944     aMajor := 0;
1945
1946     Separator := Pos(AnsiString('.'), aBuffer);
1947     if (Separator > 1) and (Separator < Length(aBuffer)) and
1948        (aBuffer[Separator - 1] in ['0'..'9']) and
1949        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1950
1951       Dec(Separator);
1952       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1953         Dec(Separator);
1954
1955       Delete(aBuffer, 1, Separator);
1956       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1957
1958       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1959         Inc(Separator);
1960
1961       Delete(aBuffer, Separator, 255);
1962       Separator := Pos(AnsiString('.'), aBuffer);
1963
1964       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1965       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
1966     end;
1967   end;
1968
1969   ///////////////////////////////////////////////////////////////////////////////////////////
1970   function CheckExtension(const Extension: AnsiString): Boolean;
1971   var
1972     ExtPos: Integer;
1973   begin
1974     ExtPos := Pos(Extension, Buffer);
1975     result := ExtPos > 0;
1976     if result then
1977       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1978   end;
1979
1980 begin
1981 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1982   InitOpenGLCS.Enter;
1983   try
1984     if not OpenGLInitialized then begin
1985       glbInitOpenGL;
1986       OpenGLInitialized := true;
1987     end;
1988   finally
1989     InitOpenGLCS.Leave;
1990   end;
1991 {$ENDIF}
1992
1993   // Version
1994   Buffer := glGetString(GL_VERSION);
1995   TrimVersionString(Buffer, MajorVersion, MinorVersion);
1996
1997   GL_VERSION_1_2 := false;
1998   GL_VERSION_1_3 := false;
1999   GL_VERSION_1_4 := false;
2000   GL_VERSION_2_0 := false;
2001   if MajorVersion = 1 then begin
2002     if MinorVersion >= 2 then
2003       GL_VERSION_1_2 := true;
2004
2005     if MinorVersion >= 3 then
2006       GL_VERSION_1_3 := true;
2007
2008     if MinorVersion >= 4 then
2009       GL_VERSION_1_4 := true;
2010   end else if MajorVersion >= 2 then begin
2011     GL_VERSION_1_2 := true;
2012     GL_VERSION_1_3 := true;
2013     GL_VERSION_1_4 := true;
2014     GL_VERSION_2_0 := true;
2015   end;
2016
2017   // Extensions
2018   Buffer := glGetString(GL_EXTENSIONS);
2019   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2020   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2021   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2022   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2023   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2024   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2025   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2026   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2027   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2028   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2029
2030   if GL_VERSION_1_3 then begin
2031     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2032     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2033     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2034   end else begin
2035     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2036     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2037     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2038   end;
2039 end;
2040 {$ENDIF}
2041
2042 {$IFDEF GLB_SDL_IMAGE}
2043 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2044 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2045 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2046 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2047 begin
2048   result := TStream(context^.unknown.data1).Seek(offset, whence);
2049 end;
2050
2051 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2052 begin
2053   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2054 end;
2055
2056 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2057 begin
2058   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2059 end;
2060
2061 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2062 begin
2063   result := 0;
2064 end;
2065
2066 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2067 begin
2068   result := SDL_AllocRW;
2069
2070   if result = nil then
2071     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2072
2073   result^.seek := glBitmapRWseek;
2074   result^.read := glBitmapRWread;
2075   result^.write := glBitmapRWwrite;
2076   result^.close := glBitmapRWclose;
2077   result^.unknown.data1 := Stream;
2078 end;
2079 {$ENDIF}
2080
2081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2082 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2083 begin
2084   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2085 end;
2086
2087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2089 begin
2090   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2091 end;
2092
2093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2094 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2095 begin
2096   glBitmapDefaultMipmap := aValue;
2097 end;
2098
2099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2100 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2101 begin
2102   glBitmapDefaultFormat := aFormat;
2103 end;
2104
2105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2106 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2107 begin
2108   glBitmapDefaultFilterMin := aMin;
2109   glBitmapDefaultFilterMag := aMag;
2110 end;
2111
2112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2113 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2114 begin
2115   glBitmapDefaultWrapS := S;
2116   glBitmapDefaultWrapT := T;
2117   glBitmapDefaultWrapR := R;
2118 end;
2119
2120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2122 begin
2123   result := glBitmapDefaultDeleteTextureOnFree;
2124 end;
2125
2126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2127 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2128 begin
2129   result := glBitmapDefaultFreeDataAfterGenTextures;
2130 end;
2131
2132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2133 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2134 begin
2135   result := glBitmapDefaultMipmap;
2136 end;
2137
2138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2139 function glBitmapGetDefaultFormat: TglBitmapFormat;
2140 begin
2141   result := glBitmapDefaultFormat;
2142 end;
2143
2144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2145 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2146 begin
2147   aMin := glBitmapDefaultFilterMin;
2148   aMag := glBitmapDefaultFilterMag;
2149 end;
2150
2151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2152 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2153 begin
2154   S := glBitmapDefaultWrapS;
2155   T := glBitmapDefaultWrapT;
2156   R := glBitmapDefaultWrapR;
2157 end;
2158
2159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2160 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2162 function TFormatDescriptor.GetRedMask: QWord;
2163 begin
2164   result := fRange.r shl fShift.r;
2165 end;
2166
2167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2168 function TFormatDescriptor.GetGreenMask: QWord;
2169 begin
2170   result := fRange.g shl fShift.g;
2171 end;
2172
2173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 function TFormatDescriptor.GetBlueMask: QWord;
2175 begin
2176   result := fRange.b shl fShift.b;
2177 end;
2178
2179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2180 function TFormatDescriptor.GetAlphaMask: QWord;
2181 begin
2182   result := fRange.a shl fShift.a;
2183 end;
2184
2185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2186 function TFormatDescriptor.GetComponents: Integer;
2187 var
2188   i: Integer;
2189 begin
2190   result := 0;
2191   for i := 0 to 3 do
2192     if (fRange.arr[i] > 0) then
2193       inc(result);
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2198 var
2199   w, h: Integer;
2200 begin
2201   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2202     w := Max(1, aSize.X);
2203     h := Max(1, aSize.Y);
2204     result := GetSize(w, h);
2205   end else
2206     result := 0;
2207 end;
2208
2209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2210 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2211 begin
2212   result := 0;
2213   if (aWidth <= 0) or (aHeight <= 0) then
2214     exit;
2215   result := Ceil(aWidth * aHeight * fPixelSize);
2216 end;
2217
2218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2219 function TFormatDescriptor.CreateMappingData: Pointer;
2220 begin
2221   result := nil;
2222 end;
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2226 begin
2227   //DUMMY
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 function TFormatDescriptor.IsEmpty: Boolean;
2232 begin
2233   result := (fFormat = tfEmpty);
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 function TFormatDescriptor.HasAlpha: Boolean;
2238 begin
2239   result := (fRange.a > 0);
2240 end;
2241
2242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2244 begin
2245   result := false;
2246   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2247     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2248   if (aRedMask   <> RedMask) then
2249     exit;
2250   if (aGreenMask <> GreenMask) then
2251     exit;
2252   if (aBlueMask  <> BlueMask) then
2253     exit;
2254   if (aAlphaMask <> AlphaMask) then
2255     exit;
2256   result := true;
2257 end;
2258
2259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2260 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2261 begin
2262   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2263   aPixel.Data   := fRange;
2264   aPixel.Range  := fRange;
2265   aPixel.Format := fFormat;
2266 end;
2267
2268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2269 constructor TFormatDescriptor.Create;
2270 begin
2271   inherited Create;
2272
2273   fFormat       := tfEmpty;
2274   fWithAlpha    := tfEmpty;
2275   fWithoutAlpha := tfEmpty;
2276   fRGBInverted  := tfEmpty;
2277   fUncompressed := tfEmpty;
2278   fPixelSize    := 0.0;
2279   fIsCompressed := false;
2280
2281   fglFormat         := 0;
2282   fglInternalFormat := 0;
2283   fglDataFormat     := 0;
2284
2285   FillChar(fRange, 0, SizeOf(fRange));
2286   FillChar(fShift, 0, SizeOf(fShift));
2287 end;
2288
2289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2290 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2292 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2293 begin
2294   aData^ := aPixel.Data.a;
2295   inc(aData);
2296 end;
2297
2298 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2299 begin
2300   aPixel.Data.r := 0;
2301   aPixel.Data.g := 0;
2302   aPixel.Data.b := 0;
2303   aPixel.Data.a := aData^;
2304   inc(aData);
2305 end;
2306
2307 constructor TfdAlpha_UB1.Create;
2308 begin
2309   inherited Create;
2310   fPixelSize        := 1.0;
2311   fRange.a          := $FF;
2312   fglFormat         := GL_ALPHA;
2313   fglDataFormat     := GL_UNSIGNED_BYTE;
2314 end;
2315
2316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2317 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2320 begin
2321   aData^ := LuminanceWeight(aPixel);
2322   inc(aData);
2323 end;
2324
2325 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2326 begin
2327   aPixel.Data.r := aData^;
2328   aPixel.Data.g := aData^;
2329   aPixel.Data.b := aData^;
2330   aPixel.Data.a := 0;
2331   inc(aData);
2332 end;
2333
2334 constructor TfdLuminance_UB1.Create;
2335 begin
2336   inherited Create;
2337   fPixelSize        := 1.0;
2338   fRange.r          := $FF;
2339   fRange.g          := $FF;
2340   fRange.b          := $FF;
2341   fglFormat         := GL_LUMINANCE;
2342   fglDataFormat     := GL_UNSIGNED_BYTE;
2343 end;
2344
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2349 var
2350   i: Integer;
2351 begin
2352   aData^ := 0;
2353   for i := 0 to 3 do
2354     if (fRange.arr[i] > 0) then
2355       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2356   inc(aData);
2357 end;
2358
2359 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2360 var
2361   i: Integer;
2362 begin
2363   for i := 0 to 3 do
2364     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2365   inc(aData);
2366 end;
2367
2368 constructor TfdUniversal_UB1.Create;
2369 begin
2370   inherited Create;
2371   fPixelSize := 1.0;
2372 end;
2373
2374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2375 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2378 begin
2379   inherited Map(aPixel, aData, aMapData);
2380   aData^ := aPixel.Data.a;
2381   inc(aData);
2382 end;
2383
2384 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2385 begin
2386   inherited Unmap(aData, aPixel, aMapData);
2387   aPixel.Data.a := aData^;
2388   inc(aData);
2389 end;
2390
2391 constructor TfdLuminanceAlpha_UB2.Create;
2392 begin
2393   inherited Create;
2394   fPixelSize        := 2.0;
2395   fRange.a          := $FF;
2396   fShift.a          :=   8;
2397   fglFormat         := GL_LUMINANCE_ALPHA;
2398   fglDataFormat     := GL_UNSIGNED_BYTE;
2399 end;
2400
2401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2405 begin
2406   aData^ := aPixel.Data.r;
2407   inc(aData);
2408   aData^ := aPixel.Data.g;
2409   inc(aData);
2410   aData^ := aPixel.Data.b;
2411   inc(aData);
2412 end;
2413
2414 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2415 begin
2416   aPixel.Data.r := aData^;
2417   inc(aData);
2418   aPixel.Data.g := aData^;
2419   inc(aData);
2420   aPixel.Data.b := aData^;
2421   inc(aData);
2422   aPixel.Data.a := 0;
2423 end;
2424
2425 constructor TfdRGB_UB3.Create;
2426 begin
2427   inherited Create;
2428   fPixelSize        := 3.0;
2429   fRange.r          := $FF;
2430   fRange.g          := $FF;
2431   fRange.b          := $FF;
2432   fShift.r          :=   0;
2433   fShift.g          :=   8;
2434   fShift.b          :=  16;
2435   fglFormat         := GL_RGB;
2436   fglDataFormat     := GL_UNSIGNED_BYTE;
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2442 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2443 begin
2444   aData^ := aPixel.Data.b;
2445   inc(aData);
2446   aData^ := aPixel.Data.g;
2447   inc(aData);
2448   aData^ := aPixel.Data.r;
2449   inc(aData);
2450 end;
2451
2452 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2453 begin
2454   aPixel.Data.b := aData^;
2455   inc(aData);
2456   aPixel.Data.g := aData^;
2457   inc(aData);
2458   aPixel.Data.r := aData^;
2459   inc(aData);
2460   aPixel.Data.a := 0;
2461 end;
2462
2463 constructor TfdBGR_UB3.Create;
2464 begin
2465   fPixelSize        := 3.0;
2466   fRange.r          := $FF;
2467   fRange.g          := $FF;
2468   fRange.b          := $FF;
2469   fShift.r          :=  16;
2470   fShift.g          :=   8;
2471   fShift.b          :=   0;
2472   fglFormat         := GL_BGR;
2473   fglDataFormat     := GL_UNSIGNED_BYTE;
2474 end;
2475
2476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2477 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2480 begin
2481   inherited Map(aPixel, aData, aMapData);
2482   aData^ := aPixel.Data.a;
2483   inc(aData);
2484 end;
2485
2486 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2487 begin
2488   inherited Unmap(aData, aPixel, aMapData);
2489   aPixel.Data.a := aData^;
2490   inc(aData);
2491 end;
2492
2493 constructor TfdRGBA_UB4.Create;
2494 begin
2495   inherited Create;
2496   fPixelSize        := 4.0;
2497   fRange.a          := $FF;
2498   fShift.a          :=  24;
2499   fglFormat         := GL_RGBA;
2500   fglDataFormat     := GL_UNSIGNED_BYTE;
2501 end;
2502
2503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2504 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2506 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2507 begin
2508   inherited Map(aPixel, aData, aMapData);
2509   aData^ := aPixel.Data.a;
2510   inc(aData);
2511 end;
2512
2513 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2514 begin
2515   inherited Unmap(aData, aPixel, aMapData);
2516   aPixel.Data.a := aData^;
2517   inc(aData);
2518 end;
2519
2520 constructor TfdBGRA_UB4.Create;
2521 begin
2522   inherited Create;
2523   fPixelSize        := 4.0;
2524   fRange.a          := $FF;
2525   fShift.a          :=  24;
2526   fglFormat         := GL_BGRA;
2527   fglDataFormat     := GL_UNSIGNED_BYTE;
2528 end;
2529
2530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2531 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2533 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2534 begin
2535   PWord(aData)^ := aPixel.Data.a;
2536   inc(aData, 2);
2537 end;
2538
2539 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2540 begin
2541   aPixel.Data.r := 0;
2542   aPixel.Data.g := 0;
2543   aPixel.Data.b := 0;
2544   aPixel.Data.a := PWord(aData)^;
2545   inc(aData, 2);
2546 end;
2547
2548 constructor TfdAlpha_US1.Create;
2549 begin
2550   inherited Create;
2551   fPixelSize        := 2.0;
2552   fRange.a          := $FFFF;
2553   fglFormat         := GL_ALPHA;
2554   fglDataFormat     := GL_UNSIGNED_SHORT;
2555 end;
2556
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2561 begin
2562   PWord(aData)^ := LuminanceWeight(aPixel);
2563   inc(aData, 2);
2564 end;
2565
2566 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2567 begin
2568   aPixel.Data.r := PWord(aData)^;
2569   aPixel.Data.g := PWord(aData)^;
2570   aPixel.Data.b := PWord(aData)^;
2571   aPixel.Data.a := 0;
2572   inc(aData, 2);
2573 end;
2574
2575 constructor TfdLuminance_US1.Create;
2576 begin
2577   inherited Create;
2578   fPixelSize        := 2.0;
2579   fRange.r          := $FFFF;
2580   fRange.g          := $FFFF;
2581   fRange.b          := $FFFF;
2582   fglFormat         := GL_LUMINANCE;
2583   fglDataFormat     := GL_UNSIGNED_SHORT;
2584 end;
2585
2586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2589 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2590 var
2591   i: Integer;
2592 begin
2593   PWord(aData)^ := 0;
2594   for i := 0 to 3 do
2595     if (fRange.arr[i] > 0) then
2596       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2597   inc(aData, 2);
2598 end;
2599
2600 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2601 var
2602   i: Integer;
2603 begin
2604   for i := 0 to 3 do
2605     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2606   inc(aData, 2);
2607 end;
2608
2609 constructor TfdUniversal_US1.Create;
2610 begin
2611   inherited Create;
2612   fPixelSize := 2.0;
2613 end;
2614
2615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2618 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2619 begin
2620   PWord(aData)^ := DepthWeight(aPixel);
2621   inc(aData, 2);
2622 end;
2623
2624 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2625 begin
2626   aPixel.Data.r := PWord(aData)^;
2627   aPixel.Data.g := PWord(aData)^;
2628   aPixel.Data.b := PWord(aData)^;
2629   aPixel.Data.a := 0;
2630   inc(aData, 2);
2631 end;
2632
2633 constructor TfdDepth_US1.Create;
2634 begin
2635   inherited Create;
2636   fPixelSize        := 2.0;
2637   fRange.r          := $FFFF;
2638   fRange.g          := $FFFF;
2639   fRange.b          := $FFFF;
2640   fglFormat         := GL_DEPTH_COMPONENT;
2641   fglDataFormat     := GL_UNSIGNED_SHORT;
2642 end;
2643
2644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2648 begin
2649   inherited Map(aPixel, aData, aMapData);
2650   PWord(aData)^ := aPixel.Data.a;
2651   inc(aData, 2);
2652 end;
2653
2654 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2655 begin
2656   inherited Unmap(aData, aPixel, aMapData);
2657   aPixel.Data.a := PWord(aData)^;
2658   inc(aData, 2);
2659 end;
2660
2661 constructor TfdLuminanceAlpha_US2.Create;
2662 begin
2663   inherited Create;
2664   fPixelSize        :=   4.0;
2665   fRange.a          := $FFFF;
2666   fShift.a          :=    16;
2667   fglFormat         := GL_LUMINANCE_ALPHA;
2668   fglDataFormat     := GL_UNSIGNED_SHORT;
2669 end;
2670
2671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2675 begin
2676   PWord(aData)^ := aPixel.Data.r;
2677   inc(aData, 2);
2678   PWord(aData)^ := aPixel.Data.g;
2679   inc(aData, 2);
2680   PWord(aData)^ := aPixel.Data.b;
2681   inc(aData, 2);
2682 end;
2683
2684 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2685 begin
2686   aPixel.Data.r := PWord(aData)^;
2687   inc(aData, 2);
2688   aPixel.Data.g := PWord(aData)^;
2689   inc(aData, 2);
2690   aPixel.Data.b := PWord(aData)^;
2691   inc(aData, 2);
2692   aPixel.Data.a := 0;
2693 end;
2694
2695 constructor TfdRGB_US3.Create;
2696 begin
2697   inherited Create;
2698   fPixelSize        :=   6.0;
2699   fRange.r          := $FFFF;
2700   fRange.g          := $FFFF;
2701   fRange.b          := $FFFF;
2702   fShift.r          :=     0;
2703   fShift.g          :=    16;
2704   fShift.b          :=    32;
2705   fglFormat         := GL_RGB;
2706   fglDataFormat     := GL_UNSIGNED_SHORT;
2707 end;
2708
2709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2710 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2712 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2713 begin
2714   PWord(aData)^ := aPixel.Data.b;
2715   inc(aData, 2);
2716   PWord(aData)^ := aPixel.Data.g;
2717   inc(aData, 2);
2718   PWord(aData)^ := aPixel.Data.r;
2719   inc(aData, 2);
2720 end;
2721
2722 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2723 begin
2724   aPixel.Data.b := PWord(aData)^;
2725   inc(aData, 2);
2726   aPixel.Data.g := PWord(aData)^;
2727   inc(aData, 2);
2728   aPixel.Data.r := PWord(aData)^;
2729   inc(aData, 2);
2730   aPixel.Data.a := 0;
2731 end;
2732
2733 constructor TfdBGR_US3.Create;
2734 begin
2735   inherited Create;
2736   fPixelSize        :=   6.0;
2737   fRange.r          := $FFFF;
2738   fRange.g          := $FFFF;
2739   fRange.b          := $FFFF;
2740   fShift.r          :=    32;
2741   fShift.g          :=    16;
2742   fShift.b          :=     0;
2743   fglFormat         := GL_BGR;
2744   fglDataFormat     := GL_UNSIGNED_SHORT;
2745 end;
2746
2747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2748 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2750 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2751 begin
2752   inherited Map(aPixel, aData, aMapData);
2753   PWord(aData)^ := aPixel.Data.a;
2754   inc(aData, 2);
2755 end;
2756
2757 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2758 begin
2759   inherited Unmap(aData, aPixel, aMapData);
2760   aPixel.Data.a := PWord(aData)^;
2761   inc(aData, 2);
2762 end;
2763
2764 constructor TfdRGBA_US4.Create;
2765 begin
2766   inherited Create;
2767   fPixelSize        :=   8.0;
2768   fRange.a          := $FFFF;
2769   fShift.a          :=    48;
2770   fglFormat         := GL_RGBA;
2771   fglDataFormat     := GL_UNSIGNED_SHORT;
2772 end;
2773
2774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2777 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2778 begin
2779   inherited Map(aPixel, aData, aMapData);
2780   PWord(aData)^ := aPixel.Data.a;
2781   inc(aData, 2);
2782 end;
2783
2784 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2785 begin
2786   inherited Unmap(aData, aPixel, aMapData);
2787   aPixel.Data.a := PWord(aData)^;
2788   inc(aData, 2);
2789 end;
2790
2791 constructor TfdBGRA_US4.Create;
2792 begin
2793   inherited Create;
2794   fPixelSize        :=   8.0;
2795   fRange.a          := $FFFF;
2796   fShift.a          :=    48;
2797   fglFormat         := GL_BGRA;
2798   fglDataFormat     := GL_UNSIGNED_SHORT;
2799 end;
2800
2801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2802 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2804 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2805 var
2806   i: Integer;
2807 begin
2808   PCardinal(aData)^ := 0;
2809   for i := 0 to 3 do
2810     if (fRange.arr[i] > 0) then
2811       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2812   inc(aData, 4);
2813 end;
2814
2815 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2816 var
2817   i: Integer;
2818 begin
2819   for i := 0 to 3 do
2820     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2821   inc(aData, 2);
2822 end;
2823
2824 constructor TfdUniversal_UI1.Create;
2825 begin
2826   inherited Create;
2827   fPixelSize := 4.0;
2828 end;
2829
2830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2831 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2833 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2834 begin
2835   PCardinal(aData)^ := DepthWeight(aPixel);
2836   inc(aData, 4);
2837 end;
2838
2839 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2840 begin
2841   aPixel.Data.r := PCardinal(aData)^;
2842   aPixel.Data.g := PCardinal(aData)^;
2843   aPixel.Data.b := PCardinal(aData)^;
2844   aPixel.Data.a := 0;
2845   inc(aData, 4);
2846 end;
2847
2848 constructor TfdDepth_UI1.Create;
2849 begin
2850   inherited Create;
2851   fPixelSize        := 4.0;
2852   fRange.r          := $FFFFFFFF;
2853   fRange.g          := $FFFFFFFF;
2854   fRange.b          := $FFFFFFFF;
2855   fglFormat         := GL_DEPTH_COMPONENT;
2856   fglDataFormat     := GL_UNSIGNED_INT;
2857 end;
2858
2859 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2860 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2862 constructor TfdAlpha4.Create;
2863 begin
2864   inherited Create;
2865   fFormat           := tfAlpha4;
2866   fWithAlpha        := tfAlpha4;
2867   fglInternalFormat := GL_ALPHA4;
2868 end;
2869
2870 constructor TfdAlpha8.Create;
2871 begin
2872   inherited Create;
2873   fFormat           := tfAlpha8;
2874   fWithAlpha        := tfAlpha8;
2875   fglInternalFormat := GL_ALPHA8;
2876 end;
2877
2878 constructor TfdAlpha12.Create;
2879 begin
2880   inherited Create;
2881   fFormat           := tfAlpha12;
2882   fWithAlpha        := tfAlpha12;
2883   fglInternalFormat := GL_ALPHA12;
2884 end;
2885
2886 constructor TfdAlpha16.Create;
2887 begin
2888   inherited Create;
2889   fFormat           := tfAlpha16;
2890   fWithAlpha        := tfAlpha16;
2891   fglInternalFormat := GL_ALPHA16;
2892 end;
2893
2894 constructor TfdLuminance4.Create;
2895 begin
2896   inherited Create;
2897   fFormat           := tfLuminance4;
2898   fWithAlpha        := tfLuminance4Alpha4;
2899   fWithoutAlpha     := tfLuminance4;
2900   fglInternalFormat := GL_LUMINANCE4;
2901 end;
2902
2903 constructor TfdLuminance8.Create;
2904 begin
2905   inherited Create;
2906   fFormat           := tfLuminance8;
2907   fWithAlpha        := tfLuminance8Alpha8;
2908   fWithoutAlpha     := tfLuminance8;
2909   fglInternalFormat := GL_LUMINANCE8;
2910 end;
2911
2912 constructor TfdLuminance12.Create;
2913 begin
2914   inherited Create;
2915   fFormat           := tfLuminance12;
2916   fWithAlpha        := tfLuminance12Alpha12;
2917   fWithoutAlpha     := tfLuminance12;
2918   fglInternalFormat := GL_LUMINANCE12;
2919 end;
2920
2921 constructor TfdLuminance16.Create;
2922 begin
2923   inherited Create;
2924   fFormat           := tfLuminance16;
2925   fWithAlpha        := tfLuminance16Alpha16;
2926   fWithoutAlpha     := tfLuminance16;
2927   fglInternalFormat := GL_LUMINANCE16;
2928 end;
2929
2930 constructor TfdLuminance4Alpha4.Create;
2931 begin
2932   inherited Create;
2933   fFormat           := tfLuminance4Alpha4;
2934   fWithAlpha        := tfLuminance4Alpha4;
2935   fWithoutAlpha     := tfLuminance4;
2936   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2937 end;
2938
2939 constructor TfdLuminance6Alpha2.Create;
2940 begin
2941   inherited Create;
2942   fFormat           := tfLuminance6Alpha2;
2943   fWithAlpha        := tfLuminance6Alpha2;
2944   fWithoutAlpha     := tfLuminance8;
2945   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2946 end;
2947
2948 constructor TfdLuminance8Alpha8.Create;
2949 begin
2950   inherited Create;
2951   fFormat           := tfLuminance8Alpha8;
2952   fWithAlpha        := tfLuminance8Alpha8;
2953   fWithoutAlpha     := tfLuminance8;
2954   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
2955 end;
2956
2957 constructor TfdLuminance12Alpha4.Create;
2958 begin
2959   inherited Create;
2960   fFormat           := tfLuminance12Alpha4;
2961   fWithAlpha        := tfLuminance12Alpha4;
2962   fWithoutAlpha     := tfLuminance12;
2963   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2964 end;
2965
2966 constructor TfdLuminance12Alpha12.Create;
2967 begin
2968   inherited Create;
2969   fFormat           := tfLuminance12Alpha12;
2970   fWithAlpha        := tfLuminance12Alpha12;
2971   fWithoutAlpha     := tfLuminance12;
2972   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
2973 end;
2974
2975 constructor TfdLuminance16Alpha16.Create;
2976 begin
2977   inherited Create;
2978   fFormat           := tfLuminance16Alpha16;
2979   fWithAlpha        := tfLuminance16Alpha16;
2980   fWithoutAlpha     := tfLuminance16;
2981   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2982 end;
2983
2984 constructor TfdR3G3B2.Create;
2985 begin
2986   inherited Create;
2987   fFormat           := tfR3G3B2;
2988   fWithAlpha        := tfRGBA2;
2989   fWithoutAlpha     := tfR3G3B2;
2990   fRange.r          := $7;
2991   fRange.g          := $7;
2992   fRange.b          := $3;
2993   fShift.r          :=  0;
2994   fShift.g          :=  3;
2995   fShift.b          :=  6;
2996   fglFormat         := GL_RGB;
2997   fglInternalFormat := GL_R3_G3_B2;
2998   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
2999 end;
3000
3001 constructor TfdRGB4.Create;
3002 begin
3003   inherited Create;
3004   fFormat           := tfRGB4;
3005   fWithAlpha        := tfRGBA4;
3006   fWithoutAlpha     := tfRGB4;
3007   fRGBInverted      := tfBGR4;
3008   fRange.r          := $F;
3009   fRange.g          := $F;
3010   fRange.b          := $F;
3011   fShift.r          :=  0;
3012   fShift.g          :=  4;
3013   fShift.b          :=  8;
3014   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3015   fglInternalFormat := GL_RGB4;
3016   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3017 end;
3018
3019 constructor TfdR5G6B5.Create;
3020 begin
3021   inherited Create;
3022   fFormat           := tfR5G6B5;
3023   fWithAlpha        := tfRGBA4;
3024   fWithoutAlpha     := tfR5G6B5;
3025   fRGBInverted      := tfB5G6R5;
3026   fRange.r          := $1F;
3027   fRange.g          := $3F;
3028   fRange.b          := $1F;
3029   fShift.r          :=   0;
3030   fShift.g          :=   5;
3031   fShift.b          :=  11;
3032   fglFormat         := GL_RGB;
3033   fglInternalFormat := GL_RGB565;
3034   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3035 end;
3036
3037 constructor TfdRGB5.Create;
3038 begin
3039   inherited Create;
3040   fFormat           := tfRGB5;
3041   fWithAlpha        := tfRGB5A1;
3042   fWithoutAlpha     := tfRGB5;
3043   fRGBInverted      := tfBGR5;
3044   fRange.r          := $1F;
3045   fRange.g          := $1F;
3046   fRange.b          := $1F;
3047   fShift.r          :=   0;
3048   fShift.g          :=   5;
3049   fShift.b          :=  10;
3050   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3051   fglInternalFormat := GL_RGB5;
3052   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3053 end;
3054
3055 constructor TfdRGB8.Create;
3056 begin
3057   inherited Create;
3058   fFormat           := tfRGB8;
3059   fWithAlpha        := tfRGBA8;
3060   fWithoutAlpha     := tfRGB8;
3061   fRGBInverted      := tfBGR8;
3062   fglInternalFormat := GL_RGB8;
3063 end;
3064
3065 constructor TfdRGB10.Create;
3066 begin
3067   inherited Create;
3068   fFormat           := tfRGB10;
3069   fWithAlpha        := tfRGB10A2;
3070   fWithoutAlpha     := tfRGB10;
3071   fRGBInverted      := tfBGR10;
3072   fRange.r          := $3FF;
3073   fRange.g          := $3FF;
3074   fRange.b          := $3FF;
3075   fShift.r          :=    0;
3076   fShift.g          :=   10;
3077   fShift.b          :=   20;
3078   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3079   fglInternalFormat := GL_RGB10;
3080   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3081 end;
3082
3083 constructor TfdRGB12.Create;
3084 begin
3085   inherited Create;
3086   fFormat           := tfRGB12;
3087   fWithAlpha        := tfRGBA12;
3088   fWithoutAlpha     := tfRGB12;
3089   fRGBInverted      := tfBGR12;
3090   fglInternalFormat := GL_RGB12;
3091 end;
3092
3093 constructor TfdRGB16.Create;
3094 begin
3095   inherited Create;
3096   fFormat           := tfRGB16;
3097   fWithAlpha        := tfRGBA16;
3098   fWithoutAlpha     := tfRGB16;
3099   fRGBInverted      := tfBGR16;
3100   fglInternalFormat := GL_RGB16;
3101 end;
3102
3103 constructor TfdRGBA2.Create;
3104 begin
3105   inherited Create;
3106   fFormat           := tfRGBA2;
3107   fWithAlpha        := tfRGBA2;
3108   fWithoutAlpha     := tfR3G3B2;
3109   fRGBInverted      := tfBGRA2;
3110   fglInternalFormat := GL_RGBA2;
3111 end;
3112
3113 constructor TfdRGBA4.Create;
3114 begin
3115   inherited Create;
3116   fFormat           := tfRGBA4;
3117   fWithAlpha        := tfRGBA4;
3118   fWithoutAlpha     := tfRGB4;
3119   fRGBInverted      := tfBGRA4;
3120   fRange.r          := $F;
3121   fRange.g          := $F;
3122   fRange.b          := $F;
3123   fRange.a          := $F;
3124   fShift.r          :=  0;
3125   fShift.g          :=  4;
3126   fShift.b          :=  8;
3127   fShift.a          := 12;
3128   fglFormat         := GL_RGBA;
3129   fglInternalFormat := GL_RGBA4;
3130   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3131 end;
3132
3133 constructor TfdRGB5A1.Create;
3134 begin
3135   inherited Create;
3136   fFormat           := tfRGB5A1;
3137   fWithAlpha        := tfRGB5A1;
3138   fWithoutAlpha     := tfRGB5;
3139   fRGBInverted      := tfBGR5A1;
3140   fRange.r          := $1F;
3141   fRange.g          := $1F;
3142   fRange.b          := $1F;
3143   fRange.a          := $01;
3144   fShift.r          :=   0;
3145   fShift.g          :=   5;
3146   fShift.b          :=  10;
3147   fShift.a          :=  15;
3148   fglFormat         := GL_RGBA;
3149   fglInternalFormat := GL_RGB5_A1;
3150   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3151 end;
3152
3153 constructor TfdRGBA8.Create;
3154 begin
3155   inherited Create;
3156   fFormat           := tfRGBA8;
3157   fWithAlpha        := tfRGBA8;
3158   fWithoutAlpha     := tfRGB8;
3159   fRGBInverted      := tfBGRA8;
3160   fglInternalFormat := GL_RGBA8;
3161 end;
3162
3163 constructor TfdRGB10A2.Create;
3164 begin
3165   inherited Create;
3166   fFormat           := tfRGB10A2;
3167   fWithAlpha        := tfRGB10A2;
3168   fWithoutAlpha     := tfRGB10;
3169   fRGBInverted      := tfBGR10A2;
3170   fRange.r          := $3FF;
3171   fRange.g          := $3FF;
3172   fRange.b          := $3FF;
3173   fRange.a          := $003;
3174   fShift.r          :=    0;
3175   fShift.g          :=   10;
3176   fShift.b          :=   20;
3177   fShift.a          :=   30;
3178   fglFormat         := GL_RGBA;
3179   fglInternalFormat := GL_RGB10_A2;
3180   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3181 end;
3182
3183 constructor TfdRGBA12.Create;
3184 begin
3185   inherited Create;
3186   fFormat           := tfRGBA12;
3187   fWithAlpha        := tfRGBA12;
3188   fWithoutAlpha     := tfRGB12;
3189   fRGBInverted      := tfBGRA12;
3190   fglInternalFormat := GL_RGBA12;
3191 end;
3192
3193 constructor TfdRGBA16.Create;
3194 begin
3195   inherited Create;
3196   fFormat           := tfRGBA16;
3197   fWithAlpha        := tfRGBA16;
3198   fWithoutAlpha     := tfRGB16;
3199   fRGBInverted      := tfBGRA16;
3200   fglInternalFormat := GL_RGBA16;
3201 end;
3202
3203 constructor TfdBGR4.Create;
3204 begin
3205   inherited Create;
3206   fPixelSize        := 2.0;
3207   fFormat           := tfBGR4;
3208   fWithAlpha        := tfBGRA4;
3209   fWithoutAlpha     := tfBGR4;
3210   fRGBInverted      := tfRGB4;
3211   fRange.r          := $F;
3212   fRange.g          := $F;
3213   fRange.b          := $F;
3214   fRange.a          := $0;
3215   fShift.r          :=  8;
3216   fShift.g          :=  4;
3217   fShift.b          :=  0;
3218   fShift.a          :=  0;
3219   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3220   fglInternalFormat := GL_RGB4;
3221   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3222 end;
3223
3224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3227 constructor TfdB5G6R5.Create;
3228 begin
3229   inherited Create;
3230   fFormat           := tfB5G6R5;
3231   fWithAlpha        := tfBGRA4;
3232   fWithoutAlpha     := tfB5G6R5;
3233   fRGBInverted      := tfR5G6B5;
3234   fRange.r          := $1F;
3235   fRange.g          := $3F;
3236   fRange.b          := $1F;
3237   fShift.r          :=  11;
3238   fShift.g          :=   5;
3239   fShift.b          :=   0;
3240   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3241   fglInternalFormat := GL_RGB8;
3242   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3243 end;
3244
3245 constructor TfdBGR5.Create;
3246 begin
3247   inherited Create;
3248   fPixelSize        := 2.0;
3249   fFormat           := tfBGR5;
3250   fWithAlpha        := tfBGR5A1;
3251   fWithoutAlpha     := tfBGR5;
3252   fRGBInverted      := tfRGB5;
3253   fRange.r          := $1F;
3254   fRange.g          := $1F;
3255   fRange.b          := $1F;
3256   fRange.a          := $00;
3257   fShift.r          :=  10;
3258   fShift.g          :=   5;
3259   fShift.b          :=   0;
3260   fShift.a          :=   0;
3261   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3262   fglInternalFormat := GL_RGB5;
3263   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3264 end;
3265
3266 constructor TfdBGR8.Create;
3267 begin
3268   inherited Create;
3269   fFormat           := tfBGR8;
3270   fWithAlpha        := tfBGRA8;
3271   fWithoutAlpha     := tfBGR8;
3272   fRGBInverted      := tfRGB8;
3273   fglInternalFormat := GL_RGB8;
3274 end;
3275
3276 constructor TfdBGR10.Create;
3277 begin
3278   inherited Create;
3279   fFormat           := tfBGR10;
3280   fWithAlpha        := tfBGR10A2;
3281   fWithoutAlpha     := tfBGR10;
3282   fRGBInverted      := tfRGB10;
3283   fRange.r          := $3FF;
3284   fRange.g          := $3FF;
3285   fRange.b          := $3FF;
3286   fRange.a          := $000;
3287   fShift.r          :=   20;
3288   fShift.g          :=   10;
3289   fShift.b          :=    0;
3290   fShift.a          :=    0;
3291   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3292   fglInternalFormat := GL_RGB10;
3293   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3294 end;
3295
3296 constructor TfdBGR12.Create;
3297 begin
3298   inherited Create;
3299   fFormat           := tfBGR12;
3300   fWithAlpha        := tfBGRA12;
3301   fWithoutAlpha     := tfBGR12;
3302   fRGBInverted      := tfRGB12;
3303   fglInternalFormat := GL_RGB12;
3304 end;
3305
3306 constructor TfdBGR16.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfBGR16;
3310   fWithAlpha        := tfBGRA16;
3311   fWithoutAlpha     := tfBGR16;
3312   fRGBInverted      := tfRGB16;
3313   fglInternalFormat := GL_RGB16;
3314 end;
3315
3316 constructor TfdBGRA2.Create;
3317 begin
3318   inherited Create;
3319   fFormat           := tfBGRA2;
3320   fWithAlpha        := tfBGRA4;
3321   fWithoutAlpha     := tfBGR4;
3322   fRGBInverted      := tfRGBA2;
3323   fglInternalFormat := GL_RGBA2;
3324 end;
3325
3326 constructor TfdBGRA4.Create;
3327 begin
3328   inherited Create;
3329   fFormat           := tfBGRA4;
3330   fWithAlpha        := tfBGRA4;
3331   fWithoutAlpha     := tfBGR4;
3332   fRGBInverted      := tfRGBA4;
3333   fRange.r          := $F;
3334   fRange.g          := $F;
3335   fRange.b          := $F;
3336   fRange.a          := $F;
3337   fShift.r          :=  8;
3338   fShift.g          :=  4;
3339   fShift.b          :=  0;
3340   fShift.a          := 12;
3341   fglFormat         := GL_BGRA;
3342   fglInternalFormat := GL_RGBA4;
3343   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3344 end;
3345
3346 constructor TfdBGR5A1.Create;
3347 begin
3348   inherited Create;
3349   fFormat           := tfBGR5A1;
3350   fWithAlpha        := tfBGR5A1;
3351   fWithoutAlpha     := tfBGR5;
3352   fRGBInverted      := tfRGB5A1;
3353   fRange.r          := $1F;
3354   fRange.g          := $1F;
3355   fRange.b          := $1F;
3356   fRange.a          := $01;
3357   fShift.r          :=  10;
3358   fShift.g          :=   5;
3359   fShift.b          :=   0;
3360   fShift.a          :=  15;
3361   fglFormat         := GL_BGRA;
3362   fglInternalFormat := GL_RGB5_A1;
3363   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3364 end;
3365
3366 constructor TfdBGRA8.Create;
3367 begin
3368   inherited Create;
3369   fFormat           := tfBGRA8;
3370   fWithAlpha        := tfBGRA8;
3371   fWithoutAlpha     := tfBGR8;
3372   fRGBInverted      := tfRGBA8;
3373   fglInternalFormat := GL_RGBA8;
3374 end;
3375
3376 constructor TfdBGR10A2.Create;
3377 begin
3378   inherited Create;
3379   fFormat           := tfBGR10A2;
3380   fWithAlpha        := tfBGR10A2;
3381   fWithoutAlpha     := tfBGR10;
3382   fRGBInverted      := tfRGB10A2;
3383   fRange.r          := $3FF;
3384   fRange.g          := $3FF;
3385   fRange.b          := $3FF;
3386   fRange.a          := $003;
3387   fShift.r          :=   20;
3388   fShift.g          :=   10;
3389   fShift.b          :=    0;
3390   fShift.a          :=   30;
3391   fglFormat         := GL_BGRA;
3392   fglInternalFormat := GL_RGB10_A2;
3393   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3394 end;
3395
3396 constructor TfdBGRA12.Create;
3397 begin
3398   inherited Create;
3399   fFormat           := tfBGRA12;
3400   fWithAlpha        := tfBGRA12;
3401   fWithoutAlpha     := tfBGR12;
3402   fRGBInverted      := tfRGBA12;
3403   fglInternalFormat := GL_RGBA12;
3404 end;
3405
3406 constructor TfdBGRA16.Create;
3407 begin
3408   inherited Create;
3409   fFormat           := tfBGRA16;
3410   fWithAlpha        := tfBGRA16;
3411   fWithoutAlpha     := tfBGR16;
3412   fRGBInverted      := tfRGBA16;
3413   fglInternalFormat := GL_RGBA16;
3414 end;
3415
3416 constructor TfdDepth16.Create;
3417 begin
3418   inherited Create;
3419   fFormat           := tfDepth16;
3420   fWithAlpha        := tfEmpty;
3421   fWithoutAlpha     := tfDepth16;
3422   fglInternalFormat := GL_DEPTH_COMPONENT16;
3423 end;
3424
3425 constructor TfdDepth24.Create;
3426 begin
3427   inherited Create;
3428   fFormat           := tfDepth24;
3429   fWithAlpha        := tfEmpty;
3430   fWithoutAlpha     := tfDepth24;
3431   fglInternalFormat := GL_DEPTH_COMPONENT24;
3432 end;
3433
3434 constructor TfdDepth32.Create;
3435 begin
3436   inherited Create;
3437   fFormat           := tfDepth32;
3438   fWithAlpha        := tfEmpty;
3439   fWithoutAlpha     := tfDepth32;
3440   fglInternalFormat := GL_DEPTH_COMPONENT32;
3441 end;
3442
3443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3444 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3446 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3447 begin
3448   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3449 end;
3450
3451 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3452 begin
3453   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3454 end;
3455
3456 constructor TfdS3tcDtx1RGBA.Create;
3457 begin
3458   inherited Create;
3459   fFormat           := tfS3tcDtx1RGBA;
3460   fWithAlpha        := tfS3tcDtx1RGBA;
3461   fUncompressed     := tfRGB5A1;
3462   fPixelSize        := 0.5;
3463   fIsCompressed     := true;
3464   fglFormat         := GL_COMPRESSED_RGBA;
3465   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3466   fglDataFormat     := GL_UNSIGNED_BYTE;
3467 end;
3468
3469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3470 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3472 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3473 begin
3474   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3475 end;
3476
3477 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3478 begin
3479   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3480 end;
3481
3482 constructor TfdS3tcDtx3RGBA.Create;
3483 begin
3484   inherited Create;
3485   fFormat           := tfS3tcDtx3RGBA;
3486   fWithAlpha        := tfS3tcDtx3RGBA;
3487   fUncompressed     := tfRGBA8;
3488   fPixelSize        := 1.0;
3489   fIsCompressed     := true;
3490   fglFormat         := GL_COMPRESSED_RGBA;
3491   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3492   fglDataFormat     := GL_UNSIGNED_BYTE;
3493 end;
3494
3495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3496 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3498 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3499 begin
3500   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3501 end;
3502
3503 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3504 begin
3505   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3506 end;
3507
3508 constructor TfdS3tcDtx5RGBA.Create;
3509 begin
3510   inherited Create;
3511   fFormat           := tfS3tcDtx3RGBA;
3512   fWithAlpha        := tfS3tcDtx3RGBA;
3513   fUncompressed     := tfRGBA8;
3514   fPixelSize        := 1.0;
3515   fIsCompressed     := true;
3516   fglFormat         := GL_COMPRESSED_RGBA;
3517   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3518   fglDataFormat     := GL_UNSIGNED_BYTE;
3519 end;
3520
3521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3522 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3524 class procedure TFormatDescriptor.Init;
3525 begin
3526   if not Assigned(FormatDescriptorCS) then
3527     FormatDescriptorCS := TCriticalSection.Create;
3528 end;
3529
3530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3531 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3532 begin
3533   FormatDescriptorCS.Enter;
3534   try
3535     result := FormatDescriptors[aFormat];
3536     if not Assigned(result) then begin
3537       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3538       FormatDescriptors[aFormat] := result;
3539     end;
3540   finally
3541     FormatDescriptorCS.Leave;
3542   end;
3543 end;
3544
3545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3546 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3547 begin
3548   result := Get(Get(aFormat).WithAlpha);
3549 end;
3550
3551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3552 class procedure TFormatDescriptor.Clear;
3553 var
3554   f: TglBitmapFormat;
3555 begin
3556   FormatDescriptorCS.Enter;
3557   try
3558     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3559       FreeAndNil(FormatDescriptors[f]);
3560   finally
3561     FormatDescriptorCS.Leave;
3562   end;
3563 end;
3564
3565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3566 class procedure TFormatDescriptor.Finalize;
3567 begin
3568   Clear;
3569   FreeAndNil(FormatDescriptorCS);
3570 end;
3571
3572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3573 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3575 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3576 begin
3577   Update(aValue, fRange.r, fShift.r);
3578 end;
3579
3580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3581 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3582 begin
3583   Update(aValue, fRange.g, fShift.g);
3584 end;
3585
3586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3587 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3588 begin
3589   Update(aValue, fRange.b, fShift.b);
3590 end;
3591
3592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3593 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3594 begin
3595   Update(aValue, fRange.a, fShift.a);
3596 end;
3597
3598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3599 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3600   aShift: Byte);
3601 begin
3602   aShift := 0;
3603   aRange := 0;
3604   if (aMask = 0) then
3605     exit;
3606   while (aMask > 0) and ((aMask and 1) = 0) do begin
3607     inc(aShift);
3608     aMask := aMask shr 1;
3609   end;
3610   aRange := 1;
3611   while (aMask > 0) do begin
3612     aRange := aRange shl 1;
3613     aMask  := aMask  shr 1;
3614   end;
3615   dec(aRange);
3616
3617   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3618 end;
3619
3620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3621 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3622 var
3623   data: QWord;
3624   s: Integer;
3625 begin
3626   data :=
3627     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3628     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3629     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3630     ((aPixel.Data.a and fRange.a) shl fShift.a);
3631   s := Round(fPixelSize);
3632   case s of
3633     1:           aData^  := data;
3634     2:     PWord(aData)^ := data;
3635     4: PCardinal(aData)^ := data;
3636     8:    PQWord(aData)^ := data;
3637   else
3638     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3639   end;
3640   inc(aData, s);
3641 end;
3642
3643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3645 var
3646   data: QWord;
3647   s, i: Integer;
3648 begin
3649   s := Round(fPixelSize);
3650   case s of
3651     1: data :=           aData^;
3652     2: data :=     PWord(aData)^;
3653     4: data := PCardinal(aData)^;
3654     8: data :=    PQWord(aData)^;
3655   else
3656     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3657   end;
3658   for i := 0 to 3 do
3659     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3660   inc(aData, s);
3661 end;
3662
3663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3664 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 procedure TbmpColorTableFormat.CreateColorTable;
3667 var
3668   i: Integer;
3669 begin
3670   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3671     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3672
3673   if (Format = tfLuminance4) then
3674     SetLength(fColorTable, 16)
3675   else
3676     SetLength(fColorTable, 256);
3677
3678   case Format of
3679     tfLuminance4: begin
3680       for i := 0 to High(fColorTable) do begin
3681         fColorTable[i].r := 16 * i;
3682         fColorTable[i].g := 16 * i;
3683         fColorTable[i].b := 16 * i;
3684         fColorTable[i].a := 0;
3685       end;
3686     end;
3687
3688     tfLuminance8: begin
3689       for i := 0 to High(fColorTable) do begin
3690         fColorTable[i].r := i;
3691         fColorTable[i].g := i;
3692         fColorTable[i].b := i;
3693         fColorTable[i].a := 0;
3694       end;
3695     end;
3696
3697     tfR3G3B2: begin
3698       for i := 0 to High(fColorTable) do begin
3699         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3700         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3701         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3702         fColorTable[i].a := 0;
3703       end;
3704     end;
3705   end;
3706 end;
3707
3708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3709 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3710 var
3711   d: Byte;
3712 begin
3713   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3714     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3715
3716   case Format of
3717     tfLuminance4: begin
3718       if (aMapData = nil) then
3719         aData^ := 0;
3720       d := LuminanceWeight(aPixel) and Range.r;
3721       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3722       inc(PByte(aMapData), 4);
3723       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3724         inc(aData);
3725         aMapData := nil;
3726       end;
3727     end;
3728
3729     tfLuminance8: begin
3730       aData^ := LuminanceWeight(aPixel) and Range.r;
3731       inc(aData);
3732     end;
3733
3734     tfR3G3B2: begin
3735       aData^ := Round(
3736         ((aPixel.Data.r and Range.r) shl Shift.r) or
3737         ((aPixel.Data.g and Range.g) shl Shift.g) or
3738         ((aPixel.Data.b and Range.b) shl Shift.b));
3739       inc(aData);
3740     end;
3741   end;
3742 end;
3743
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3746 var
3747   idx: QWord;
3748   s: Integer;
3749   bits: Byte;
3750   f: Single;
3751 begin
3752   s    := Trunc(fPixelSize);
3753   f    := fPixelSize - s;
3754   bits := Round(8 * f);
3755   case s of
3756     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3757     1: idx :=           aData^;
3758     2: idx :=     PWord(aData)^;
3759     4: idx := PCardinal(aData)^;
3760     8: idx :=    PQWord(aData)^;
3761   else
3762     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3763   end;
3764   if (idx >= Length(fColorTable)) then
3765     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3766   with fColorTable[idx] do begin
3767     aPixel.Data.r := r;
3768     aPixel.Data.g := g;
3769     aPixel.Data.b := b;
3770     aPixel.Data.a := a;
3771   end;
3772   inc(PByte(aMapData), bits);
3773   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3774     inc(aData, 1);
3775     dec(PByte(aMapData), 8);
3776   end;
3777   inc(aData, s);
3778 end;
3779
3780 destructor TbmpColorTableFormat.Destroy;
3781 begin
3782   SetLength(fColorTable, 0);
3783   inherited Destroy;
3784 end;
3785
3786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3787 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3790 var
3791   i: Integer;
3792 begin
3793   for i := 0 to 3 do begin
3794     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3795       if (aSourceFD.Range.arr[i] > 0) then
3796         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3797       else
3798         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3799     end;
3800   end;
3801 end;
3802
3803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3804 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3805 begin
3806   with aFuncRec do begin
3807     if (Source.Range.r   > 0) then
3808       Dest.Data.r := Source.Data.r;
3809     if (Source.Range.g > 0) then
3810       Dest.Data.g := Source.Data.g;
3811     if (Source.Range.b  > 0) then
3812       Dest.Data.b := Source.Data.b;
3813     if (Source.Range.a > 0) then
3814       Dest.Data.a := Source.Data.a;
3815   end;
3816 end;
3817
3818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3819 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3820 var
3821   i: Integer;
3822 begin
3823   with aFuncRec do begin
3824     for i := 0 to 3 do
3825       if (Source.Range.arr[i] > 0) then
3826         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3827   end;
3828 end;
3829
3830 type
3831   TShiftData = packed record
3832     case Integer of
3833       0: (r, g, b, a: SmallInt);
3834       1: (arr: array[0..3] of SmallInt);
3835   end;
3836   PShiftData = ^TShiftData;
3837
3838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3840 var
3841   i: Integer;
3842 begin
3843   with aFuncRec do
3844     for i := 0 to 3 do
3845       if (Source.Range.arr[i] > 0) then
3846         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3847 end;
3848
3849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3850 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3851 begin
3852   with aFuncRec do begin
3853     Dest.Data := Source.Data;
3854     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3855       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3856       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3857       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3858     end;
3859     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3860       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3861     end;
3862   end;
3863 end;
3864
3865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3867 var
3868   i: Integer;
3869 begin
3870   with aFuncRec do begin
3871     for i := 0 to 3 do
3872       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3873   end;
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3878 var
3879   Temp: Single;
3880 begin
3881   with FuncRec do begin
3882     if (FuncRec.Args = nil) then begin //source has no alpha
3883       Temp :=
3884         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3885         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3886         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3887       Dest.Data.a := Round(Dest.Range.a * Temp);
3888     end else
3889       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3890   end;
3891 end;
3892
3893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3894 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3895 type
3896   PglBitmapPixelData = ^TglBitmapPixelData;
3897 begin
3898   with FuncRec do begin
3899     Dest.Data.r := Source.Data.r;
3900     Dest.Data.g := Source.Data.g;
3901     Dest.Data.b := Source.Data.b;
3902
3903     with PglBitmapPixelData(Args)^ do
3904       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3905           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3906           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3907         Dest.Data.a := 0
3908       else
3909         Dest.Data.a := Dest.Range.a;
3910   end;
3911 end;
3912
3913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3914 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3915 begin
3916   with FuncRec do begin
3917     Dest.Data.r := Source.Data.r;
3918     Dest.Data.g := Source.Data.g;
3919     Dest.Data.b := Source.Data.b;
3920     Dest.Data.a := PCardinal(Args)^;
3921   end;
3922 end;
3923
3924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3925 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
3926 type
3927   PRGBPix = ^TRGBPix;
3928   TRGBPix = array [0..2] of byte;
3929 var
3930   Temp: Byte;
3931 begin
3932   while aWidth > 0 do begin
3933     Temp := PRGBPix(aData)^[0];
3934     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
3935     PRGBPix(aData)^[2] := Temp;
3936
3937     if aHasAlpha then
3938       Inc(aData, 4)
3939     else
3940       Inc(aData, 3);
3941     dec(aWidth);
3942   end;
3943 end;
3944
3945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3946 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3948 function TglBitmap.GetWidth: Integer;
3949 begin
3950   if (ffX in fDimension.Fields) then
3951     result := fDimension.X
3952   else
3953     result := -1;
3954 end;
3955
3956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3957 function TglBitmap.GetHeight: Integer;
3958 begin
3959   if (ffY in fDimension.Fields) then
3960     result := fDimension.Y
3961   else
3962     result := -1;
3963 end;
3964
3965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3966 function TglBitmap.GetFileWidth: Integer;
3967 begin
3968   result := Max(1, Width);
3969 end;
3970
3971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3972 function TglBitmap.GetFileHeight: Integer;
3973 begin
3974   result := Max(1, Height);
3975 end;
3976
3977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3978 procedure TglBitmap.SetCustomData(const aValue: Pointer);
3979 begin
3980   if fCustomData = aValue then
3981     exit;
3982   fCustomData := aValue;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 procedure TglBitmap.SetCustomName(const aValue: String);
3987 begin
3988   if fCustomName = aValue then
3989     exit;
3990   fCustomName := aValue;
3991 end;
3992
3993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3994 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
3995 begin
3996   if fCustomNameW = aValue then
3997     exit;
3998   fCustomNameW := aValue;
3999 end;
4000
4001 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4002 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4003 begin
4004   if fDeleteTextureOnFree = aValue then
4005     exit;
4006   fDeleteTextureOnFree := aValue;
4007 end;
4008
4009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4010 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4011 begin
4012   if fFormat = aValue then
4013     exit;
4014   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4015     raise EglBitmapUnsupportedFormat.Create(Format);
4016   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4017 end;
4018
4019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4020 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4021 begin
4022   if fFreeDataAfterGenTexture = aValue then
4023     exit;
4024   fFreeDataAfterGenTexture := aValue;
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 procedure TglBitmap.SetID(const aValue: Cardinal);
4029 begin
4030   if fID = aValue then
4031     exit;
4032   fID := aValue;
4033 end;
4034
4035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4036 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4037 begin
4038   if fMipMap = aValue then
4039     exit;
4040   fMipMap := aValue;
4041 end;
4042
4043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4044 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4045 begin
4046   if fTarget = aValue then
4047     exit;
4048   fTarget := aValue;
4049 end;
4050
4051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4052 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4053 var
4054   MaxAnisotropic: Integer;
4055 begin
4056   fAnisotropic := aValue;
4057   if (ID > 0) then begin
4058     if GL_EXT_texture_filter_anisotropic then begin
4059       if fAnisotropic > 0 then begin
4060         Bind(false);
4061         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4062         if aValue > MaxAnisotropic then
4063           fAnisotropic := MaxAnisotropic;
4064         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4065       end;
4066     end else begin
4067       fAnisotropic := 0;
4068     end;
4069   end;
4070 end;
4071
4072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4073 procedure TglBitmap.CreateID;
4074 begin
4075   if (ID <> 0) then
4076     glDeleteTextures(1, @fID);
4077   glGenTextures(1, @fID);
4078   Bind(false);
4079 end;
4080
4081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4082 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4083 begin
4084   // Set Up Parameters
4085   SetWrap(fWrapS, fWrapT, fWrapR);
4086   SetFilter(fFilterMin, fFilterMag);
4087   SetAnisotropic(fAnisotropic);
4088   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4089
4090   // Mip Maps Generation Mode
4091   aBuildWithGlu := false;
4092   if (MipMap = mmMipmap) then begin
4093     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4094       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4095     else
4096       aBuildWithGlu := true;
4097   end else if (MipMap = mmMipmapGlu) then
4098     aBuildWithGlu := true;
4099 end;
4100
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4103   const aWidth: Integer; const aHeight: Integer);
4104 var
4105   s: Single;
4106 begin
4107   if (Data <> aData) then begin
4108     if (Assigned(Data)) then
4109       FreeMem(Data);
4110     fData := aData;
4111   end;
4112
4113   FillChar(fDimension, SizeOf(fDimension), 0);
4114   if not Assigned(fData) then begin
4115     fFormat    := tfEmpty;
4116     fPixelSize := 0;
4117     fRowSize   := 0;
4118   end else begin
4119     if aWidth <> -1 then begin
4120       fDimension.Fields := fDimension.Fields + [ffX];
4121       fDimension.X := aWidth;
4122     end;
4123
4124     if aHeight <> -1 then begin
4125       fDimension.Fields := fDimension.Fields + [ffY];
4126       fDimension.Y := aHeight;
4127     end;
4128
4129     s := TFormatDescriptor.Get(aFormat).PixelSize;
4130     fFormat    := aFormat;
4131     fPixelSize := Ceil(s);
4132     fRowSize   := Ceil(s * aWidth);
4133   end;
4134 end;
4135
4136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4137 function TglBitmap.FlipHorz: Boolean;
4138 begin
4139   result := false;
4140 end;
4141
4142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 function TglBitmap.FlipVert: Boolean;
4144 begin
4145   result := false;
4146 end;
4147
4148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4149 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4151 procedure TglBitmap.AfterConstruction;
4152 begin
4153   inherited AfterConstruction;
4154
4155   fID         := 0;
4156   fTarget     := 0;
4157   fIsResident := false;
4158
4159   fFormat                  := glBitmapGetDefaultFormat;
4160   fMipMap                  := glBitmapDefaultMipmap;
4161   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4162   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4163
4164   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4165   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4166 end;
4167
4168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4169 procedure TglBitmap.BeforeDestruction;
4170 var
4171   NewData: PByte;
4172 begin
4173   NewData := nil;
4174   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4175   if (fID > 0) and fDeleteTextureOnFree then
4176     glDeleteTextures(1, @fID);
4177   inherited BeforeDestruction;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4182 var
4183   TempPos: Integer;
4184 begin
4185   if not Assigned(aResType) then begin
4186     TempPos   := Pos('.', aResource);
4187     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4188     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4189   end;
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.LoadFromFile(const aFilename: String);
4194 var
4195   fs: TFileStream;
4196 begin
4197   if not FileExists(aFilename) then
4198     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4199   fFilename := aFilename;
4200   fs := TFileStream.Create(fFilename, fmOpenRead);
4201   try
4202     fs.Position := 0;
4203     LoadFromStream(fs);
4204   finally
4205     fs.Free;
4206   end;
4207 end;
4208
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4211 begin
4212   {$IFDEF GLB_SUPPORT_PNG_READ}
4213   if not LoadPNG(aStream) then
4214   {$ENDIF}
4215   {$IFDEF GLB_SUPPORT_JPEG_READ}
4216   if not LoadJPEG(aStream) then
4217   {$ENDIF}
4218   if not LoadDDS(aStream) then
4219   if not LoadTGA(aStream) then
4220   if not LoadBMP(aStream) then
4221     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4226   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4227 var
4228   tmpData: PByte;
4229   size: Integer;
4230 begin
4231   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4232   GetMem(tmpData, size);
4233   try
4234     FillChar(tmpData^, size, #$FF);
4235     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4236   except
4237     if Assigned(tmpData) then
4238       FreeMem(tmpData);
4239     raise;
4240   end;
4241   AddFunc(Self, aFunc, false, Format, aArgs);
4242 end;
4243
4244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4245 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4246 var
4247   rs: TResourceStream;
4248 begin
4249   PrepareResType(aResource, aResType);
4250   rs := TResourceStream.Create(aInstance, aResource, aResType);
4251   try
4252     LoadFromStream(rs);
4253   finally
4254     rs.Free;
4255   end;
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4260 var
4261   rs: TResourceStream;
4262 begin
4263   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4264   try
4265     LoadFromStream(rs);
4266   finally
4267     rs.Free;
4268   end;
4269 end;
4270
4271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4272 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4273 var
4274   fs: TFileStream;
4275 begin
4276   fs := TFileStream.Create(aFileName, fmCreate);
4277   try
4278     fs.Position := 0;
4279     SaveToStream(fs, aFileType);
4280   finally
4281     fs.Free;
4282   end;
4283 end;
4284
4285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4286 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4287 begin
4288   case aFileType of
4289     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4290     ftPNG:  SavePNG(aStream);
4291     {$ENDIF}
4292     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4293     ftJPEG: SaveJPEG(aStream);
4294     {$ENDIF}
4295     ftDDS:  SaveDDS(aStream);
4296     ftTGA:  SaveTGA(aStream);
4297     ftBMP:  SaveBMP(aStream);
4298   end;
4299 end;
4300
4301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4302 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4303 begin
4304   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4305 end;
4306
4307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4308 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4309   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4310 var
4311   DestData, TmpData, SourceData: pByte;
4312   TempHeight, TempWidth: Integer;
4313   SourceFD, DestFD: TFormatDescriptor;
4314   SourceMD, DestMD: Pointer;
4315
4316   FuncRec: TglBitmapFunctionRec;
4317 begin
4318   Assert(Assigned(Data));
4319   Assert(Assigned(aSource));
4320   Assert(Assigned(aSource.Data));
4321
4322   result := false;
4323   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4324     SourceFD := TFormatDescriptor.Get(aSource.Format);
4325     DestFD   := TFormatDescriptor.Get(aFormat);
4326
4327     if (SourceFD.IsCompressed) then
4328       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4329     if (DestFD.IsCompressed) then
4330       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4331
4332     // inkompatible Formats so CreateTemp
4333     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4334       aCreateTemp := true;
4335
4336     // Values
4337     TempHeight := Max(1, aSource.Height);
4338     TempWidth  := Max(1, aSource.Width);
4339
4340     FuncRec.Sender := Self;
4341     FuncRec.Args   := aArgs;
4342
4343     TmpData := nil;
4344     if aCreateTemp then begin
4345       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4346       DestData := TmpData;
4347     end else
4348       DestData := Data;
4349
4350     try
4351       SourceFD.PreparePixel(FuncRec.Source);
4352       DestFD.PreparePixel  (FuncRec.Dest);
4353
4354       SourceMD := SourceFD.CreateMappingData;
4355       DestMD   := DestFD.CreateMappingData;
4356
4357       FuncRec.Size            := aSource.Dimension;
4358       FuncRec.Position.Fields := FuncRec.Size.Fields;
4359
4360       try
4361         SourceData := aSource.Data;
4362         FuncRec.Position.Y := 0;
4363         while FuncRec.Position.Y < TempHeight do begin
4364           FuncRec.Position.X := 0;
4365           while FuncRec.Position.X < TempWidth do begin
4366             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4367             aFunc(FuncRec);
4368             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4369             inc(FuncRec.Position.X);
4370           end;
4371           inc(FuncRec.Position.Y);
4372         end;
4373
4374         // Updating Image or InternalFormat
4375         if aCreateTemp then
4376           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4377         else if (aFormat <> fFormat) then
4378           Format := aFormat;
4379
4380         result := true;
4381       finally
4382         SourceFD.FreeMappingData(SourceMD);
4383         DestFD.FreeMappingData(DestMD);
4384       end;
4385     except
4386       if aCreateTemp and Assigned(TmpData) then
4387         FreeMem(TmpData);
4388       raise;
4389     end;
4390   end;
4391 end;
4392
4393 {$IFDEF GLB_SDL}
4394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4395 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4396 var
4397   Row, RowSize: Integer;
4398   SourceData, TmpData: PByte;
4399   TempDepth: Integer;
4400   FormatDesc: TFormatDescriptor;
4401
4402   function GetRowPointer(Row: Integer): pByte;
4403   begin
4404     result := aSurface.pixels;
4405     Inc(result, Row * RowSize);
4406   end;
4407
4408 begin
4409   result := false;
4410
4411   FormatDesc := TFormatDescriptor.Get(Format);
4412   if FormatDesc.IsCompressed then
4413     raise EglBitmapUnsupportedFormat.Create(Format);
4414
4415   if Assigned(Data) then begin
4416     case Trunc(FormatDesc.PixelSize) of
4417       1: TempDepth :=  8;
4418       2: TempDepth := 16;
4419       3: TempDepth := 24;
4420       4: TempDepth := 32;
4421     else
4422       raise EglBitmapUnsupportedFormat.Create(Format);
4423     end;
4424
4425     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4426       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4427     SourceData := Data;
4428     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4429
4430     for Row := 0 to FileHeight-1 do begin
4431       TmpData := GetRowPointer(Row);
4432       if Assigned(TmpData) then begin
4433         Move(SourceData^, TmpData^, RowSize);
4434         inc(SourceData, RowSize);
4435       end;
4436     end;
4437     result := true;
4438   end;
4439 end;
4440
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4443 var
4444   pSource, pData, pTempData: PByte;
4445   Row, RowSize, TempWidth, TempHeight: Integer;
4446   IntFormat: TglBitmapFormat;
4447   FormatDesc: TFormatDescriptor;
4448
4449   function GetRowPointer(Row: Integer): pByte;
4450   begin
4451     result := aSurface^.pixels;
4452     Inc(result, Row * RowSize);
4453   end;
4454
4455 begin
4456   result := false;
4457   if (Assigned(aSurface)) then begin
4458     with aSurface^.format^ do begin
4459       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4460         FormatDesc := TFormatDescriptor.Get(IntFormat);
4461         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4462           break;
4463       end;
4464       if (IntFormat = tfEmpty) then
4465         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4466     end;
4467
4468     TempWidth  := aSurface^.w;
4469     TempHeight := aSurface^.h;
4470     RowSize := FormatDesc.GetSize(TempWidth, 1);
4471     GetMem(pData, TempHeight * RowSize);
4472     try
4473       pTempData := pData;
4474       for Row := 0 to TempHeight -1 do begin
4475         pSource := GetRowPointer(Row);
4476         if (Assigned(pSource)) then begin
4477           Move(pSource^, pTempData^, RowSize);
4478           Inc(pTempData, RowSize);
4479         end;
4480       end;
4481       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4482       result := true;
4483     except
4484       if Assigned(pData) then
4485         FreeMem(pData);
4486       raise;
4487     end;
4488   end;
4489 end;
4490
4491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4492 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4493 var
4494   Row, Col, AlphaInterleave: Integer;
4495   pSource, pDest: PByte;
4496
4497   function GetRowPointer(Row: Integer): pByte;
4498   begin
4499     result := aSurface.pixels;
4500     Inc(result, Row * Width);
4501   end;
4502
4503 begin
4504   result := false;
4505   if Assigned(Data) then begin
4506     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4507       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4508
4509       AlphaInterleave := 0;
4510       case Format of
4511         tfLuminance8Alpha8:
4512           AlphaInterleave := 1;
4513         tfBGRA8, tfRGBA8:
4514           AlphaInterleave := 3;
4515       end;
4516
4517       pSource := Data;
4518       for Row := 0 to Height -1 do begin
4519         pDest := GetRowPointer(Row);
4520         if Assigned(pDest) then begin
4521           for Col := 0 to Width -1 do begin
4522             Inc(pSource, AlphaInterleave);
4523             pDest^ := pSource^;
4524             Inc(pDest);
4525             Inc(pSource);
4526           end;
4527         end;
4528       end;
4529       result := true;
4530     end;
4531   end;
4532 end;
4533
4534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4535 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4536 var
4537   bmp: TglBitmap2D;
4538 begin
4539   bmp := TglBitmap2D.Create;
4540   try
4541     bmp.AssignFromSurface(aSurface);
4542     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4543   finally
4544     bmp.Free;
4545   end;
4546 end;
4547 {$ENDIF}
4548
4549 {$IFDEF GLB_DELPHI}
4550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4551 function CreateGrayPalette: HPALETTE;
4552 var
4553   Idx: Integer;
4554   Pal: PLogPalette;
4555 begin
4556   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
4557
4558   Pal.palVersion := $300;
4559   Pal.palNumEntries := 256;
4560
4561   for Idx := 0 to Pal.palNumEntries - 1 do begin
4562     Pal.palPalEntry[Idx].peRed   := Idx;
4563     Pal.palPalEntry[Idx].peGreen := Idx;
4564     Pal.palPalEntry[Idx].peBlue  := Idx;
4565     Pal.palPalEntry[Idx].peFlags := 0;
4566   end;
4567   Result := CreatePalette(Pal^);
4568   FreeMem(Pal);
4569 end;
4570
4571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4572 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4573 var
4574   Row: Integer;
4575   pSource, pData: PByte;
4576 begin
4577   result := false;
4578   if Assigned(Data) then begin
4579     if Assigned(aBitmap) then begin
4580       aBitmap.Width  := Width;
4581       aBitmap.Height := Height;
4582
4583       case Format of
4584         tfAlpha8, tfLuminance8: begin
4585           aBitmap.PixelFormat := pf8bit;
4586           aBitmap.Palette     := CreateGrayPalette;
4587         end;
4588         tfRGB5A1:
4589           aBitmap.PixelFormat := pf15bit;
4590         tfR5G6B5:
4591           aBitmap.PixelFormat := pf16bit;
4592         tfRGB8, tfBGR8:
4593           aBitmap.PixelFormat := pf24bit;
4594         tfRGBA8, tfBGRA8:
4595           aBitmap.PixelFormat := pf32bit;
4596       else
4597         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4598       end;
4599
4600       pSource := Data;
4601       for Row := 0 to FileHeight -1 do begin
4602         pData := aBitmap.Scanline[Row];
4603         Move(pSource^, pData^, fRowSize);
4604         Inc(pSource, fRowSize);
4605         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)
4606           SwapRGB(pData, FileWidth, Format = tfRGBA8);
4607       end;
4608       result := true;
4609     end;
4610   end;
4611 end;
4612
4613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4614 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4615 var
4616   pSource, pData, pTempData: PByte;
4617   Row, RowSize, TempWidth, TempHeight: Integer;
4618   IntFormat: TglBitmapFormat;
4619 begin
4620   result := false;
4621
4622   if (Assigned(aBitmap)) then begin
4623     case aBitmap.PixelFormat of
4624       pf8bit:
4625         IntFormat := tfLuminance8;
4626       pf15bit:
4627         IntFormat := tfRGB5A1;
4628       pf16bit:
4629         IntFormat := tfR5G6B5;
4630       pf24bit:
4631         IntFormat := tfBGR8;
4632       pf32bit:
4633         IntFormat := tfBGRA8;
4634     else
4635       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4636     end;
4637
4638     TempWidth  := aBitmap.Width;
4639     TempHeight := aBitmap.Height;
4640     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
4641     GetMem(pData, TempHeight * RowSize);
4642     try
4643       pTempData := pData;
4644       for Row := 0 to TempHeight -1 do begin
4645         pSource := aBitmap.Scanline[Row];
4646         if (Assigned(pSource)) then begin
4647           Move(pSource^, pTempData^, RowSize);
4648           Inc(pTempData, RowSize);
4649         end;
4650       end;
4651       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4652       result := true;
4653     except
4654       if Assigned(pData) then
4655         FreeMem(pData);
4656       raise;
4657     end;
4658   end;
4659 end;
4660
4661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4662 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4663 var
4664   Row, Col, AlphaInterleave: Integer;
4665   pSource, pDest: PByte;
4666 begin
4667   result := false;
4668
4669   if Assigned(Data) then begin
4670     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
4671       if Assigned(aBitmap) then begin
4672         aBitmap.PixelFormat := pf8bit;
4673         aBitmap.Palette     := CreateGrayPalette;
4674         aBitmap.Width       := Width;
4675         aBitmap.Height      := Height;
4676
4677         case Format of
4678           tfLuminance8Alpha8:
4679             AlphaInterleave := 1;
4680           tfRGBA8, tfBGRA8:
4681             AlphaInterleave := 3;
4682           else
4683             AlphaInterleave := 0;
4684         end;
4685
4686         // Copy Data
4687         pSource := Data;
4688
4689         for Row := 0 to Height -1 do begin
4690           pDest := aBitmap.Scanline[Row];
4691           if Assigned(pDest) then begin
4692             for Col := 0 to Width -1 do begin
4693               Inc(pSource, AlphaInterleave);
4694               pDest^ := pSource^;
4695               Inc(pDest);
4696               Inc(pSource);
4697             end;
4698           end;
4699         end;
4700         result := true;
4701       end;
4702     end;
4703   end;
4704 end;
4705
4706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4707 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4708 var
4709   tex: TglBitmap2D;
4710 begin
4711   tex := TglBitmap2D.Create;
4712   try
4713     tex.AssignFromBitmap(ABitmap);
4714     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4715   finally
4716     tex.Free;
4717   end;
4718 end;
4719 {$ENDIF}
4720
4721 {$IFDEF GLB_LAZARUS}
4722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4723 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4724 var
4725   rid: TRawImageDescription;
4726   FormatDesc: TFormatDescriptor;
4727 begin
4728   result := false;
4729   if not Assigned(aImage) or (Format = tfEmpty) then
4730     exit;
4731   FormatDesc := TFormatDescriptor.Get(Format);
4732   if FormatDesc.IsCompressed then
4733     exit;
4734
4735   FillChar(rid{%H-}, SizeOf(rid), 0);
4736   if (Format in [
4737        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4738        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4739        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4740     rid.Format := ricfGray
4741   else
4742     rid.Format := ricfRGBA;
4743
4744   rid.Width        := Width;
4745   rid.Height       := Height;
4746   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4747   rid.BitOrder     := riboBitsInOrder;
4748   rid.ByteOrder    := riboLSBFirst;
4749   rid.LineOrder    := riloTopToBottom;
4750   rid.LineEnd      := rileTight;
4751   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4752   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
4753   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
4754   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
4755   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
4756   rid.RedShift     := FormatDesc.Shift.r;
4757   rid.GreenShift   := FormatDesc.Shift.g;
4758   rid.BlueShift    := FormatDesc.Shift.b;
4759   rid.AlphaShift   := FormatDesc.Shift.a;
4760
4761   rid.MaskBitsPerPixel  := 0;
4762   rid.PaletteColorCount := 0;
4763
4764   aImage.DataDescription := rid;
4765   aImage.CreateData;
4766
4767   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4768
4769   result := true;
4770 end;
4771
4772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4773 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4774 var
4775   f: TglBitmapFormat;
4776   FormatDesc: TFormatDescriptor;
4777   ImageData: PByte;
4778   ImageSize: Integer;
4779 begin
4780   result := false;
4781   if not Assigned(aImage) then
4782     exit;
4783   for f := High(f) downto Low(f) do begin
4784     FormatDesc := TFormatDescriptor.Get(f);
4785     with aImage.DataDescription do
4786       if FormatDesc.MaskMatch(
4787         (QWord(1 shl RedPrec  )-1) shl RedShift,
4788         (QWord(1 shl GreenPrec)-1) shl GreenShift,
4789         (QWord(1 shl BluePrec )-1) shl BlueShift,
4790         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4791         break;
4792   end;
4793
4794   if (f = tfEmpty) then
4795     exit;
4796
4797   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4798   ImageData := GetMem(ImageSize);
4799   try
4800     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4801     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
4802   except
4803     if Assigned(ImageData) then
4804       FreeMem(ImageData);
4805     raise;
4806   end;
4807
4808   result := true;
4809 end;
4810
4811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4812 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4813 var
4814   rid: TRawImageDescription;
4815   FormatDesc: TFormatDescriptor;
4816   Pixel: TglBitmapPixelData;
4817   x, y: Integer;
4818   srcMD: Pointer;
4819   src, dst: PByte;
4820 begin
4821   result := false;
4822   if not Assigned(aImage) or (Format = tfEmpty) then
4823     exit;
4824   FormatDesc := TFormatDescriptor.Get(Format);
4825   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4826     exit;
4827
4828   FillChar(rid{%H-}, SizeOf(rid), 0);
4829   rid.Format       := ricfGray;
4830   rid.Width        := Width;
4831   rid.Height       := Height;
4832   rid.Depth        := CountSetBits(FormatDesc.Range.a);
4833   rid.BitOrder     := riboBitsInOrder;
4834   rid.ByteOrder    := riboLSBFirst;
4835   rid.LineOrder    := riloTopToBottom;
4836   rid.LineEnd      := rileTight;
4837   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4838   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
4839   rid.GreenPrec    := 0;
4840   rid.BluePrec     := 0;
4841   rid.AlphaPrec    := 0;
4842   rid.RedShift     := 0;
4843   rid.GreenShift   := 0;
4844   rid.BlueShift    := 0;
4845   rid.AlphaShift   := 0;
4846
4847   rid.MaskBitsPerPixel  := 0;
4848   rid.PaletteColorCount := 0;
4849
4850   aImage.DataDescription := rid;
4851   aImage.CreateData;
4852
4853   srcMD := FormatDesc.CreateMappingData;
4854   try
4855     FormatDesc.PreparePixel(Pixel);
4856     src := Data;
4857     dst := aImage.PixelData;
4858     for y := 0 to Height-1 do
4859       for x := 0 to Width-1 do begin
4860         FormatDesc.Unmap(src, Pixel, srcMD);
4861         case rid.BitsPerPixel of
4862            8: begin
4863             dst^ := Pixel.Data.a;
4864             inc(dst);
4865           end;
4866           16: begin
4867             PWord(dst)^ := Pixel.Data.a;
4868             inc(dst, 2);
4869           end;
4870           24: begin
4871             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4872             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4873             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4874             inc(dst, 3);
4875           end;
4876           32: begin
4877             PCardinal(dst)^ := Pixel.Data.a;
4878             inc(dst, 4);
4879           end;
4880         else
4881           raise EglBitmapUnsupportedFormat.Create(Format);
4882         end;
4883       end;
4884   finally
4885     FormatDesc.FreeMappingData(srcMD);
4886   end;
4887   result := true;
4888 end;
4889
4890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4891 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4892 var
4893   tex: TglBitmap2D;
4894 begin
4895   tex := TglBitmap2D.Create;
4896   try
4897     tex.AssignFromLazIntfImage(aImage);
4898     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4899   finally
4900     tex.Free;
4901   end;
4902 end;
4903 {$ENDIF}
4904
4905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4906 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4907   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4908 var
4909   rs: TResourceStream;
4910 begin
4911   PrepareResType(aResource, aResType);
4912   rs := TResourceStream.Create(aInstance, aResource, aResType);
4913   try
4914     result := AddAlphaFromStream(rs, aFunc, aArgs);
4915   finally
4916     rs.Free;
4917   end;
4918 end;
4919
4920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4921 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4922   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4923 var
4924   rs: TResourceStream;
4925 begin
4926   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4927   try
4928     result := AddAlphaFromStream(rs, aFunc, aArgs);
4929   finally
4930     rs.Free;
4931   end;
4932 end;
4933
4934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4935 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4936 begin
4937   if TFormatDescriptor.Get(Format).IsCompressed then
4938     raise EglBitmapUnsupportedFormat.Create(Format);
4939   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4940 end;
4941
4942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4943 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4944 var
4945   FS: TFileStream;
4946 begin
4947   FS := TFileStream.Create(FileName, fmOpenRead);
4948   try
4949     result := AddAlphaFromStream(FS, aFunc, aArgs);
4950   finally
4951     FS.Free;
4952   end;
4953 end;
4954
4955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4956 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4957 var
4958   tex: TglBitmap2D;
4959 begin
4960   tex := TglBitmap2D.Create(aStream);
4961   try
4962     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4963   finally
4964     tex.Free;
4965   end;
4966 end;
4967
4968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4969 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4970 var
4971   DestData, DestData2, SourceData: pByte;
4972   TempHeight, TempWidth: Integer;
4973   SourceFD, DestFD: TFormatDescriptor;
4974   SourceMD, DestMD, DestMD2: Pointer;
4975
4976   FuncRec: TglBitmapFunctionRec;
4977 begin
4978   result := false;
4979
4980   Assert(Assigned(Data));
4981   Assert(Assigned(aBitmap));
4982   Assert(Assigned(aBitmap.Data));
4983
4984   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4985     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4986
4987     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4988     DestFD   := TFormatDescriptor.Get(Format);
4989
4990     if not Assigned(aFunc) then begin
4991       aFunc        := glBitmapAlphaFunc;
4992       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
4993     end else
4994       FuncRec.Args := aArgs;
4995
4996     // Values
4997     TempHeight := aBitmap.FileHeight;
4998     TempWidth  := aBitmap.FileWidth;
4999
5000     FuncRec.Sender          := Self;
5001     FuncRec.Size            := Dimension;
5002     FuncRec.Position.Fields := FuncRec.Size.Fields;
5003
5004     DestData   := Data;
5005     DestData2  := Data;
5006     SourceData := aBitmap.Data;
5007
5008     // Mapping
5009     SourceFD.PreparePixel(FuncRec.Source);
5010     DestFD.PreparePixel  (FuncRec.Dest);
5011
5012     SourceMD := SourceFD.CreateMappingData;
5013     DestMD   := DestFD.CreateMappingData;
5014     DestMD2  := DestFD.CreateMappingData;
5015     try
5016       FuncRec.Position.Y := 0;
5017       while FuncRec.Position.Y < TempHeight do begin
5018         FuncRec.Position.X := 0;
5019         while FuncRec.Position.X < TempWidth do begin
5020           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5021           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5022           aFunc(FuncRec);
5023           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5024           inc(FuncRec.Position.X);
5025         end;
5026         inc(FuncRec.Position.Y);
5027       end;
5028     finally
5029       SourceFD.FreeMappingData(SourceMD);
5030       DestFD.FreeMappingData(DestMD);
5031       DestFD.FreeMappingData(DestMD2);
5032     end;
5033   end;
5034 end;
5035
5036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5037 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5038 begin
5039   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5040 end;
5041
5042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5043 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5044 var
5045   PixelData: TglBitmapPixelData;
5046 begin
5047   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5048   result := AddAlphaFromColorKeyFloat(
5049     aRed   / PixelData.Range.r,
5050     aGreen / PixelData.Range.g,
5051     aBlue  / PixelData.Range.b,
5052     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5053 end;
5054
5055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5056 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5057 var
5058   values: array[0..2] of Single;
5059   tmp: Cardinal;
5060   i: Integer;
5061   PixelData: TglBitmapPixelData;
5062 begin
5063   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5064   with PixelData do begin
5065     values[0] := aRed;
5066     values[1] := aGreen;
5067     values[2] := aBlue;
5068
5069     for i := 0 to 2 do begin
5070       tmp          := Trunc(Range.arr[i] * aDeviation);
5071       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5072       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5073     end;
5074     Data.a  := 0;
5075     Range.a := 0;
5076   end;
5077   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5078 end;
5079
5080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5081 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5082 begin
5083   result := AddAlphaFromValueFloat(aAlpha / $FF);
5084 end;
5085
5086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5087 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5088 var
5089   PixelData: TglBitmapPixelData;
5090 begin
5091   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5092   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5093 end;
5094
5095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5096 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5097 var
5098   PixelData: TglBitmapPixelData;
5099 begin
5100   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5101   with PixelData do
5102     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5103   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5104 end;
5105
5106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5107 function TglBitmap.RemoveAlpha: Boolean;
5108 var
5109   FormatDesc: TFormatDescriptor;
5110 begin
5111   result := false;
5112   FormatDesc := TFormatDescriptor.Get(Format);
5113   if Assigned(Data) then begin
5114     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5115       raise EglBitmapUnsupportedFormat.Create(Format);
5116     result := ConvertTo(FormatDesc.WithoutAlpha);
5117   end;
5118 end;
5119
5120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5121 function TglBitmap.Clone: TglBitmap;
5122 var
5123   Temp: TglBitmap;
5124   TempPtr: PByte;
5125   Size: Integer;
5126 begin
5127   result := nil;
5128   Temp := (ClassType.Create as TglBitmap);
5129   try
5130     // copy texture data if assigned
5131     if Assigned(Data) then begin
5132       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5133       GetMem(TempPtr, Size);
5134       try
5135         Move(Data^, TempPtr^, Size);
5136         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5137       except
5138         if Assigned(TempPtr) then
5139           FreeMem(TempPtr);
5140         raise;
5141       end;
5142     end else begin
5143       TempPtr := nil;
5144       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5145     end;
5146
5147         // copy properties
5148     Temp.fID                      := ID;
5149     Temp.fTarget                  := Target;
5150     Temp.fFormat                  := Format;
5151     Temp.fMipMap                  := MipMap;
5152     Temp.fAnisotropic             := Anisotropic;
5153     Temp.fBorderColor             := fBorderColor;
5154     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5155     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5156     Temp.fFilterMin               := fFilterMin;
5157     Temp.fFilterMag               := fFilterMag;
5158     Temp.fWrapS                   := fWrapS;
5159     Temp.fWrapT                   := fWrapT;
5160     Temp.fWrapR                   := fWrapR;
5161     Temp.fFilename                := fFilename;
5162     Temp.fCustomName              := fCustomName;
5163     Temp.fCustomNameW             := fCustomNameW;
5164     Temp.fCustomData              := fCustomData;
5165
5166     result := Temp;
5167   except
5168     FreeAndNil(Temp);
5169     raise;
5170   end;
5171 end;
5172
5173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5174 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5175 var
5176   SourceFD, DestFD: TFormatDescriptor;
5177   SourcePD, DestPD: TglBitmapPixelData;
5178   ShiftData: TShiftData;
5179
5180   function CanCopyDirect: Boolean;
5181   begin
5182     result :=
5183       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5184       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5185       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5186       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5187   end;
5188
5189   function CanShift: Boolean;
5190   begin
5191     result :=
5192       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5193       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5194       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5195       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5196   end;
5197
5198   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5199   begin
5200     result := 0;
5201     while (aSource > aDest) and (aSource > 0) do begin
5202       inc(result);
5203       aSource := aSource shr 1;
5204     end;
5205   end;
5206
5207 begin
5208   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5209     SourceFD := TFormatDescriptor.Get(Format);
5210     DestFD   := TFormatDescriptor.Get(aFormat);
5211
5212     SourceFD.PreparePixel(SourcePD);
5213     DestFD.PreparePixel  (DestPD);
5214
5215     if CanCopyDirect then
5216       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5217     else if CanShift then begin
5218       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5219       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5220       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5221       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5222       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5223     end else
5224       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5225   end else
5226     result := true;
5227 end;
5228
5229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5230 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5231 begin
5232   if aUseRGB or aUseAlpha then
5233     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5234       ((PtrInt(aUseAlpha) and 1) shl 1) or
5235        (PtrInt(aUseRGB)   and 1)      ));
5236 end;
5237
5238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5239 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5240 begin
5241   fBorderColor[0] := aRed;
5242   fBorderColor[1] := aGreen;
5243   fBorderColor[2] := aBlue;
5244   fBorderColor[3] := aAlpha;
5245   if (ID > 0) then begin
5246     Bind(false);
5247     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5248   end;
5249 end;
5250
5251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5252 procedure TglBitmap.FreeData;
5253 var
5254   TempPtr: PByte;
5255 begin
5256   TempPtr := nil;
5257   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5258 end;
5259
5260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5261 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5262   const aAlpha: Byte);
5263 begin
5264   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5265 end;
5266
5267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5268 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5269 var
5270   PixelData: TglBitmapPixelData;
5271 begin
5272   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5273   FillWithColorFloat(
5274     aRed   / PixelData.Range.r,
5275     aGreen / PixelData.Range.g,
5276     aBlue  / PixelData.Range.b,
5277     aAlpha / PixelData.Range.a);
5278 end;
5279
5280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5281 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5282 var
5283   PixelData: TglBitmapPixelData;
5284 begin
5285   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5286   with PixelData do begin
5287     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5288     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5289     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5290     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5291   end;
5292   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5293 end;
5294
5295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5296 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5297 begin
5298   //check MIN filter
5299   case aMin of
5300     GL_NEAREST:
5301       fFilterMin := GL_NEAREST;
5302     GL_LINEAR:
5303       fFilterMin := GL_LINEAR;
5304     GL_NEAREST_MIPMAP_NEAREST:
5305       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5306     GL_LINEAR_MIPMAP_NEAREST:
5307       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5308     GL_NEAREST_MIPMAP_LINEAR:
5309       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5310     GL_LINEAR_MIPMAP_LINEAR:
5311       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5312     else
5313       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5314   end;
5315
5316   //check MAG filter
5317   case aMag of
5318     GL_NEAREST:
5319       fFilterMag := GL_NEAREST;
5320     GL_LINEAR:
5321       fFilterMag := GL_LINEAR;
5322     else
5323       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5324   end;
5325
5326   //apply filter
5327   if (ID > 0) then begin
5328     Bind(false);
5329     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5330
5331     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5332       case fFilterMin of
5333         GL_NEAREST, GL_LINEAR:
5334           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5335         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5336           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5337         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5338           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5339       end;
5340     end else
5341       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5342   end;
5343 end;
5344
5345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5346 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5347
5348   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5349   begin
5350     case aValue of
5351       GL_CLAMP:
5352         aTarget := GL_CLAMP;
5353
5354       GL_REPEAT:
5355         aTarget := GL_REPEAT;
5356
5357       GL_CLAMP_TO_EDGE: begin
5358         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5359           aTarget := GL_CLAMP_TO_EDGE
5360         else
5361           aTarget := GL_CLAMP;
5362       end;
5363
5364       GL_CLAMP_TO_BORDER: begin
5365         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5366           aTarget := GL_CLAMP_TO_BORDER
5367         else
5368           aTarget := GL_CLAMP;
5369       end;
5370
5371       GL_MIRRORED_REPEAT: begin
5372         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5373           aTarget := GL_MIRRORED_REPEAT
5374         else
5375           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5376       end;
5377     else
5378       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5379     end;
5380   end;
5381
5382 begin
5383   CheckAndSetWrap(S, fWrapS);
5384   CheckAndSetWrap(T, fWrapT);
5385   CheckAndSetWrap(R, fWrapR);
5386
5387   if (ID > 0) then begin
5388     Bind(false);
5389     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5390     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5391     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5392   end;
5393 end;
5394
5395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5396 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5397 begin
5398   if aEnableTextureUnit then
5399     glEnable(Target);
5400   if (ID > 0) then
5401     glBindTexture(Target, ID);
5402 end;
5403
5404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5405 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5406 begin
5407   if aDisableTextureUnit then
5408     glDisable(Target);
5409   glBindTexture(Target, 0);
5410 end;
5411
5412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5413 constructor TglBitmap.Create;
5414 begin
5415   if (ClassType = TglBitmap) then
5416     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5417 {$IFDEF GLB_NATIVE_OGL}
5418   glbReadOpenGLExtensions;
5419 {$ENDIF}
5420   inherited Create;
5421 end;
5422
5423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5424 constructor TglBitmap.Create(const aFileName: String);
5425 begin
5426   Create;
5427   LoadFromFile(FileName);
5428 end;
5429
5430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5431 constructor TglBitmap.Create(const aStream: TStream);
5432 begin
5433   Create;
5434   LoadFromStream(aStream);
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5439 var
5440   Image: PByte;
5441   ImageSize: Integer;
5442 begin
5443   Create;
5444   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5445   GetMem(Image, ImageSize);
5446   try
5447     FillChar(Image^, ImageSize, #$FF);
5448     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5449   except
5450     if Assigned(Image) then
5451       FreeMem(Image);
5452     raise;
5453   end;
5454 end;
5455
5456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5457 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5458   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5459 begin
5460   Create;
5461   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5462 end;
5463
5464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5465 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5466 begin
5467   Create;
5468   LoadFromResource(aInstance, aResource, aResType);
5469 end;
5470
5471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5472 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5473 begin
5474   Create;
5475   LoadFromResourceID(aInstance, aResourceID, aResType);
5476 end;
5477
5478 {$IFDEF GLB_SUPPORT_PNG_READ}
5479 {$IF DEFINED(GLB_SDL_IMAGE)}
5480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5481 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5484 var
5485   Surface: PSDL_Surface;
5486   RWops: PSDL_RWops;
5487 begin
5488   result := false;
5489   RWops := glBitmapCreateRWops(aStream);
5490   try
5491     if IMG_isPNG(RWops) > 0 then begin
5492       Surface := IMG_LoadPNG_RW(RWops);
5493       try
5494         AssignFromSurface(Surface);
5495         result := true;
5496       finally
5497         SDL_FreeSurface(Surface);
5498       end;
5499     end;
5500   finally
5501     SDL_FreeRW(RWops);
5502   end;
5503 end;
5504
5505 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5507 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5508 begin
5509   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5510 end;
5511
5512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5513 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5514 var
5515   StreamPos: Int64;
5516   signature: array [0..7] of byte;
5517   png: png_structp;
5518   png_info: png_infop;
5519
5520   TempHeight, TempWidth: Integer;
5521   Format: TglBitmapFormat;
5522
5523   png_data: pByte;
5524   png_rows: array of pByte;
5525   Row, LineSize: Integer;
5526 begin
5527   result := false;
5528
5529   if not init_libPNG then
5530     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5531
5532   try
5533     // signature
5534     StreamPos := aStream.Position;
5535     aStream.Read(signature{%H-}, 8);
5536     aStream.Position := StreamPos;
5537
5538     if png_check_sig(@signature, 8) <> 0 then begin
5539       // png read struct
5540       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5541       if png = nil then
5542         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5543
5544       // png info
5545       png_info := png_create_info_struct(png);
5546       if png_info = nil then begin
5547         png_destroy_read_struct(@png, nil, nil);
5548         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5549       end;
5550
5551       // set read callback
5552       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5553
5554       // read informations
5555       png_read_info(png, png_info);
5556
5557       // size
5558       TempHeight := png_get_image_height(png, png_info);
5559       TempWidth := png_get_image_width(png, png_info);
5560
5561       // format
5562       case png_get_color_type(png, png_info) of
5563         PNG_COLOR_TYPE_GRAY:
5564           Format := tfLuminance8;
5565         PNG_COLOR_TYPE_GRAY_ALPHA:
5566           Format := tfLuminance8Alpha8;
5567         PNG_COLOR_TYPE_RGB:
5568           Format := tfRGB8;
5569         PNG_COLOR_TYPE_RGB_ALPHA:
5570           Format := tfRGBA8;
5571         else
5572           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5573       end;
5574
5575       // cut upper 8 bit from 16 bit formats
5576       if png_get_bit_depth(png, png_info) > 8 then
5577         png_set_strip_16(png);
5578
5579       // expand bitdepth smaller than 8
5580       if png_get_bit_depth(png, png_info) < 8 then
5581         png_set_expand(png);
5582
5583       // allocating mem for scanlines
5584       LineSize := png_get_rowbytes(png, png_info);
5585       GetMem(png_data, TempHeight * LineSize);
5586       try
5587         SetLength(png_rows, TempHeight);
5588         for Row := Low(png_rows) to High(png_rows) do begin
5589           png_rows[Row] := png_data;
5590           Inc(png_rows[Row], Row * LineSize);
5591         end;
5592
5593         // read complete image into scanlines
5594         png_read_image(png, @png_rows[0]);
5595
5596         // read end
5597         png_read_end(png, png_info);
5598
5599         // destroy read struct
5600         png_destroy_read_struct(@png, @png_info, nil);
5601
5602         SetLength(png_rows, 0);
5603
5604         // set new data
5605         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
5606
5607         result := true;
5608       except
5609         if Assigned(png_data) then
5610           FreeMem(png_data);
5611         raise;
5612       end;
5613     end;
5614   finally
5615     quit_libPNG;
5616   end;
5617 end;
5618
5619 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5621 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5622 var
5623   StreamPos: Int64;
5624   Png: TPNGObject;
5625   Header: String[8];
5626   Row, Col, PixSize, LineSize: Integer;
5627   NewImage, pSource, pDest, pAlpha: pByte;
5628   PngFormat: TglBitmapFormat;
5629   FormatDesc: TFormatDescriptor;
5630
5631 const
5632   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5633
5634 begin
5635   result := false;
5636
5637   StreamPos := aStream.Position;
5638   aStream.Read(Header[0], SizeOf(Header));
5639   aStream.Position := StreamPos;
5640
5641   {Test if the header matches}
5642   if Header = PngHeader then begin
5643     Png := TPNGObject.Create;
5644     try
5645       Png.LoadFromStream(aStream);
5646
5647       case Png.Header.ColorType of
5648         COLOR_GRAYSCALE:
5649           PngFormat := tfLuminance8;
5650         COLOR_GRAYSCALEALPHA:
5651           PngFormat := tfLuminance8Alpha8;
5652         COLOR_RGB:
5653           PngFormat := tfBGR8;
5654         COLOR_RGBALPHA:
5655           PngFormat := tfBGRA8;
5656         else
5657           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5658       end;
5659
5660       FormatDesc := TFormatDescriptor.Get(PngFormat);
5661       PixSize    := Round(FormatDesc.PixelSize);
5662       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
5663
5664       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5665       try
5666         pDest := NewImage;
5667
5668         case Png.Header.ColorType of
5669           COLOR_RGB, COLOR_GRAYSCALE:
5670             begin
5671               for Row := 0 to Png.Height -1 do begin
5672                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5673                 Inc(pDest, LineSize);
5674               end;
5675             end;
5676           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5677             begin
5678               PixSize := PixSize -1;
5679
5680               for Row := 0 to Png.Height -1 do begin
5681                 pSource := Png.Scanline[Row];
5682                 pAlpha := pByte(Png.AlphaScanline[Row]);
5683
5684                 for Col := 0 to Png.Width -1 do begin
5685                   Move (pSource^, pDest^, PixSize);
5686                   Inc(pSource, PixSize);
5687                   Inc(pDest, PixSize);
5688
5689                   pDest^ := pAlpha^;
5690                   inc(pAlpha);
5691                   Inc(pDest);
5692                 end;
5693               end;
5694             end;
5695           else
5696             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5697         end;
5698
5699         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
5700
5701         result := true;
5702       except
5703         if Assigned(NewImage) then
5704           FreeMem(NewImage);
5705         raise;
5706       end;
5707     finally
5708       Png.Free;
5709     end;
5710   end;
5711 end;
5712 {$IFEND}
5713 {$ENDIF}
5714
5715 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5716 {$IFDEF GLB_LIB_PNG}
5717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5718 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5719 begin
5720   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5721 end;
5722 {$ENDIF}
5723
5724 {$IF DEFINED(GLB_LIB_PNG)}
5725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5726 procedure TglBitmap.SavePNG(const aStream: TStream);
5727 var
5728   png: png_structp;
5729   png_info: png_infop;
5730   png_rows: array of pByte;
5731   LineSize: Integer;
5732   ColorType: Integer;
5733   Row: Integer;
5734   FormatDesc: TFormatDescriptor;
5735 begin
5736   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5737     raise EglBitmapUnsupportedFormat.Create(Format);
5738
5739   if not init_libPNG then
5740     raise Exception.Create('unable to initialize libPNG.');
5741
5742   try
5743     case Format of
5744       tfAlpha8, tfLuminance8:
5745         ColorType := PNG_COLOR_TYPE_GRAY;
5746       tfLuminance8Alpha8:
5747         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5748       tfBGR8, tfRGB8:
5749         ColorType := PNG_COLOR_TYPE_RGB;
5750       tfBGRA8, tfRGBA8:
5751         ColorType := PNG_COLOR_TYPE_RGBA;
5752       else
5753         raise EglBitmapUnsupportedFormat.Create(Format);
5754     end;
5755
5756     FormatDesc := TFormatDescriptor.Get(Format);
5757     LineSize := FormatDesc.GetSize(Width, 1);
5758
5759     // creating array for scanline
5760     SetLength(png_rows, Height);
5761     try
5762       for Row := 0 to Height - 1 do begin
5763         png_rows[Row] := Data;
5764         Inc(png_rows[Row], Row * LineSize)
5765       end;
5766
5767       // write struct
5768       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5769       if png = nil then
5770         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5771
5772       // create png info
5773       png_info := png_create_info_struct(png);
5774       if png_info = nil then begin
5775         png_destroy_write_struct(@png, nil);
5776         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5777       end;
5778
5779       // set read callback
5780       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5781
5782       // set compression
5783       png_set_compression_level(png, 6);
5784
5785       if Format in [tfBGR8, tfBGRA8] then
5786         png_set_bgr(png);
5787
5788       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5789       png_write_info(png, png_info);
5790       png_write_image(png, @png_rows[0]);
5791       png_write_end(png, png_info);
5792       png_destroy_write_struct(@png, @png_info);
5793     finally
5794       SetLength(png_rows, 0);
5795     end;
5796   finally
5797     quit_libPNG;
5798   end;
5799 end;
5800
5801 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5803 procedure TglBitmap.SavePNG(const aStream: TStream);
5804 var
5805   Png: TPNGObject;
5806
5807   pSource, pDest: pByte;
5808   X, Y, PixSize: Integer;
5809   ColorType: Cardinal;
5810   Alpha: Boolean;
5811
5812   pTemp: pByte;
5813   Temp: Byte;
5814 begin
5815   if not (ftPNG in FormatGetSupportedFiles (Format)) then
5816     raise EglBitmapUnsupportedFormat.Create(Format);
5817
5818   case Format of
5819     tfAlpha8, tfLuminance8: begin
5820       ColorType := COLOR_GRAYSCALE;
5821       PixSize   := 1;
5822       Alpha     := false;
5823     end;
5824     tfLuminance8Alpha8: begin
5825       ColorType := COLOR_GRAYSCALEALPHA;
5826       PixSize   := 1;
5827       Alpha     := true;
5828     end;
5829     tfBGR8, tfRGB8: begin
5830       ColorType := COLOR_RGB;
5831       PixSize   := 3;
5832       Alpha     := false;
5833     end;
5834     tfBGRA8, tfRGBA8: begin
5835       ColorType := COLOR_RGBALPHA;
5836       PixSize   := 3;
5837       Alpha     := true
5838     end;
5839   else
5840     raise EglBitmapUnsupportedFormat.Create(Format);
5841   end;
5842
5843   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5844   try
5845     // Copy ImageData
5846     pSource := Data;
5847     for Y := 0 to Height -1 do begin
5848       pDest := png.ScanLine[Y];
5849       for X := 0 to Width -1 do begin
5850         Move(pSource^, pDest^, PixSize);
5851         Inc(pDest, PixSize);
5852         Inc(pSource, PixSize);
5853         if Alpha then begin
5854           png.AlphaScanline[Y]^[X] := pSource^;
5855           Inc(pSource);
5856         end;
5857       end;
5858
5859       // convert RGB line to BGR
5860       if Format in [tfRGB8, tfRGBA8] then begin
5861         pTemp := png.ScanLine[Y];
5862         for X := 0 to Width -1 do begin
5863           Temp := pByteArray(pTemp)^[0];
5864           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5865           pByteArray(pTemp)^[2] := Temp;
5866           Inc(pTemp, 3);
5867         end;
5868       end;
5869     end;
5870
5871     // Save to Stream
5872     Png.CompressionLevel := 6;
5873     Png.SaveToStream(aStream);
5874   finally
5875     FreeAndNil(Png);
5876   end;
5877 end;
5878 {$IFEND}
5879 {$ENDIF}
5880
5881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5882 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5884 {$IFDEF GLB_LIB_JPEG}
5885 type
5886   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5887   glBitmap_libJPEG_source_mgr = record
5888     pub: jpeg_source_mgr;
5889
5890     SrcStream: TStream;
5891     SrcBuffer: array [1..4096] of byte;
5892   end;
5893
5894   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5895   glBitmap_libJPEG_dest_mgr = record
5896     pub: jpeg_destination_mgr;
5897
5898     DestStream: TStream;
5899     DestBuffer: array [1..4096] of byte;
5900   end;
5901
5902 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5903 begin
5904   //DUMMY
5905 end;
5906
5907
5908 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5909 begin
5910   //DUMMY
5911 end;
5912
5913
5914 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5915 begin
5916   //DUMMY
5917 end;
5918
5919 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5920 begin
5921   //DUMMY
5922 end;
5923
5924
5925 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5926 begin
5927   //DUMMY
5928 end;
5929
5930
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5933 var
5934   src: glBitmap_libJPEG_source_mgr_ptr;
5935   bytes: integer;
5936 begin
5937   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5938
5939   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5940         if (bytes <= 0) then begin
5941                 src^.SrcBuffer[1] := $FF;
5942                 src^.SrcBuffer[2] := JPEG_EOI;
5943                 bytes := 2;
5944         end;
5945
5946         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5947         src^.pub.bytes_in_buffer := bytes;
5948
5949   result := true;
5950 end;
5951
5952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5953 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5954 var
5955   src: glBitmap_libJPEG_source_mgr_ptr;
5956 begin
5957   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5958
5959   if num_bytes > 0 then begin
5960     // wanted byte isn't in buffer so set stream position and read buffer
5961     if num_bytes > src^.pub.bytes_in_buffer then begin
5962       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5963       src^.pub.fill_input_buffer(cinfo);
5964     end else begin
5965       // wanted byte is in buffer so only skip
5966                 inc(src^.pub.next_input_byte, num_bytes);
5967                 dec(src^.pub.bytes_in_buffer, num_bytes);
5968     end;
5969   end;
5970 end;
5971
5972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5973 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5974 var
5975   dest: glBitmap_libJPEG_dest_mgr_ptr;
5976 begin
5977   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5978
5979   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5980     // write complete buffer
5981     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5982
5983     // reset buffer
5984     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5985     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5986   end;
5987
5988   result := true;
5989 end;
5990
5991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5992 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5993 var
5994   Idx: Integer;
5995   dest: glBitmap_libJPEG_dest_mgr_ptr;
5996 begin
5997   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5998
5999   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6000     // check for endblock
6001     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6002       // write endblock
6003       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6004
6005       // leave
6006       break;
6007     end else
6008       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6009   end;
6010 end;
6011 {$ENDIF}
6012
6013 {$IFDEF GLB_SUPPORT_JPEG_READ}
6014 {$IF DEFINED(GLB_SDL_IMAGE)}
6015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6016 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6017 var
6018   Surface: PSDL_Surface;
6019   RWops: PSDL_RWops;
6020 begin
6021   result := false;
6022
6023   RWops := glBitmapCreateRWops(aStream);
6024   try
6025     if IMG_isJPG(RWops) > 0 then begin
6026       Surface := IMG_LoadJPG_RW(RWops);
6027       try
6028         AssignFromSurface(Surface);
6029         result := true;
6030       finally
6031         SDL_FreeSurface(Surface);
6032       end;
6033     end;
6034   finally
6035     SDL_FreeRW(RWops);
6036   end;
6037 end;
6038
6039 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6041 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6042 var
6043   StreamPos: Int64;
6044   Temp: array[0..1]of Byte;
6045
6046   jpeg: jpeg_decompress_struct;
6047   jpeg_err: jpeg_error_mgr;
6048
6049   IntFormat: TglBitmapFormat;
6050   pImage: pByte;
6051   TempHeight, TempWidth: Integer;
6052
6053   pTemp: pByte;
6054   Row: Integer;
6055
6056   FormatDesc: TFormatDescriptor;
6057 begin
6058   result := false;
6059
6060   if not init_libJPEG then
6061     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6062
6063   try
6064     // reading first two bytes to test file and set cursor back to begin
6065     StreamPos := aStream.Position;
6066     aStream.Read({%H-}Temp[0], 2);
6067     aStream.Position := StreamPos;
6068
6069     // if Bitmap then read file.
6070     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6071       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6072       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6073
6074       // error managment
6075       jpeg.err := jpeg_std_error(@jpeg_err);
6076       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6077       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6078
6079       // decompression struct
6080       jpeg_create_decompress(@jpeg);
6081
6082       // allocation space for streaming methods
6083       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6084
6085       // seeting up custom functions
6086       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6087         pub.init_source       := glBitmap_libJPEG_init_source;
6088         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6089         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6090         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6091         pub.term_source       := glBitmap_libJPEG_term_source;
6092
6093         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6094         pub.next_input_byte := nil;   // until buffer loaded
6095
6096         SrcStream := aStream;
6097       end;
6098
6099       // set global decoding state
6100       jpeg.global_state := DSTATE_START;
6101
6102       // read header of jpeg
6103       jpeg_read_header(@jpeg, false);
6104
6105       // setting output parameter
6106       case jpeg.jpeg_color_space of
6107         JCS_GRAYSCALE:
6108           begin
6109             jpeg.out_color_space := JCS_GRAYSCALE;
6110             IntFormat := tfLuminance8;
6111           end;
6112         else
6113           jpeg.out_color_space := JCS_RGB;
6114           IntFormat := tfRGB8;
6115       end;
6116
6117       // reading image
6118       jpeg_start_decompress(@jpeg);
6119
6120       TempHeight := jpeg.output_height;
6121       TempWidth := jpeg.output_width;
6122
6123       FormatDesc := TFormatDescriptor.Get(IntFormat);
6124
6125       // creating new image
6126       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6127       try
6128         pTemp := pImage;
6129
6130         for Row := 0 to TempHeight -1 do begin
6131           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6132           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6133         end;
6134
6135         // finish decompression
6136         jpeg_finish_decompress(@jpeg);
6137
6138         // destroy decompression
6139         jpeg_destroy_decompress(@jpeg);
6140
6141         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6142
6143         result := true;
6144       except
6145         if Assigned(pImage) then
6146           FreeMem(pImage);
6147         raise;
6148       end;
6149     end;
6150   finally
6151     quit_libJPEG;
6152   end;
6153 end;
6154
6155 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6157 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6158 var
6159   bmp: TBitmap;
6160   jpg: TJPEGImage;
6161   StreamPos: Int64;
6162   Temp: array[0..1]of Byte;
6163 begin
6164   result := false;
6165
6166   // reading first two bytes to test file and set cursor back to begin
6167   StreamPos := aStream.Position;
6168   aStream.Read(Temp[0], 2);
6169   aStream.Position := StreamPos;
6170
6171   // if Bitmap then read file.
6172   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6173     bmp := TBitmap.Create;
6174     try
6175       jpg := TJPEGImage.Create;
6176       try
6177         jpg.LoadFromStream(aStream);
6178         bmp.Assign(jpg);
6179         result := AssignFromBitmap(bmp);
6180       finally
6181         jpg.Free;
6182       end;
6183     finally
6184       bmp.Free;
6185     end;
6186   end;
6187 end;
6188 {$IFEND}
6189 {$ENDIF}
6190
6191 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6192 {$IF DEFINED(GLB_LIB_JPEG)}
6193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6194 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6195 var
6196   jpeg: jpeg_compress_struct;
6197   jpeg_err: jpeg_error_mgr;
6198   Row: Integer;
6199   pTemp, pTemp2: pByte;
6200
6201   procedure CopyRow(pDest, pSource: pByte);
6202   var
6203     X: Integer;
6204   begin
6205     for X := 0 to Width - 1 do begin
6206       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6207       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6208       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6209       Inc(pDest, 3);
6210       Inc(pSource, 3);
6211     end;
6212   end;
6213
6214 begin
6215   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6216     raise EglBitmapUnsupportedFormat.Create(Format);
6217
6218   if not init_libJPEG then
6219     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6220
6221   try
6222     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6223     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6224
6225     // error managment
6226     jpeg.err := jpeg_std_error(@jpeg_err);
6227     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6228     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6229
6230     // compression struct
6231     jpeg_create_compress(@jpeg);
6232
6233     // allocation space for streaming methods
6234     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6235
6236     // seeting up custom functions
6237     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6238       pub.init_destination    := glBitmap_libJPEG_init_destination;
6239       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6240       pub.term_destination    := glBitmap_libJPEG_term_destination;
6241
6242       pub.next_output_byte  := @DestBuffer[1];
6243       pub.free_in_buffer    := Length(DestBuffer);
6244
6245       DestStream := aStream;
6246     end;
6247
6248     // very important state
6249     jpeg.global_state := CSTATE_START;
6250     jpeg.image_width  := Width;
6251     jpeg.image_height := Height;
6252     case Format of
6253       tfAlpha8, tfLuminance8: begin
6254         jpeg.input_components := 1;
6255         jpeg.in_color_space   := JCS_GRAYSCALE;
6256       end;
6257       tfRGB8, tfBGR8: begin
6258         jpeg.input_components := 3;
6259         jpeg.in_color_space   := JCS_RGB;
6260       end;
6261     end;
6262
6263     jpeg_set_defaults(@jpeg);
6264     jpeg_set_quality(@jpeg, 95, true);
6265     jpeg_start_compress(@jpeg, true);
6266     pTemp := Data;
6267
6268     if Format = tfBGR8 then
6269       GetMem(pTemp2, fRowSize)
6270     else
6271       pTemp2 := pTemp;
6272
6273     try
6274       for Row := 0 to jpeg.image_height -1 do begin
6275         // prepare row
6276         if Format = tfBGR8 then
6277           CopyRow(pTemp2, pTemp)
6278         else
6279           pTemp2 := pTemp;
6280
6281         // write row
6282         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6283         inc(pTemp, fRowSize);
6284       end;
6285     finally
6286       // free memory
6287       if Format = tfBGR8 then
6288         FreeMem(pTemp2);
6289     end;
6290     jpeg_finish_compress(@jpeg);
6291     jpeg_destroy_compress(@jpeg);
6292   finally
6293     quit_libJPEG;
6294   end;
6295 end;
6296
6297 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6299 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6300 var
6301   Bmp: TBitmap;
6302   Jpg: TJPEGImage;
6303 begin
6304   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6305     raise EglBitmapUnsupportedFormat.Create(Format);
6306
6307   Bmp := TBitmap.Create;
6308   try
6309     Jpg := TJPEGImage.Create;
6310     try
6311       AssignToBitmap(Bmp);
6312       if (Format in [tfAlpha8, tfLuminance8]) then begin
6313         Jpg.Grayscale   := true;
6314         Jpg.PixelFormat := jf8Bit;
6315       end;
6316       Jpg.Assign(Bmp);
6317       Jpg.SaveToStream(aStream);
6318     finally
6319       FreeAndNil(Jpg);
6320     end;
6321   finally
6322     FreeAndNil(Bmp);
6323   end;
6324 end;
6325 {$IFEND}
6326 {$ENDIF}
6327
6328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6329 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6331 const
6332   BMP_MAGIC          = $4D42;
6333
6334   BMP_COMP_RGB       = 0;
6335   BMP_COMP_RLE8      = 1;
6336   BMP_COMP_RLE4      = 2;
6337   BMP_COMP_BITFIELDS = 3;
6338
6339 type
6340   TBMPHeader = packed record
6341     bfType: Word;
6342     bfSize: Cardinal;
6343     bfReserved1: Word;
6344     bfReserved2: Word;
6345     bfOffBits: Cardinal;
6346   end;
6347
6348   TBMPInfo = packed record
6349     biSize: Cardinal;
6350     biWidth: Longint;
6351     biHeight: Longint;
6352     biPlanes: Word;
6353     biBitCount: Word;
6354     biCompression: Cardinal;
6355     biSizeImage: Cardinal;
6356     biXPelsPerMeter: Longint;
6357     biYPelsPerMeter: Longint;
6358     biClrUsed: Cardinal;
6359     biClrImportant: Cardinal;
6360   end;
6361
6362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6363 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6364
6365   //////////////////////////////////////////////////////////////////////////////////////////////////
6366   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6367   begin
6368     result := tfEmpty;
6369     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6370     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6371
6372     //Read Compression
6373     case aInfo.biCompression of
6374       BMP_COMP_RLE4,
6375       BMP_COMP_RLE8: begin
6376         raise EglBitmapException.Create('RLE compression is not supported');
6377       end;
6378       BMP_COMP_BITFIELDS: begin
6379         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6380           aStream.Read(aMask.r, SizeOf(aMask.r));
6381           aStream.Read(aMask.g, SizeOf(aMask.g));
6382           aStream.Read(aMask.b, SizeOf(aMask.b));
6383           aStream.Read(aMask.a, SizeOf(aMask.a));
6384         end else
6385           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6386       end;
6387     end;
6388
6389     //get suitable format
6390     case aInfo.biBitCount of
6391        8: result := tfLuminance8;
6392       16: result := tfBGR5;
6393       24: result := tfBGR8;
6394       32: result := tfBGRA8;
6395     end;
6396   end;
6397
6398   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6399   var
6400     i, c: Integer;
6401     ColorTable: TbmpColorTable;
6402   begin
6403     result := nil;
6404     if (aInfo.biBitCount >= 16) then
6405       exit;
6406     aFormat := tfLuminance8;
6407     c := aInfo.biClrUsed;
6408     if (c = 0) then
6409       c := 1 shl aInfo.biBitCount;
6410     SetLength(ColorTable, c);
6411     for i := 0 to c-1 do begin
6412       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6413       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6414         aFormat := tfRGB8;
6415     end;
6416
6417     result := TbmpColorTableFormat.Create;
6418     result.PixelSize  := aInfo.biBitCount / 8;
6419     result.ColorTable := ColorTable;
6420     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6421   end;
6422
6423   //////////////////////////////////////////////////////////////////////////////////////////////////
6424   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6425     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6426   var
6427     TmpFormat: TglBitmapFormat;
6428     FormatDesc: TFormatDescriptor;
6429   begin
6430     result := nil;
6431     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6432       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6433         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6434         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6435           aFormat := FormatDesc.Format;
6436           exit;
6437         end;
6438       end;
6439
6440       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6441         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6442       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6443         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6444
6445       result := TbmpBitfieldFormat.Create;
6446       result.PixelSize := aInfo.biBitCount / 8;
6447       result.RedMask   := aMask.r;
6448       result.GreenMask := aMask.g;
6449       result.BlueMask  := aMask.b;
6450       result.AlphaMask := aMask.a;
6451     end;
6452   end;
6453
6454 var
6455   //simple types
6456   StartPos: Int64;
6457   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6458   PaddingBuff: Cardinal;
6459   LineBuf, ImageData, TmpData: PByte;
6460   SourceMD, DestMD: Pointer;
6461   BmpFormat: TglBitmapFormat;
6462
6463   //records
6464   Mask: TglBitmapColorRec;
6465   Header: TBMPHeader;
6466   Info: TBMPInfo;
6467
6468   //classes
6469   SpecialFormat: TFormatDescriptor;
6470   FormatDesc: TFormatDescriptor;
6471
6472   //////////////////////////////////////////////////////////////////////////////////////////////////
6473   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6474   var
6475     i: Integer;
6476     Pixel: TglBitmapPixelData;
6477   begin
6478     aStream.Read(aLineBuf^, rbLineSize);
6479     SpecialFormat.PreparePixel(Pixel);
6480     for i := 0 to Info.biWidth-1 do begin
6481       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6482       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6483       FormatDesc.Map(Pixel, aData, DestMD);
6484     end;
6485   end;
6486
6487 begin
6488   result        := false;
6489   BmpFormat     := tfEmpty;
6490   SpecialFormat := nil;
6491   LineBuf       := nil;
6492   SourceMD      := nil;
6493   DestMD        := nil;
6494
6495   // Header
6496   StartPos := aStream.Position;
6497   aStream.Read(Header{%H-}, SizeOf(Header));
6498
6499   if Header.bfType = BMP_MAGIC then begin
6500     try try
6501       BmpFormat        := ReadInfo(Info, Mask);
6502       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6503       if not Assigned(SpecialFormat) then
6504         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6505       aStream.Position := StartPos + Header.bfOffBits;
6506
6507       if (BmpFormat <> tfEmpty) then begin
6508         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6509         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6510         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6511         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6512
6513         //get Memory
6514         DestMD    := FormatDesc.CreateMappingData;
6515         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6516         GetMem(ImageData, ImageSize);
6517         if Assigned(SpecialFormat) then begin
6518           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6519           SourceMD := SpecialFormat.CreateMappingData;
6520         end;
6521
6522         //read Data
6523         try try
6524           FillChar(ImageData^, ImageSize, $FF);
6525           TmpData := ImageData;
6526           if (Info.biHeight > 0) then
6527             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6528           for i := 0 to Abs(Info.biHeight)-1 do begin
6529             if Assigned(SpecialFormat) then
6530               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6531             else
6532               aStream.Read(TmpData^, wbLineSize);   //else only read data
6533             if (Info.biHeight > 0) then
6534               dec(TmpData, wbLineSize)
6535             else
6536               inc(TmpData, wbLineSize);
6537             aStream.Read(PaddingBuff{%H-}, Padding);
6538           end;
6539           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
6540           result := true;
6541         finally
6542           if Assigned(LineBuf) then
6543             FreeMem(LineBuf);
6544           if Assigned(SourceMD) then
6545             SpecialFormat.FreeMappingData(SourceMD);
6546           FormatDesc.FreeMappingData(DestMD);
6547         end;
6548         except
6549           if Assigned(ImageData) then
6550             FreeMem(ImageData);
6551           raise;
6552         end;
6553       end else
6554         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6555     except
6556       aStream.Position := StartPos;
6557       raise;
6558     end;
6559     finally
6560       FreeAndNil(SpecialFormat);
6561     end;
6562   end
6563     else aStream.Position := StartPos;
6564 end;
6565
6566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6567 procedure TglBitmap.SaveBMP(const aStream: TStream);
6568 var
6569   Header: TBMPHeader;
6570   Info: TBMPInfo;
6571   Converter: TbmpColorTableFormat;
6572   FormatDesc: TFormatDescriptor;
6573   SourceFD, DestFD: Pointer;
6574   pData, srcData, dstData, ConvertBuffer: pByte;
6575
6576   Pixel: TglBitmapPixelData;
6577   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6578   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6579
6580   PaddingBuff: Cardinal;
6581
6582   function GetLineWidth : Integer;
6583   begin
6584     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6585   end;
6586
6587 begin
6588   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6589     raise EglBitmapUnsupportedFormat.Create(Format);
6590
6591   Converter  := nil;
6592   FormatDesc := TFormatDescriptor.Get(Format);
6593   ImageSize  := FormatDesc.GetSize(Dimension);
6594
6595   FillChar(Header{%H-}, SizeOf(Header), 0);
6596   Header.bfType      := BMP_MAGIC;
6597   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6598   Header.bfReserved1 := 0;
6599   Header.bfReserved2 := 0;
6600   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6601
6602   FillChar(Info{%H-}, SizeOf(Info), 0);
6603   Info.biSize        := SizeOf(Info);
6604   Info.biWidth       := Width;
6605   Info.biHeight      := Height;
6606   Info.biPlanes      := 1;
6607   Info.biCompression := BMP_COMP_RGB;
6608   Info.biSizeImage   := ImageSize;
6609
6610   try
6611     case Format of
6612       tfLuminance4: begin
6613         Info.biBitCount  := 4;
6614         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6615         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6616         Converter           := TbmpColorTableFormat.Create;
6617         Converter.PixelSize := 0.5;
6618         Converter.Format    := Format;
6619         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6620         Converter.CreateColorTable;
6621       end;
6622
6623       tfR3G3B2, tfLuminance8: begin
6624         Info.biBitCount  :=  8;
6625         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6626         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6627         Converter           := TbmpColorTableFormat.Create;
6628         Converter.PixelSize := 1;
6629         Converter.Format    := Format;
6630         if (Format = tfR3G3B2) then begin
6631           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6632           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6633         end else
6634           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6635         Converter.CreateColorTable;
6636       end;
6637
6638       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6639       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6640         Info.biBitCount    := 16;
6641         Info.biCompression := BMP_COMP_BITFIELDS;
6642       end;
6643
6644       tfBGR8, tfRGB8: begin
6645         Info.biBitCount := 24;
6646       end;
6647
6648       tfRGB10, tfRGB10A2, tfRGBA8,
6649       tfBGR10, tfBGR10A2, tfBGRA8: begin
6650         Info.biBitCount    := 32;
6651         Info.biCompression := BMP_COMP_BITFIELDS;
6652       end;
6653     else
6654       raise EglBitmapUnsupportedFormat.Create(Format);
6655     end;
6656     Info.biXPelsPerMeter := 2835;
6657     Info.biYPelsPerMeter := 2835;
6658
6659     // prepare bitmasks
6660     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6661       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6662       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6663
6664       RedMask    := FormatDesc.RedMask;
6665       GreenMask  := FormatDesc.GreenMask;
6666       BlueMask   := FormatDesc.BlueMask;
6667       AlphaMask  := FormatDesc.AlphaMask;
6668     end;
6669
6670     // headers
6671     aStream.Write(Header, SizeOf(Header));
6672     aStream.Write(Info, SizeOf(Info));
6673
6674     // colortable
6675     if Assigned(Converter) then
6676       aStream.Write(Converter.ColorTable[0].b,
6677         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6678
6679     // bitmasks
6680     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6681       aStream.Write(RedMask,   SizeOf(Cardinal));
6682       aStream.Write(GreenMask, SizeOf(Cardinal));
6683       aStream.Write(BlueMask,  SizeOf(Cardinal));
6684       aStream.Write(AlphaMask, SizeOf(Cardinal));
6685     end;
6686
6687     // image data
6688     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6689     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6690     Padding     := GetLineWidth - wbLineSize;
6691     PaddingBuff := 0;
6692
6693     pData := Data;
6694     inc(pData, (Height-1) * rbLineSize);
6695
6696     // prepare row buffer. But only for RGB because RGBA supports color masks
6697     // so it's possible to change color within the image.
6698     if Assigned(Converter) then begin
6699       FormatDesc.PreparePixel(Pixel);
6700       GetMem(ConvertBuffer, wbLineSize);
6701       SourceFD := FormatDesc.CreateMappingData;
6702       DestFD   := Converter.CreateMappingData;
6703     end else
6704       ConvertBuffer := nil;
6705
6706     try
6707       for LineIdx := 0 to Height - 1 do begin
6708         // preparing row
6709         if Assigned(Converter) then begin
6710           srcData := pData;
6711           dstData := ConvertBuffer;
6712           for PixelIdx := 0 to Info.biWidth-1 do begin
6713             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6714             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6715             Converter.Map(Pixel, dstData, DestFD);
6716           end;
6717           aStream.Write(ConvertBuffer^, wbLineSize);
6718         end else begin
6719           aStream.Write(pData^, rbLineSize);
6720         end;
6721         dec(pData, rbLineSize);
6722         if (Padding > 0) then
6723           aStream.Write(PaddingBuff, Padding);
6724       end;
6725     finally
6726       // destroy row buffer
6727       if Assigned(ConvertBuffer) then begin
6728         FormatDesc.FreeMappingData(SourceFD);
6729         Converter.FreeMappingData(DestFD);
6730         FreeMem(ConvertBuffer);
6731       end;
6732     end;
6733   finally
6734     if Assigned(Converter) then
6735       Converter.Free;
6736   end;
6737 end;
6738
6739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6740 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6742 type
6743   TTGAHeader = packed record
6744     ImageID: Byte;
6745     ColorMapType: Byte;
6746     ImageType: Byte;
6747     //ColorMapSpec: Array[0..4] of Byte;
6748     ColorMapStart: Word;
6749     ColorMapLength: Word;
6750     ColorMapEntrySize: Byte;
6751     OrigX: Word;
6752     OrigY: Word;
6753     Width: Word;
6754     Height: Word;
6755     Bpp: Byte;
6756     ImageDesc: Byte;
6757   end;
6758
6759 const
6760   TGA_UNCOMPRESSED_RGB  =  2;
6761   TGA_UNCOMPRESSED_GRAY =  3;
6762   TGA_COMPRESSED_RGB    = 10;
6763   TGA_COMPRESSED_GRAY   = 11;
6764
6765   TGA_NONE_COLOR_TABLE  = 0;
6766
6767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6768 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6769 var
6770   Header: TTGAHeader;
6771   ImageData: System.PByte;
6772   StartPosition: Int64;
6773   PixelSize, LineSize: Integer;
6774   tgaFormat: TglBitmapFormat;
6775   FormatDesc: TFormatDescriptor;
6776   Counter: packed record
6777     X, Y: packed record
6778       low, high, dir: Integer;
6779     end;
6780   end;
6781
6782 const
6783   CACHE_SIZE = $4000;
6784
6785   ////////////////////////////////////////////////////////////////////////////////////////
6786   procedure ReadUncompressed;
6787   var
6788     i, j: Integer;
6789     buf, tmp1, tmp2: System.PByte;
6790   begin
6791     buf := nil;
6792     if (Counter.X.dir < 0) then
6793       GetMem(buf, LineSize);
6794     try
6795       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6796         tmp1 := ImageData;
6797         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
6798         if (Counter.X.dir < 0) then begin               //flip X
6799           aStream.Read(buf^, LineSize);
6800           tmp2 := buf;
6801           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
6802           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6803             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6804               tmp1^ := tmp2^;
6805               inc(tmp1);
6806               inc(tmp2);
6807             end;
6808             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6809           end;
6810         end else
6811           aStream.Read(tmp1^, LineSize);
6812         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6813       end;
6814     finally
6815       if Assigned(buf) then
6816         FreeMem(buf);
6817     end;
6818   end;
6819
6820   ////////////////////////////////////////////////////////////////////////////////////////
6821   procedure ReadCompressed;
6822
6823     /////////////////////////////////////////////////////////////////
6824     var
6825       TmpData: System.PByte;
6826       LinePixelsRead: Integer;
6827     procedure CheckLine;
6828     begin
6829       if (LinePixelsRead >= Header.Width) then begin
6830         LinePixelsRead := 0;
6831         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6832         TmpData := ImageData;
6833         inc(TmpData, Counter.Y.low * LineSize);           //set line
6834         if (Counter.X.dir < 0) then                       //if x flipped then
6835           inc(TmpData, LineSize - PixelSize);             //set last pixel
6836       end;
6837     end;
6838
6839     /////////////////////////////////////////////////////////////////
6840     var
6841       Cache: PByte;
6842       CacheSize, CachePos: Integer;
6843     procedure CachedRead(out Buffer; Count: Integer);
6844     var
6845       BytesRead: Integer;
6846     begin
6847       if (CachePos + Count > CacheSize) then begin
6848         //if buffer overflow save non read bytes
6849         BytesRead := 0;
6850         if (CacheSize - CachePos > 0) then begin
6851           BytesRead := CacheSize - CachePos;
6852           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6853           inc(CachePos, BytesRead);
6854         end;
6855
6856         //load cache from file
6857         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6858         aStream.Read(Cache^, CacheSize);
6859         CachePos := 0;
6860
6861         //read rest of requested bytes
6862         if (Count - BytesRead > 0) then begin
6863           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6864           inc(CachePos, Count - BytesRead);
6865         end;
6866       end else begin
6867         //if no buffer overflow just read the data
6868         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6869         inc(CachePos, Count);
6870       end;
6871     end;
6872
6873     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6874     begin
6875       case PixelSize of
6876         1: begin
6877           aBuffer^ := aData^;
6878           inc(aBuffer, Counter.X.dir);
6879         end;
6880         2: begin
6881           PWord(aBuffer)^ := PWord(aData)^;
6882           inc(aBuffer, 2 * Counter.X.dir);
6883         end;
6884         3: begin
6885           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6886           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6887           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6888           inc(aBuffer, 3 * Counter.X.dir);
6889         end;
6890         4: begin
6891           PCardinal(aBuffer)^ := PCardinal(aData)^;
6892           inc(aBuffer, 4 * Counter.X.dir);
6893         end;
6894       end;
6895     end;
6896
6897   var
6898     TotalPixelsToRead, TotalPixelsRead: Integer;
6899     Temp: Byte;
6900     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6901     PixelRepeat: Boolean;
6902     PixelsToRead, PixelCount: Integer;
6903   begin
6904     CacheSize := 0;
6905     CachePos  := 0;
6906
6907     TotalPixelsToRead := Header.Width * Header.Height;
6908     TotalPixelsRead   := 0;
6909     LinePixelsRead    := 0;
6910
6911     GetMem(Cache, CACHE_SIZE);
6912     try
6913       TmpData := ImageData;
6914       inc(TmpData, Counter.Y.low * LineSize);           //set line
6915       if (Counter.X.dir < 0) then                       //if x flipped then
6916         inc(TmpData, LineSize - PixelSize);             //set last pixel
6917
6918       repeat
6919         //read CommandByte
6920         CachedRead(Temp, 1);
6921         PixelRepeat  := (Temp and $80) > 0;
6922         PixelsToRead := (Temp and $7F) + 1;
6923         inc(TotalPixelsRead, PixelsToRead);
6924
6925         if PixelRepeat then
6926           CachedRead(buf[0], PixelSize);
6927         while (PixelsToRead > 0) do begin
6928           CheckLine;
6929           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6930           while (PixelCount > 0) do begin
6931             if not PixelRepeat then
6932               CachedRead(buf[0], PixelSize);
6933             PixelToBuffer(@buf[0], TmpData);
6934             inc(LinePixelsRead);
6935             dec(PixelsToRead);
6936             dec(PixelCount);
6937           end;
6938         end;
6939       until (TotalPixelsRead >= TotalPixelsToRead);
6940     finally
6941       FreeMem(Cache);
6942     end;
6943   end;
6944
6945   function IsGrayFormat: Boolean;
6946   begin
6947     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6948   end;
6949
6950 begin
6951   result := false;
6952
6953   // reading header to test file and set cursor back to begin
6954   StartPosition := aStream.Position;
6955   aStream.Read(Header{%H-}, SizeOf(Header));
6956
6957   // no colormapped files
6958   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6959     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6960   begin
6961     try
6962       if Header.ImageID <> 0 then       // skip image ID
6963         aStream.Position := aStream.Position + Header.ImageID;
6964
6965       tgaFormat := tfEmpty;
6966       case Header.Bpp of
6967          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6968                0: tgaFormat := tfLuminance8;
6969                8: tgaFormat := tfAlpha8;
6970             end;
6971
6972         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6973                0: tgaFormat := tfLuminance16;
6974                8: tgaFormat := tfLuminance8Alpha8;
6975             end else case (Header.ImageDesc and $F) of
6976                0: tgaFormat := tfBGR5;
6977                1: tgaFormat := tfBGR5A1;
6978                4: tgaFormat := tfBGRA4;
6979             end;
6980
6981         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6982                0: tgaFormat := tfBGR8;
6983             end;
6984
6985         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6986                2: tgaFormat := tfBGR10A2;
6987                8: tgaFormat := tfBGRA8;
6988             end;
6989       end;
6990
6991       if (tgaFormat = tfEmpty) then
6992         raise EglBitmapException.Create('LoadTga - unsupported format');
6993
6994       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6995       PixelSize  := FormatDesc.GetSize(1, 1);
6996       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6997
6998       GetMem(ImageData, LineSize * Header.Height);
6999       try
7000         //column direction
7001         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7002           Counter.X.low  := Header.Height-1;;
7003           Counter.X.high := 0;
7004           Counter.X.dir  := -1;
7005         end else begin
7006           Counter.X.low  := 0;
7007           Counter.X.high := Header.Height-1;
7008           Counter.X.dir  := 1;
7009         end;
7010
7011         // Row direction
7012         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7013           Counter.Y.low  := 0;
7014           Counter.Y.high := Header.Height-1;
7015           Counter.Y.dir  := 1;
7016         end else begin
7017           Counter.Y.low  := Header.Height-1;;
7018           Counter.Y.high := 0;
7019           Counter.Y.dir  := -1;
7020         end;
7021
7022         // Read Image
7023         case Header.ImageType of
7024           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7025             ReadUncompressed;
7026           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7027             ReadCompressed;
7028         end;
7029
7030         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7031         result := true;
7032       except
7033         if Assigned(ImageData) then
7034           FreeMem(ImageData);
7035         raise;
7036       end;
7037     finally
7038       aStream.Position := StartPosition;
7039     end;
7040   end
7041     else aStream.Position := StartPosition;
7042 end;
7043
7044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7045 procedure TglBitmap.SaveTGA(const aStream: TStream);
7046 var
7047   Header: TTGAHeader;
7048   LineSize, Size, x, y: Integer;
7049   Pixel: TglBitmapPixelData;
7050   LineBuf, SourceData, DestData: PByte;
7051   SourceMD, DestMD: Pointer;
7052   FormatDesc: TFormatDescriptor;
7053   Converter: TFormatDescriptor;
7054 begin
7055   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7056     raise EglBitmapUnsupportedFormat.Create(Format);
7057
7058   //prepare header
7059   FillChar(Header{%H-}, SizeOf(Header), 0);
7060
7061   //set ImageType
7062   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7063                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7064     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7065   else
7066     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7067
7068   //set BitsPerPixel
7069   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7070     Header.Bpp := 8
7071   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7072                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7073     Header.Bpp := 16
7074   else if (Format in [tfBGR8, tfRGB8]) then
7075     Header.Bpp := 24
7076   else
7077     Header.Bpp := 32;
7078
7079   //set AlphaBitCount
7080   case Format of
7081     tfRGB5A1, tfBGR5A1:
7082       Header.ImageDesc := 1 and $F;
7083     tfRGB10A2, tfBGR10A2:
7084       Header.ImageDesc := 2 and $F;
7085     tfRGBA4, tfBGRA4:
7086       Header.ImageDesc := 4 and $F;
7087     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7088       Header.ImageDesc := 8 and $F;
7089   end;
7090
7091   Header.Width     := Width;
7092   Header.Height    := Height;
7093   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7094   aStream.Write(Header, SizeOf(Header));
7095
7096   // convert RGB(A) to BGR(A)
7097   Converter  := nil;
7098   FormatDesc := TFormatDescriptor.Get(Format);
7099   Size       := FormatDesc.GetSize(Dimension);
7100   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7101     if (FormatDesc.RGBInverted = tfEmpty) then
7102       raise EglBitmapException.Create('inverted RGB format is empty');
7103     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7104     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7105        (Converter.PixelSize <> FormatDesc.PixelSize) then
7106       raise EglBitmapException.Create('invalid inverted RGB format');
7107   end;
7108
7109   if Assigned(Converter) then begin
7110     LineSize := FormatDesc.GetSize(Width, 1);
7111     GetMem(LineBuf, LineSize);
7112     SourceMD := FormatDesc.CreateMappingData;
7113     DestMD   := Converter.CreateMappingData;
7114     try
7115       SourceData := Data;
7116       for y := 0 to Height-1 do begin
7117         DestData := LineBuf;
7118         for x := 0 to Width-1 do begin
7119           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7120           Converter.Map(Pixel, DestData, DestMD);
7121         end;
7122         aStream.Write(LineBuf^, LineSize);
7123       end;
7124     finally
7125       FreeMem(LineBuf);
7126       FormatDesc.FreeMappingData(SourceMD);
7127       FormatDesc.FreeMappingData(DestMD);
7128     end;
7129   end else
7130     aStream.Write(Data^, Size);
7131 end;
7132
7133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7134 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7136 const
7137   DDS_MAGIC: Cardinal         = $20534444;
7138
7139   // DDS_header.dwFlags
7140   DDSD_CAPS                   = $00000001;
7141   DDSD_HEIGHT                 = $00000002;
7142   DDSD_WIDTH                  = $00000004;
7143   DDSD_PIXELFORMAT            = $00001000;
7144
7145   // DDS_header.sPixelFormat.dwFlags
7146   DDPF_ALPHAPIXELS            = $00000001;
7147   DDPF_ALPHA                  = $00000002;
7148   DDPF_FOURCC                 = $00000004;
7149   DDPF_RGB                    = $00000040;
7150   DDPF_LUMINANCE              = $00020000;
7151
7152   // DDS_header.sCaps.dwCaps1
7153   DDSCAPS_TEXTURE             = $00001000;
7154
7155   // DDS_header.sCaps.dwCaps2
7156   DDSCAPS2_CUBEMAP            = $00000200;
7157
7158   D3DFMT_DXT1                 = $31545844;
7159   D3DFMT_DXT3                 = $33545844;
7160   D3DFMT_DXT5                 = $35545844;
7161
7162 type
7163   TDDSPixelFormat = packed record
7164     dwSize: Cardinal;
7165     dwFlags: Cardinal;
7166     dwFourCC: Cardinal;
7167     dwRGBBitCount: Cardinal;
7168     dwRBitMask: Cardinal;
7169     dwGBitMask: Cardinal;
7170     dwBBitMask: Cardinal;
7171     dwABitMask: Cardinal;
7172   end;
7173
7174   TDDSCaps = packed record
7175     dwCaps1: Cardinal;
7176     dwCaps2: Cardinal;
7177     dwDDSX: Cardinal;
7178     dwReserved: Cardinal;
7179   end;
7180
7181   TDDSHeader = packed record
7182     dwSize: Cardinal;
7183     dwFlags: Cardinal;
7184     dwHeight: Cardinal;
7185     dwWidth: Cardinal;
7186     dwPitchOrLinearSize: Cardinal;
7187     dwDepth: Cardinal;
7188     dwMipMapCount: Cardinal;
7189     dwReserved: array[0..10] of Cardinal;
7190     PixelFormat: TDDSPixelFormat;
7191     Caps: TDDSCaps;
7192     dwReserved2: Cardinal;
7193   end;
7194
7195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7196 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7197 var
7198   Header: TDDSHeader;
7199   Converter: TbmpBitfieldFormat;
7200
7201   function GetDDSFormat: TglBitmapFormat;
7202   var
7203     fd: TFormatDescriptor;
7204     i: Integer;
7205     Range: TglBitmapColorRec;
7206     match: Boolean;
7207   begin
7208     result := tfEmpty;
7209     with Header.PixelFormat do begin
7210       // Compresses
7211       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7212         case Header.PixelFormat.dwFourCC of
7213           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7214           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7215           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7216         end;
7217       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7218
7219         //find matching format
7220         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7221           fd := TFormatDescriptor.Get(result);
7222           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7223              (8 * fd.PixelSize = dwRGBBitCount) then
7224             exit;
7225         end;
7226
7227         //find format with same Range
7228         Range.r := dwRBitMask;
7229         Range.g := dwGBitMask;
7230         Range.b := dwBBitMask;
7231         Range.a := dwABitMask;
7232         for i := 0 to 3 do begin
7233           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7234             Range.arr[i] := Range.arr[i] shr 1;
7235         end;
7236         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7237           fd := TFormatDescriptor.Get(result);
7238           match := true;
7239           for i := 0 to 3 do
7240             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7241               match := false;
7242               break;
7243             end;
7244           if match then
7245             break;
7246         end;
7247
7248         //no format with same range found -> use default
7249         if (result = tfEmpty) then begin
7250           if (dwABitMask > 0) then
7251             result := tfBGRA8
7252           else
7253             result := tfBGR8;
7254         end;
7255
7256         Converter := TbmpBitfieldFormat.Create;
7257         Converter.RedMask   := dwRBitMask;
7258         Converter.GreenMask := dwGBitMask;
7259         Converter.BlueMask  := dwBBitMask;
7260         Converter.AlphaMask := dwABitMask;
7261         Converter.PixelSize := dwRGBBitCount / 8;
7262       end;
7263     end;
7264   end;
7265
7266 var
7267   StreamPos: Int64;
7268   x, y, LineSize, RowSize, Magic: Cardinal;
7269   NewImage, TmpData, RowData, SrcData: System.PByte;
7270   SourceMD, DestMD: Pointer;
7271   Pixel: TglBitmapPixelData;
7272   ddsFormat: TglBitmapFormat;
7273   FormatDesc: TFormatDescriptor;
7274
7275 begin
7276   result    := false;
7277   Converter := nil;
7278   StreamPos := aStream.Position;
7279
7280   // Magic
7281   aStream.Read(Magic{%H-}, sizeof(Magic));
7282   if (Magic <> DDS_MAGIC) then begin
7283     aStream.Position := StreamPos;
7284     exit;
7285   end;
7286
7287   //Header
7288   aStream.Read(Header{%H-}, sizeof(Header));
7289   if (Header.dwSize <> SizeOf(Header)) or
7290      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7291         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7292   begin
7293     aStream.Position := StreamPos;
7294     exit;
7295   end;
7296
7297   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7298     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7299
7300   ddsFormat := GetDDSFormat;
7301   try
7302     if (ddsFormat = tfEmpty) then
7303       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7304
7305     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7306     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7307     GetMem(NewImage, Header.dwHeight * LineSize);
7308     try
7309       TmpData := NewImage;
7310
7311       //Converter needed
7312       if Assigned(Converter) then begin
7313         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7314         GetMem(RowData, RowSize);
7315         SourceMD := Converter.CreateMappingData;
7316         DestMD   := FormatDesc.CreateMappingData;
7317         try
7318           for y := 0 to Header.dwHeight-1 do begin
7319             TmpData := NewImage;
7320             inc(TmpData, y * LineSize);
7321             SrcData := RowData;
7322             aStream.Read(SrcData^, RowSize);
7323             for x := 0 to Header.dwWidth-1 do begin
7324               Converter.Unmap(SrcData, Pixel, SourceMD);
7325               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7326               FormatDesc.Map(Pixel, TmpData, DestMD);
7327             end;
7328           end;
7329         finally
7330           Converter.FreeMappingData(SourceMD);
7331           FormatDesc.FreeMappingData(DestMD);
7332           FreeMem(RowData);
7333         end;
7334       end else
7335
7336       // Compressed
7337       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7338         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7339         for Y := 0 to Header.dwHeight-1 do begin
7340           aStream.Read(TmpData^, RowSize);
7341           Inc(TmpData, LineSize);
7342         end;
7343       end else
7344
7345       // Uncompressed
7346       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7347         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7348         for Y := 0 to Header.dwHeight-1 do begin
7349           aStream.Read(TmpData^, RowSize);
7350           Inc(TmpData, LineSize);
7351         end;
7352       end else
7353         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7354
7355       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
7356       result := true;
7357     except
7358       if Assigned(NewImage) then
7359         FreeMem(NewImage);
7360       raise;
7361     end;
7362   finally
7363     FreeAndNil(Converter);
7364   end;
7365 end;
7366
7367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7368 procedure TglBitmap.SaveDDS(const aStream: TStream);
7369 var
7370   Header: TDDSHeader;
7371   FormatDesc: TFormatDescriptor;
7372 begin
7373   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7374     raise EglBitmapUnsupportedFormat.Create(Format);
7375
7376   FormatDesc := TFormatDescriptor.Get(Format);
7377
7378   // Generell
7379   FillChar(Header{%H-}, SizeOf(Header), 0);
7380   Header.dwSize  := SizeOf(Header);
7381   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7382
7383   Header.dwWidth  := Max(1, Width);
7384   Header.dwHeight := Max(1, Height);
7385
7386   // Caps
7387   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7388
7389   // Pixelformat
7390   Header.PixelFormat.dwSize := sizeof(Header);
7391   if (FormatDesc.IsCompressed) then begin
7392     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7393     case Format of
7394       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7395       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7396       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7397     end;
7398   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7399     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7400     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7401     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7402   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7403     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7404     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7405     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7406     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7407   end else begin
7408     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7409     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7410     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7411     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7412     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7413     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7414   end;
7415
7416   if (FormatDesc.HasAlpha) then
7417     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7418
7419   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7420   aStream.Write(Header, SizeOf(Header));
7421   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7422 end;
7423
7424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7425 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7427 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7428   const aWidth: Integer; const aHeight: Integer);
7429 var
7430   pTemp: pByte;
7431   Size: Integer;
7432 begin
7433   if (aHeight > 1) then begin
7434     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
7435     GetMem(pTemp, Size);
7436     try
7437       Move(aData^, pTemp^, Size);
7438       FreeMem(aData);
7439       aData := nil;
7440     except
7441       FreeMem(pTemp);
7442       raise;
7443     end;
7444   end else
7445     pTemp := aData;
7446   inherited SetDataPointer(pTemp, aFormat, aWidth);
7447 end;
7448
7449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7450 function TglBitmap1D.FlipHorz: Boolean;
7451 var
7452   Col: Integer;
7453   pTempDest, pDest, pSource: PByte;
7454 begin
7455   result := inherited FlipHorz;
7456   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
7457     pSource := Data;
7458     GetMem(pDest, fRowSize);
7459     try
7460       pTempDest := pDest;
7461       Inc(pTempDest, fRowSize);
7462       for Col := 0 to Width-1 do begin
7463         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
7464         Move(pSource^, pTempDest^, fPixelSize);
7465         Inc(pSource, fPixelSize);
7466       end;
7467       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
7468       result := true;
7469     except
7470       if Assigned(pDest) then
7471         FreeMem(pDest);
7472       raise;
7473     end;
7474   end;
7475 end;
7476
7477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7478 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
7479 var
7480   FormatDesc: TFormatDescriptor;
7481 begin
7482   // Upload data
7483   FormatDesc := TFormatDescriptor.Get(Format);
7484   if FormatDesc.IsCompressed then
7485     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
7486   else if aBuildWithGlu then
7487     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7488   else
7489     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7490
7491   // Free Data
7492   if (FreeDataAfterGenTexture) then
7493     FreeData;
7494 end;
7495
7496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7497 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
7498 var
7499   BuildWithGlu, TexRec: Boolean;
7500   TexSize: Integer;
7501 begin
7502   if Assigned(Data) then begin
7503     // Check Texture Size
7504     if (aTestTextureSize) then begin
7505       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7506
7507       if (Width > TexSize) then
7508         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7509
7510       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7511                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7512       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7513         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7514     end;
7515
7516     CreateId;
7517     SetupParameters(BuildWithGlu);
7518     UploadData(BuildWithGlu);
7519     glAreTexturesResident(1, @fID, @fIsResident);
7520   end;
7521 end;
7522
7523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7524 procedure TglBitmap1D.AfterConstruction;
7525 begin
7526   inherited;
7527   Target := GL_TEXTURE_1D;
7528 end;
7529
7530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7531 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7533 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7534 begin
7535   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7536     result := fLines[aIndex]
7537   else
7538     result := nil;
7539 end;
7540
7541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7542 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
7543   const aWidth: Integer; const aHeight: Integer);
7544 var
7545   Idx, LineWidth: Integer;
7546 begin
7547   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7548
7549   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7550     // Assigning Data
7551     if Assigned(Data) then begin
7552       SetLength(fLines, GetHeight);
7553       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7554
7555       for Idx := 0 to GetHeight-1 do begin
7556         fLines[Idx] := Data;
7557         Inc(fLines[Idx], Idx * LineWidth);
7558       end;
7559     end
7560       else SetLength(fLines, 0);
7561   end else begin
7562     SetLength(fLines, 0);
7563   end;
7564 end;
7565
7566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7567 procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
7568 var
7569   FormatDesc: TFormatDescriptor;
7570 begin
7571   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7572
7573   FormatDesc := TFormatDescriptor.Get(Format);
7574   if FormatDesc.IsCompressed then begin
7575     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7576   end else if aBuildWithGlu then begin
7577     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7578       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7579   end else begin
7580     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7581       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7582   end;
7583
7584   // Freigeben
7585   if (FreeDataAfterGenTexture) then
7586     FreeData;
7587 end;
7588
7589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7590 procedure TglBitmap2D.AfterConstruction;
7591 begin
7592   inherited;
7593   Target := GL_TEXTURE_2D;
7594 end;
7595
7596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7597 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7598 var
7599   Temp: pByte;
7600   Size, w, h: Integer;
7601   FormatDesc: TFormatDescriptor;
7602 begin
7603   FormatDesc := TFormatDescriptor.Get(Format);
7604   if FormatDesc.IsCompressed then
7605     raise EglBitmapUnsupportedFormat.Create(Format);
7606
7607   w    := aRight  - aLeft;
7608   h    := aBottom - aTop;
7609   Size := FormatDesc.GetSize(w, h);
7610   GetMem(Temp, Size);
7611   try
7612     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7613     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7614     SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
7615     FlipVert;
7616   except
7617     if Assigned(Temp) then
7618       FreeMem(Temp);
7619     raise;
7620   end;
7621 end;
7622
7623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7624 procedure TglBitmap2D.GetDataFromTexture;
7625 var
7626   Temp: PByte;
7627   TempWidth, TempHeight: Integer;
7628   TempIntFormat: Cardinal;
7629   IntFormat, f: TglBitmapFormat;
7630   FormatDesc: TFormatDescriptor;
7631 begin
7632   Bind;
7633
7634   // Request Data
7635   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7636   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7637   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7638
7639   IntFormat := tfEmpty;
7640   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7641     FormatDesc := TFormatDescriptor.Get(f);
7642     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7643       IntFormat := FormatDesc.Format;
7644       break;
7645     end;
7646   end;
7647
7648   // Getting data from OpenGL
7649   FormatDesc := TFormatDescriptor.Get(IntFormat);
7650   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7651   try
7652     if FormatDesc.IsCompressed then
7653       glGetCompressedTexImage(Target, 0, Temp)
7654     else
7655      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7656     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7657   except
7658     if Assigned(Temp) then
7659       FreeMem(Temp);
7660     raise;
7661   end;
7662 end;
7663
7664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7665 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7666 var
7667   BuildWithGlu, PotTex, TexRec: Boolean;
7668   TexSize: Integer;
7669 begin
7670   if Assigned(Data) then begin
7671     // Check Texture Size
7672     if (aTestTextureSize) then begin
7673       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7674
7675       if ((Height > TexSize) or (Width > TexSize)) then
7676         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7677
7678       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7679       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7680       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7681         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7682     end;
7683
7684     CreateId;
7685     SetupParameters(BuildWithGlu);
7686     UploadData(Target, BuildWithGlu);
7687     glAreTexturesResident(1, @fID, @fIsResident);
7688   end;
7689 end;
7690
7691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7692 function TglBitmap2D.FlipHorz: Boolean;
7693 var
7694   Col, Row: Integer;
7695   TempDestData, DestData, SourceData: PByte;
7696   ImgSize: Integer;
7697 begin
7698   result := inherited FlipHorz;
7699   if Assigned(Data) then begin
7700     SourceData := Data;
7701     ImgSize := Height * fRowSize;
7702     GetMem(DestData, ImgSize);
7703     try
7704       TempDestData := DestData;
7705       Dec(TempDestData, fRowSize + fPixelSize);
7706       for Row := 0 to Height -1 do begin
7707         Inc(TempDestData, fRowSize * 2);
7708         for Col := 0 to Width -1 do begin
7709           Move(SourceData^, TempDestData^, fPixelSize);
7710           Inc(SourceData, fPixelSize);
7711           Dec(TempDestData, fPixelSize);
7712         end;
7713       end;
7714       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7715       result := true;
7716     except
7717       if Assigned(DestData) then
7718         FreeMem(DestData);
7719       raise;
7720     end;
7721   end;
7722 end;
7723
7724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7725 function TglBitmap2D.FlipVert: Boolean;
7726 var
7727   Row: Integer;
7728   TempDestData, DestData, SourceData: PByte;
7729 begin
7730   result := inherited FlipVert;
7731   if Assigned(Data) then begin
7732     SourceData := Data;
7733     GetMem(DestData, Height * fRowSize);
7734     try
7735       TempDestData := DestData;
7736       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7737       for Row := 0 to Height -1 do begin
7738         Move(SourceData^, TempDestData^, fRowSize);
7739         Dec(TempDestData, fRowSize);
7740         Inc(SourceData, fRowSize);
7741       end;
7742       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
7743       result := true;
7744     except
7745       if Assigned(DestData) then
7746         FreeMem(DestData);
7747       raise;
7748     end;
7749   end;
7750 end;
7751
7752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7753 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7755 type
7756   TMatrixItem = record
7757     X, Y: Integer;
7758     W: Single;
7759   end;
7760
7761   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7762   TglBitmapToNormalMapRec = Record
7763     Scale: Single;
7764     Heights: array of Single;
7765     MatrixU : array of TMatrixItem;
7766     MatrixV : array of TMatrixItem;
7767   end;
7768
7769 const
7770   ONE_OVER_255 = 1 / 255;
7771
7772   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7773 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7774 var
7775   Val: Single;
7776 begin
7777   with FuncRec do begin
7778     Val :=
7779       Source.Data.r * LUMINANCE_WEIGHT_R +
7780       Source.Data.g * LUMINANCE_WEIGHT_G +
7781       Source.Data.b * LUMINANCE_WEIGHT_B;
7782     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7783   end;
7784 end;
7785
7786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7787 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7788 begin
7789   with FuncRec do
7790     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7791 end;
7792
7793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7794 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7795 type
7796   TVec = Array[0..2] of Single;
7797 var
7798   Idx: Integer;
7799   du, dv: Double;
7800   Len: Single;
7801   Vec: TVec;
7802
7803   function GetHeight(X, Y: Integer): Single;
7804   begin
7805     with FuncRec do begin
7806       X := Max(0, Min(Size.X -1, X));
7807       Y := Max(0, Min(Size.Y -1, Y));
7808       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7809     end;
7810   end;
7811
7812 begin
7813   with FuncRec do begin
7814     with PglBitmapToNormalMapRec(Args)^ do begin
7815       du := 0;
7816       for Idx := Low(MatrixU) to High(MatrixU) do
7817         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7818
7819       dv := 0;
7820       for Idx := Low(MatrixU) to High(MatrixU) do
7821         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7822
7823       Vec[0] := -du * Scale;
7824       Vec[1] := -dv * Scale;
7825       Vec[2] := 1;
7826     end;
7827
7828     // Normalize
7829     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7830     if Len <> 0 then begin
7831       Vec[0] := Vec[0] * Len;
7832       Vec[1] := Vec[1] * Len;
7833       Vec[2] := Vec[2] * Len;
7834     end;
7835
7836     // Farbe zuweisem
7837     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7838     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7839     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7840   end;
7841 end;
7842
7843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7844 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7845 var
7846   Rec: TglBitmapToNormalMapRec;
7847
7848   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7849   begin
7850     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7851       Matrix[Index].X := X;
7852       Matrix[Index].Y := Y;
7853       Matrix[Index].W := W;
7854     end;
7855   end;
7856
7857 begin
7858   if TFormatDescriptor.Get(Format).IsCompressed then
7859     raise EglBitmapUnsupportedFormat.Create(Format);
7860
7861   if aScale > 100 then
7862     Rec.Scale := 100
7863   else if aScale < -100 then
7864     Rec.Scale := -100
7865   else
7866     Rec.Scale := aScale;
7867
7868   SetLength(Rec.Heights, Width * Height);
7869   try
7870     case aFunc of
7871       nm4Samples: begin
7872         SetLength(Rec.MatrixU, 2);
7873         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7874         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7875
7876         SetLength(Rec.MatrixV, 2);
7877         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7878         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7879       end;
7880
7881       nmSobel: begin
7882         SetLength(Rec.MatrixU, 6);
7883         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7884         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7885         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7886         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7887         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7888         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7889
7890         SetLength(Rec.MatrixV, 6);
7891         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7892         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7893         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7894         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7895         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7896         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7897       end;
7898
7899       nm3x3: begin
7900         SetLength(Rec.MatrixU, 6);
7901         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7902         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7903         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7904         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7905         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7906         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7907
7908         SetLength(Rec.MatrixV, 6);
7909         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7910         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7911         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7912         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7913         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7914         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7915       end;
7916
7917       nm5x5: begin
7918         SetLength(Rec.MatrixU, 20);
7919         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7920         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7921         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7922         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7923         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7924         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7925         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7926         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7927         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7928         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7929         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7930         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7931         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7932         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7933         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7934         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7935         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7936         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7937         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7938         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7939
7940         SetLength(Rec.MatrixV, 20);
7941         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7942         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7943         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7944         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7945         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7946         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7947         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7948         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7949         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7950         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7951         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7952         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7953         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7954         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7955         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7956         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7957         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7958         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7959         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7960         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7961       end;
7962     end;
7963
7964     // Daten Sammeln
7965     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7966       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7967     else
7968       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7969     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7970   finally
7971     SetLength(Rec.Heights, 0);
7972   end;
7973 end;
7974
7975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7976 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7978 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
7979 begin
7980   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
7981 end;
7982
7983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7984 procedure TglBitmapCubeMap.AfterConstruction;
7985 begin
7986   inherited;
7987
7988   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7989     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7990
7991   SetWrap;
7992   Target   := GL_TEXTURE_CUBE_MAP;
7993   fGenMode := GL_REFLECTION_MAP;
7994 end;
7995
7996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7997 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
7998 var
7999   BuildWithGlu: Boolean;
8000   TexSize: Integer;
8001 begin
8002   if (aTestTextureSize) then begin
8003     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8004
8005     if (Height > TexSize) or (Width > TexSize) then
8006       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8007
8008     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8009       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8010   end;
8011
8012   if (ID = 0) then
8013     CreateID;
8014   SetupParameters(BuildWithGlu);
8015   UploadData(aCubeTarget, BuildWithGlu);
8016 end;
8017
8018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8019 procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
8020 begin
8021   inherited Bind (aEnableTextureUnit);
8022   if aEnableTexCoordsGen then begin
8023     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8024     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8025     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8026     glEnable(GL_TEXTURE_GEN_S);
8027     glEnable(GL_TEXTURE_GEN_T);
8028     glEnable(GL_TEXTURE_GEN_R);
8029   end;
8030 end;
8031
8032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8033 procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
8034 begin
8035   inherited Unbind(aDisableTextureUnit);
8036   if aDisableTexCoordsGen then begin
8037     glDisable(GL_TEXTURE_GEN_S);
8038     glDisable(GL_TEXTURE_GEN_T);
8039     glDisable(GL_TEXTURE_GEN_R);
8040   end;
8041 end;
8042
8043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8044 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8046 type
8047   TVec = Array[0..2] of Single;
8048   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8049
8050   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8051   TglBitmapNormalMapRec = record
8052     HalfSize : Integer;
8053     Func: TglBitmapNormalMapGetVectorFunc;
8054   end;
8055
8056   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8057 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8058 begin
8059   aVec[0] := aHalfSize;
8060   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8061   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8062 end;
8063
8064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8065 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8066 begin
8067   aVec[0] := - aHalfSize;
8068   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8069   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8070 end;
8071
8072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8074 begin
8075   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8076   aVec[1] := aHalfSize;
8077   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8078 end;
8079
8080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8081 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8082 begin
8083   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8084   aVec[1] := - aHalfSize;
8085   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8086 end;
8087
8088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8089 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8090 begin
8091   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8092   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8093   aVec[2] := aHalfSize;
8094 end;
8095
8096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8097 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8098 begin
8099   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8100   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8101   aVec[2] := - aHalfSize;
8102 end;
8103
8104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8105 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8106 var
8107   i: Integer;
8108   Vec: TVec;
8109   Len: Single;
8110 begin
8111   with FuncRec do begin
8112     with PglBitmapNormalMapRec(Args)^ do begin
8113       Func(Vec, Position, HalfSize);
8114
8115       // Normalize
8116       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8117       if Len <> 0 then begin
8118         Vec[0] := Vec[0] * Len;
8119         Vec[1] := Vec[1] * Len;
8120         Vec[2] := Vec[2] * Len;
8121       end;
8122
8123       // Scale Vector and AddVectro
8124       Vec[0] := Vec[0] * 0.5 + 0.5;
8125       Vec[1] := Vec[1] * 0.5 + 0.5;
8126       Vec[2] := Vec[2] * 0.5 + 0.5;
8127     end;
8128
8129     // Set Color
8130     for i := 0 to 2 do
8131       Dest.Data.arr[i] := Round(Vec[i] * 255);
8132   end;
8133 end;
8134
8135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8136 procedure TglBitmapNormalMap.AfterConstruction;
8137 begin
8138   inherited;
8139   fGenMode := GL_NORMAL_MAP;
8140 end;
8141
8142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8143 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8144 var
8145   Rec: TglBitmapNormalMapRec;
8146   SizeRec: TglBitmapPixelPosition;
8147 begin
8148   Rec.HalfSize := aSize div 2;
8149   FreeDataAfterGenTexture := false;
8150
8151   SizeRec.Fields := [ffX, ffY];
8152   SizeRec.X := aSize;
8153   SizeRec.Y := aSize;
8154
8155   // Positive X
8156   Rec.Func := glBitmapNormalMapPosX;
8157   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8158   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8159
8160   // Negative X
8161   Rec.Func := glBitmapNormalMapNegX;
8162   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8163   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8164
8165   // Positive Y
8166   Rec.Func := glBitmapNormalMapPosY;
8167   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8168   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8169
8170   // Negative Y
8171   Rec.Func := glBitmapNormalMapNegY;
8172   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8173   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8174
8175   // Positive Z
8176   Rec.Func := glBitmapNormalMapPosZ;
8177   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8178   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8179
8180   // Negative Z
8181   Rec.Func := glBitmapNormalMapNegZ;
8182   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
8183   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8184 end;
8185
8186
8187 initialization
8188   glBitmapSetDefaultFormat(tfEmpty);
8189   glBitmapSetDefaultMipmap(mmMipmap);
8190   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8191   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8192
8193   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8194   glBitmapSetDefaultDeleteTextureOnFree    (true);
8195
8196   TFormatDescriptor.Init;
8197
8198 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8199   OpenGLInitialized := false;
8200   InitOpenGLCS := TCriticalSection.Create;
8201 {$ENDIF}
8202
8203 finalization
8204   TFormatDescriptor.Finalize;
8205
8206 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8207   FreeAndNil(InitOpenGLCS);
8208 {$ENDIF}
8209
8210 end.
8211