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 The contents of this file are used with permission, subject to
   6 the Mozilla Public License Version 1.1 (the "License"); you may
   7 not use this file except in compliance with the License. You may
   8 obtain a copy of the License at
   9 http://www.mozilla.org/MPL/MPL-1.1.html
  10 ------------------------------------------------------------
  11 Version 2.0.3
  12 ------------------------------------------------------------
  13 History
  14 21-03-2010
  15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16   then it's your problem if that isn't true. This prevents the unit for incompatibility
  17   with newer versions of Delphi.
  18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20 10-08-2008
  21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22 - Additional Datapointer for functioninterface now has the name CustomData
  23 24-07-2008
  24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25 - If you load an texture from an file the property Filename will be set to the name of the file
  26 - Three new properties to attach custom data to the Texture objects
  27   - CustomName  (free for use string)
  28   - CustomNameW (free for use widestring)
  29   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30 27-05-2008
  31 - RLE TGAs loaded much faster
  32 26-05-2008
  33 - fixed some problem with reading RLE TGAs.
  34 21-05-2008
  35 - function clone now only copys data if it's assigned and now it also copies the ID
  36 - it seems that lazarus dont like comments in comments.
  37 01-05-2008
  38 - It's possible to set the id of the texture
  39 - define GLB_NO_NATIVE_GL deactivated by default
  40 27-04-2008
  41 - Now supports the following libraries
  42   - SDL and SDL_image
  43   - libPNG
  44   - libJPEG
  45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46 - BMPs now loaded manuel
  47 - Large restructuring
  48 - Property DataPtr now has the name Data
  49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50 - Unused Depth removed
  51 - Function FreeData to freeing image data added
  52 24-10-2007
  53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54 15-11-2006
  55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57 - Function ReadOpenGLExtension is now only intern
  58 29-06-2006
  59 - pngimage now disabled by default like all other versions.
  60 26-06-2006
  61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62 22-06-2006
  63 - Fixed some Problem with Delphi 5
  64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65 22-03-2006
  66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67 09-03-2006
  68 - Internal Format ifDepth8 added
  69 - function GrabScreen now supports all uncompressed formats
  70 31-01-2006
  71 - AddAlphaFromglBitmap implemented
  72 29-12-2005
  73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74 28-12-2005
  75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76   property Width, Height, Depth are still existing and new property Dimension are avail
  77 11-12-2005
  78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79 19-10-2005
  80 - Added function GrabScreen to class TglBitmap2D
  81 18-10-2005
  82 - Added support to Save images
  83 - Added function Clone to Clone Instance
  84 11-10-2005
  85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86   Usefull for Future
  87 - Several speed optimizations
  88 09-10-2005
  89 - Internal structure change. Loading of TGA, PNG and DDS improved.
  90   Data, format and size will now set directly with SetDataPtr.
  91 - AddFunc now works with all Types of Images and Formats
  92 - Some Funtions moved to Baseclass TglBitmap
  93 06-10-2005
  94 - Added Support to decompress DXT3 and DXT5 compressed Images.
  95 - Added Mapping to convert data from one format into an other.
  96 05-10-2005
  97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98   supported Input format (supported by GetPixel) into any uncompresed Format
  99 - Added Support to decompress DXT1 compressed Images.
 100 - SwapColors replaced by ConvertTo
 101 04-10-2005
 102 - Added Support for compressed DDSs
 103 - Added new internal formats (DXT1, DXT3, DXT5)
 104 29-09-2005
 105 - Parameter Components renamed to InternalFormat
 106 23-09-2005
 107 - Some AllocMem replaced with GetMem (little speed change)
 108 - better exception handling. Better protection from memory leaks.
 109 22-09-2005
 110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 112 07-09-2005
 113 - Added support for Grayscale textures
 114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 115 10-07-2005
 116 - Added support for GL_VERSION_2_0
 117 - Added support for GL_EXT_texture_filter_anisotropic
 118 04-07-2005
 119 - Function FillWithColor fills the Image with one Color
 120 - Function LoadNormalMap added
 121 30-06-2005
 122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 123 - ToNormalMap now supports Sobel (nmSobel) function.
 124 29-06-2005
 125 - support for RLE Compressed RGB TGAs added
 126 28-06-2005
 127 - Class TglBitmapNormalMap added to support Normalmap generation
 128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 129   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 130 16-06-2005
 131 - Method LoadCubeMapClass removed
 132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 133 - virtual abstract method GenTexture in class TglBitmap now is protected
 134 12-06-2005
 135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 136 10-06-2005
 137 - little enhancement for IsPowerOfTwo
 138 - TglBitmap1D.GenTexture now tests NPOT Textures
 139 06-06-2005
 140 - some little name changes. All properties or function with Texture in name are
 141   now without texture in name. We have allways texture so we dosn't name it.
 142 03-06-2005
 143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 144   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 145 02-06-2005
 146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 147 25-04-2005
 148 - Function Unbind added
 149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 150 21-04-2005
 151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 152 29-03-2005
 153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 154   To Enable png's use the define pngimage
 155 22-03-2005
 156 - New Functioninterface added
 157 - Function GetPixel added
 158 27-11-2004
 159 - Property BuildMipMaps renamed to MipMap
 160 21-11-2004
 161 - property Name removed.
 162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 163 22-05-2004
 164 - property name added. Only used in glForms!
 165 26-11-2003
 166 - property FreeDataAfterGenTexture is now available as default (default = true)
 167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 168 - function MoveMemory replaced with function Move (little speed change)
 169 - several calculations stored in variables (little speed change)
 170 29-09-2003
 171 - property BuildMipsMaps added (default = true)
 172   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 173 - property FreeDataAfterGenTexture added (default = true)
 174   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 175 - parameter DisableOtherTextureUnits of Bind removed
 176 - parameter FreeDataAfterGeneration of GenTextures removed
 177 12-09-2003
 178 - TglBitmap dosn't delete data if class was destroyed (fixed)
 179 09-09-2003
 180 - Bind now enables TextureUnits (by params)
 181 - GenTextures can leave data (by param)
 182 - LoadTextures now optimal
 183 03-09-2003
 184 - Performance optimization in AddFunc
 185 - procedure Bind moved to subclasses
 186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 187 19-08-2003
 188 - Texturefilter and texturewrap now also as defaults
 189   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 190   Magfilter = GL_LINEAR
 191   Wrap(str) = GL_CLAMP_TO_EDGE
 192 - Added new format tfCompressed to create a compressed texture.
 193 - propertys IsCompressed, TextureSize and IsResident added
 194   IsCompressed and TextureSize only contains data from level 0
 195 18-08-2003
 196 - Added function AddFunc to add PerPixelEffects to Image
 197 - LoadFromFunc now based on AddFunc
 198 - Invert now based on AddFunc
 199 - SwapColors now based on AddFunc
 200 16-08-2003
 201 - Added function FlipHorz
 202 15-08-2003
 203 - Added function LaodFromFunc to create images with function
 204 - Added function FlipVert
 205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 206 29-07-2003
 207 - Added Alphafunctions to calculate alpha per function
 208 - Added Alpha from ColorKey using alphafunctions
 209 28-07-2003
 210 - First full functionally Version of glBitmap
 211 - Support for 24Bit and 32Bit TGA Pictures added
 212 25-07-2003
 213 - begin of programming
 214 ***********************************************************}
 215 unit glBitmap;
 216
 217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 218 // Please uncomment the defines below to configure the glBitmap to your preferences.
 219 // If you have configured the unit you can uncomment the warning above.
 220
 221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 222 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 224 // activate to enable build-in OpenGL support with statically linked methods
 225 // use dglOpenGL.pas if not enabled
 226 {.$DEFINE GLB_NATIVE_OGL_STATIC}
 227
 228 // activate to enable build-in OpenGL support with dynamically linked methods
 229 // use dglOpenGL.pas if not enabled
 230 {$DEFINE GLB_NATIVE_OGL_DYNAMIC}
 231
 232 // activate to enable the support for SDL_surfaces
 233 {.$DEFINE GLB_SDL}
 234
 235 // activate  to enable the support for TBitmap from Delphi (not lazarus)
 236 {.$DEFINE GLB_DELPHI}
 237
 238
 239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 240 // activate to enable the support of SDL_image to load files. (READ ONLY)
 241 // If you enable SDL_image all other libraries will be ignored!
 242 {.$DEFINE GLB_SDL_IMAGE}
 243
 244 // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
 245 // if you enable pngimage the libPNG will be ignored
 246 {.$DEFINE GLB_PNGIMAGE}
 247
 248 // activate to use the libPNG http://www.libpng.org/
 249 // You will need an aditional header.
 250 // http://www.opengl24.de/index.php?cat=header&file=libpng
 251 {.$DEFINE GLB_LIB_PNG}
 252
 253 // if you enable delphi jpegs the libJPEG will be ignored
 254 {.$DEFINE GLB_DELPHI_JPEG}
 255
 256 // activateto use the libJPEG http://www.ijg.org/
 257 // You will need an aditional header.
 258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
 259 {.$DEFINE GLB_LIB_JPEG}
 260
 261
 262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 263 // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 265 // Delphi Versions
 266 {$IFDEF fpc}
 267   {$MODE Delphi}
 268
 269   {$IFDEF CPUI386}
 270     {$DEFINE CPU386}
 271     {$ASMMODE INTEL}
 272   {$ENDIF}
 273
 274   {$IFNDEF WINDOWS}
 275     {$linklib c}
 276   {$ENDIF}
 277 {$ENDIF}
 278
 279 // Operation System
 280 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
 281   {$DEFINE GLB_WIN}
 282 {$ELSEIF DEFINED(LINUX)}
 283   {$DEFINE GLB_LINUX}
 284 {$IFEND}
 285
 286 // native OpenGL Support
 287 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 288   {$DEFINE GLB_NATIVE_OGL}
 289 {$IFEND}
 290
 291 // checking define combinations
 292 //SDL Image
 293 {$IFDEF GLB_SDL_IMAGE}
 294   {$IFNDEF GLB_SDL}
 295     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 296     {$DEFINE GLB_SDL}
 297   {$ENDIF}
 298   {$IFDEF GLB_PNGIMAGE}
 299     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 300     {$undef GLB_PNGIMAGE}
 301   {$ENDIF}
 302   {$IFDEF GLB_DELPHI_JPEG}
 303     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 304     {$undef GLB_DELPHI_JPEG}
 305   {$ENDIF}
 306   {$IFDEF GLB_LIB_PNG}
 307     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 308     {$undef GLB_LIB_PNG}
 309   {$ENDIF}
 310   {$IFDEF GLB_LIB_JPEG}
 311     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 312     {$undef GLB_LIB_JPEG}
 313   {$ENDIF}
 314
 315   {$DEFINE GLB_SUPPORT_PNG_READ}
 316   {$DEFINE GLB_SUPPORT_JPEG_READ}
 317 {$ENDIF}
 318
 319 // PNG Image
 320 {$IFDEF GLB_PNGIMAGE}
 321   {$IFDEF GLB_LIB_PNG}
 322     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 323     {$undef GLB_LIB_PNG}
 324   {$ENDIF}
 325
 326   {$DEFINE GLB_SUPPORT_PNG_READ}
 327   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 328 {$ENDIF}
 329
 330 // libPNG
 331 {$IFDEF GLB_LIB_PNG}
 332   {$DEFINE GLB_SUPPORT_PNG_READ}
 333   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 334 {$ENDIF}
 335
 336 // JPEG Image
 337 {$IFDEF GLB_DELPHI_JPEG}
 338   {$IFDEF GLB_LIB_JPEG}
 339     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 340     {$undef GLB_LIB_JPEG}
 341   {$ENDIF}
 342
 343   {$DEFINE GLB_SUPPORT_JPEG_READ}
 344   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 345 {$ENDIF}
 346
 347 // libJPEG
 348 {$IFDEF GLB_LIB_JPEG}
 349   {$DEFINE GLB_SUPPORT_JPEG_READ}
 350   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 351 {$ENDIF}
 352
 353 // native OpenGL
 354 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 355   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 356 {$ENDIF}
 357
 358 // general options
 359 {$EXTENDEDSYNTAX ON}
 360 {$LONGSTRINGS ON}
 361 {$ALIGN ON}
 362 {$IFNDEF FPC}
 363   {$OPTIMIZATION ON}
 364 {$ENDIF}
 365
 366 interface
 367
 368 uses
 369   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                   {$ENDIF}
 370   {$IF DEFINED(GLB_WIN) AND
 371        DEFINED(GLB_NATIVE_OGL)} windows,                 {$IFEND}
 372
 373   {$IFDEF GLB_SDL}              SDL,                         {$ENDIF}
 374   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,           {$ENDIF}
 375
 376   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                   {$ENDIF}
 377
 378   {$IFDEF GLB_PNGIMAGE}         pngimage,                    {$ENDIF}
 379   {$IFDEF GLB_LIB_PNG}          libPNG,                      {$ENDIF}
 380
 381   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                        {$ENDIF}
 382   {$IFDEF GLB_LIB_JPEG}         libJPEG,                     {$ENDIF}
 383
 384   Classes, SysUtils;
 385
 386 {$IFNDEF GLB_DELPHI}
 387 type
 388   HGLRC = Cardinal;
 389   DWORD = Cardinal;
 390   PDWORD = ^DWORD;
 391
 392   TRGBQuad = packed record
 393     rgbBlue: Byte;
 394     rgbGreen: Byte;
 395     rgbRed: Byte;
 396     rgbReserved: Byte;
 397   end;
 398 {$ENDIF}
 399
 400 {$IFDEF GLB_NATIVE_OGL}
 401 const
 402   GL_TRUE   = 1;
 403   GL_FALSE  = 0;
 404
 405   GL_VERSION    = $1F02;
 406   GL_EXTENSIONS = $1F03;
 407
 408   GL_TEXTURE_1D         = $0DE0;
 409   GL_TEXTURE_2D         = $0DE1;
 410   GL_TEXTURE_RECTANGLE  = $84F5;
 411
 412   GL_TEXTURE_WIDTH            = $1000;
 413   GL_TEXTURE_HEIGHT           = $1001;
 414   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 415
 416   GL_ALPHA    = $1906;
 417   GL_ALPHA4   = $803B;
 418   GL_ALPHA8   = $803C;
 419   GL_ALPHA12  = $803D;
 420   GL_ALPHA16  = $803E;
 421
 422   GL_LUMINANCE    = $1909;
 423   GL_LUMINANCE4   = $803F;
 424   GL_LUMINANCE8   = $8040;
 425   GL_LUMINANCE12  = $8041;
 426   GL_LUMINANCE16  = $8042;
 427
 428   GL_LUMINANCE_ALPHA      = $190A;
 429   GL_LUMINANCE4_ALPHA4    = $8043;
 430   GL_LUMINANCE6_ALPHA2    = $8044;
 431   GL_LUMINANCE8_ALPHA8    = $8045;
 432   GL_LUMINANCE12_ALPHA4   = $8046;
 433   GL_LUMINANCE12_ALPHA12  = $8047;
 434   GL_LUMINANCE16_ALPHA16  = $8048;
 435
 436   GL_RGB      = $1907;
 437   GL_BGR      = $80E0;
 438   GL_R3_G3_B2 = $2A10;
 439   GL_RGB4     = $804F;
 440   GL_RGB5     = $8050;
 441   GL_RGB565   = $8D62;
 442   GL_RGB8     = $8051;
 443   GL_RGB10    = $8052;
 444   GL_RGB12    = $8053;
 445   GL_RGB16    = $8054;
 446
 447   GL_RGBA     = $1908;
 448   GL_BGRA     = $80E1;
 449   GL_RGBA2    = $8055;
 450   GL_RGBA4    = $8056;
 451   GL_RGB5_A1  = $8057;
 452   GL_RGBA8    = $8058;
 453   GL_RGB10_A2 = $8059;
 454   GL_RGBA12   = $805A;
 455   GL_RGBA16   = $805B;
 456
 457   GL_DEPTH_COMPONENT    = $1902;
 458   GL_DEPTH_COMPONENT16  = $81A5;
 459   GL_DEPTH_COMPONENT24  = $81A6;
 460   GL_DEPTH_COMPONENT32  = $81A7;
 461
 462   GL_COMPRESSED_RGB                 = $84ED;
 463   GL_COMPRESSED_RGBA                = $84EE;
 464   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 465   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 466   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 467   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 468
 469   GL_UNSIGNED_BYTE            = $1401;
 470   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 471   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 472
 473   GL_UNSIGNED_SHORT             = $1403;
 474   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 475   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 476   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 477   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 478   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 479   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 480
 481   GL_UNSIGNED_INT                 = $1405;
 482   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 483   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 484   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 485   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 486
 487   { Texture Filter }
 488   GL_TEXTURE_MAG_FILTER     = $2800;
 489   GL_TEXTURE_MIN_FILTER     = $2801;
 490   GL_NEAREST                = $2600;
 491   GL_NEAREST_MIPMAP_NEAREST = $2700;
 492   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 493   GL_LINEAR                 = $2601;
 494   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 495   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 496
 497   { Texture Wrap }
 498   GL_TEXTURE_WRAP_S   = $2802;
 499   GL_TEXTURE_WRAP_T   = $2803;
 500   GL_TEXTURE_WRAP_R   = $8072;
 501   GL_CLAMP            = $2900;
 502   GL_REPEAT           = $2901;
 503   GL_CLAMP_TO_EDGE    = $812F;
 504   GL_CLAMP_TO_BORDER  = $812D;
 505   GL_MIRRORED_REPEAT  = $8370;
 506
 507   { Other }
 508   GL_GENERATE_MIPMAP      = $8191;
 509   GL_TEXTURE_BORDER_COLOR = $1004;
 510   GL_MAX_TEXTURE_SIZE     = $0D33;
 511   GL_PACK_ALIGNMENT       = $0D05;
 512   GL_UNPACK_ALIGNMENT     = $0CF5;
 513
 514   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 515   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 516
 517 {$ifdef LINUX}
 518   libglu    = 'libGLU.so.1';
 519   libopengl = 'libGL.so.1';
 520 {$else}
 521   libglu    = 'glu32.dll';
 522   libopengl = 'opengl32.dll';
 523 {$endif}
 524
 525 type
 526   GLboolean = BYTEBOOL;
 527   GLint     = Integer;
 528   GLsizei   = Integer;
 529   GLuint    = Cardinal;
 530   GLfloat   = Single;
 531   GLenum    = Cardinal;
 532
 533   PGLvoid    = Pointer;
 534   PGLboolean = ^GLboolean;
 535   PGLint     = ^GLint;
 536   PGLuint    = ^GLuint;
 537   PGLfloat   = ^GLfloat;
 538
 539   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 540   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}
 541   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 542
 543 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 544   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 545   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 546
 547   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 548   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 549
 550   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 551   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 552   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 553   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 554   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 555   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 556
 557   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 558   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 559   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 560
 561   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 562   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 563   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 564
 565   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}
 566   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}
 567   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 568
 569   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 570   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 571
 572   {$IFDEF GLB_LINUX}
 573   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 574   {$ELSE}
 575   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 576   {$ENDIF}
 577
 578 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 579   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 580   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 581
 582   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 583   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 584
 585   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 586   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 587   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 588   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 589   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 590   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 591
 592   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 593   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 594   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 595
 596   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 597   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;
 598   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 599
 600   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;
 601   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;
 602   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 603
 604   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 605   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 606 {$ENDIF}
 607
 608 var
 609   GL_VERSION_1_2,
 610   GL_VERSION_1_3,
 611   GL_VERSION_1_4,
 612   GL_VERSION_2_0,
 613
 614   GL_SGIS_generate_mipmap,
 615
 616   GL_ARB_texture_border_clamp,
 617   GL_ARB_texture_mirrored_repeat,
 618   GL_ARB_texture_rectangle,
 619   GL_ARB_texture_non_power_of_two,
 620
 621   GL_IBM_texture_mirrored_repeat,
 622
 623   GL_NV_texture_rectangle,
 624
 625   GL_EXT_texture_edge_clamp,
 626   GL_EXT_texture_rectangle,
 627   GL_EXT_texture_filter_anisotropic: Boolean;
 628
 629   glCompressedTexImage1D: TglCompressedTexImage1D;
 630   glCompressedTexImage2D: TglCompressedTexImage2D;
 631   glGetCompressedTexImage: TglGetCompressedTexImage;
 632
 633 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 634   glEnable: TglEnable;
 635   glDisable: TglDisable;
 636
 637   glGetString: TglGetString;
 638   glGetIntegerv: TglGetIntegerv;
 639
 640   glTexParameteri: TglTexParameteri;
 641   glTexParameterfv: TglTexParameterfv;
 642   glGetTexParameteriv: TglGetTexParameteriv;
 643   glGetTexParameterfv: TglGetTexParameterfv;
 644   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 645   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 646
 647   glGenTextures: TglGenTextures;
 648   glBindTexture: TglBindTexture;
 649   glDeleteTextures: TglDeleteTextures;
 650
 651   glAreTexturesResident: TglAreTexturesResident;
 652   glReadPixels: TglReadPixels;
 653   glPixelStorei: TglPixelStorei;
 654
 655   glTexImage1D: TglTexImage1D;
 656   glTexImage2D: TglTexImage2D;
 657   glGetTexImage: TglGetTexImage;
 658
 659   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 660   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 661
 662   {$IF DEFINED(GLB_WIN)}
 663   wglGetProcAddress: TwglGetProcAddress;
 664   {$ELSEIF DEFINED(GLB_LINUX)}
 665   glXGetProcAddress: TglXGetProcAddress;
 666   glXGetProcAddressARB: TglXGetProcAddressARB;
 667   {$ENDIF}
 668 {$ENDIF}
 669
 670 (*
 671 {$IFDEF GLB_DELPHI}
 672 var
 673   gLastContext: HGLRC;
 674 {$ENDIF}
 675 *)
 676
 677 {$ENDIF}
 678
 679 type
 680 ////////////////////////////////////////////////////////////////////////////////////////////////////
 681   EglBitmapException               = class(Exception);
 682   EglBitmapSizeToLargeException    = class(EglBitmapException);
 683   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 684   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
 685
 686 ////////////////////////////////////////////////////////////////////////////////////////////////////
 687   TglBitmapFormat = (
 688     tfEmpty = 0, //must be smallest value!
 689
 690     tfAlpha4,
 691     tfAlpha8,
 692     tfAlpha12,
 693     tfAlpha16,
 694
 695     tfLuminance4,
 696     tfLuminance8,
 697     tfLuminance12,
 698     tfLuminance16,
 699
 700     tfLuminance4Alpha4,
 701     tfLuminance6Alpha2,
 702     tfLuminance8Alpha8,
 703     tfLuminance12Alpha4,
 704     tfLuminance12Alpha12,
 705     tfLuminance16Alpha16,
 706
 707     tfR3G3B2,
 708     tfRGB4,
 709     tfR5G6B5,
 710     tfRGB5,
 711     tfRGB8,
 712     tfRGB10,
 713     tfRGB12,
 714     tfRGB16,
 715
 716     tfRGBA2,
 717     tfRGBA4,
 718     tfRGB5A1,
 719     tfRGBA8,
 720     tfRGB10A2,
 721     tfRGBA12,
 722     tfRGBA16,
 723
 724     tfBGR4,
 725     tfB5G6R5,
 726     tfBGR5,
 727     tfBGR8,
 728     tfBGR10,
 729     tfBGR12,
 730     tfBGR16,
 731
 732     tfBGRA2,
 733     tfBGRA4,
 734     tfBGR5A1,
 735     tfBGRA8,
 736     tfBGR10A2,
 737     tfBGRA12,
 738     tfBGRA16,
 739
 740     tfDepth16,
 741     tfDepth24,
 742     tfDepth32,
 743
 744     tfS3tcDtx1RGBA,
 745     tfS3tcDtx3RGBA,
 746     tfS3tcDtx5RGBA
 747   );
 748
 749   TglBitmapFileType = (
 750      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 751      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 752      ftDDS,
 753      ftTGA,
 754      ftBMP);
 755    TglBitmapFileTypes = set of TglBitmapFileType;
 756
 757    TglBitmapMipMap = (
 758      mmNone,
 759      mmMipmap,
 760      mmMipmapGlu);
 761
 762    TglBitmapNormalMapFunc = (
 763      nm4Samples,
 764      nmSobel,
 765      nm3x3,
 766      nm5x5);
 767
 768 ////////////////////////////////////////////////////////////////////////////////////////////////////
 769   TglBitmapColorRec = packed record
 770   case Integer of
 771     0: (r, g, b, a: Cardinal);
 772     1: (arr: array[0..3] of Cardinal);
 773   end;
 774
 775   TglBitmapPixelData = packed record
 776     Data, Range: TglBitmapColorRec;
 777     Format: TglBitmapFormat;
 778   end;
 779   PglBitmapPixelData = ^TglBitmapPixelData;
 780
 781 ////////////////////////////////////////////////////////////////////////////////////////////////////
 782   TglBitmapPixelPositionFields = set of (ffX, ffY);
 783   TglBitmapPixelPosition = record
 784     Fields : TglBitmapPixelPositionFields;
 785     X : Word;
 786     Y : Word;
 787   end;
 788
 789 ////////////////////////////////////////////////////////////////////////////////////////////////////
 790   TglBitmap = class;
 791   TglBitmapFunctionRec = record
 792     Sender:   TglBitmap;
 793     Size:     TglBitmapPixelPosition;
 794     Position: TglBitmapPixelPosition;
 795     Source:   TglBitmapPixelData;
 796     Dest:     TglBitmapPixelData;
 797     Args:     Pointer;
 798   end;
 799   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 800
 801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 802   TglBitmap = class
 803   protected
 804     fID: GLuint;
 805     fTarget: GLuint;
 806     fAnisotropic: Integer;
 807     fDeleteTextureOnFree: Boolean;
 808     fFreeDataAfterGenTexture: Boolean;
 809     fData: PByte;
 810     fIsResident: Boolean;
 811     fBorderColor: array[0..3] of Single;
 812
 813     fDimension: TglBitmapPixelPosition;
 814     fMipMap: TglBitmapMipMap;
 815     fFormat: TglBitmapFormat;
 816
 817     // Mapping
 818     fPixelSize: Integer;
 819     fRowSize: Integer;
 820
 821     // Filtering
 822     fFilterMin: Cardinal;
 823     fFilterMag: Cardinal;
 824
 825     // TexturWarp
 826     fWrapS: Cardinal;
 827     fWrapT: Cardinal;
 828     fWrapR: Cardinal;
 829
 830     // CustomData
 831     fFilename: String;
 832     fCustomName: String;
 833     fCustomNameW: WideString;
 834     fCustomData: Pointer;
 835
 836     //Getter
 837     function GetWidth:  Integer; virtual;
 838     function GetHeight: Integer; virtual;
 839
 840     function GetFileWidth:  Integer; virtual;
 841     function GetFileHeight: Integer; virtual;
 842
 843     //Setter
 844     procedure SetCustomData(const aValue: Pointer);
 845     procedure SetCustomName(const aValue: String);
 846     procedure SetCustomNameW(const aValue: WideString);
 847     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 848     procedure SetFormat(const aValue: TglBitmapFormat);
 849     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 850     procedure SetID(const aValue: Cardinal);
 851     procedure SetMipMap(const aValue: TglBitmapMipMap);
 852     procedure SetTarget(const aValue: Cardinal);
 853     procedure SetAnisotropic(const aValue: Integer);
 854
 855     procedure CreateID;
 856     procedure SetupParameters(out aBuildWithGlu: Boolean);
 857     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 858       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 859     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 860
 861     function FlipHorz: Boolean; virtual;
 862     function FlipVert: Boolean; virtual;
 863
 864     property Width:  Integer read GetWidth;
 865     property Height: Integer read GetHeight;
 866
 867     property FileWidth:  Integer read GetFileWidth;
 868     property FileHeight: Integer read GetFileHeight;
 869   public
 870     //Properties
 871     property ID:           Cardinal        read fID          write SetID;
 872     property Target:       Cardinal        read fTarget      write SetTarget;
 873     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 874     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 875     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 876
 877     property Filename:    String     read fFilename;
 878     property CustomName:  String     read fCustomName  write SetCustomName;
 879     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 880     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 881
 882     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 883     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 884
 885     property Dimension:  TglBitmapPixelPosition  read fDimension;
 886     property Data:       PByte                   read fData;
 887     property IsResident: Boolean                 read fIsResident;
 888
 889     procedure AfterConstruction; override;
 890     procedure BeforeDestruction; override;
 891
 892     //Load
 893     procedure LoadFromFile(const aFilename: String);
 894     procedure LoadFromStream(const aStream: TStream); virtual;
 895     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 896       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 897     {$IFDEF GLB_DELPHI}
 898     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 899     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 900     {$ENDIF}
 901
 902     //Save
 903     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 904     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 905
 906     //Convert
 907     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 908     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 909       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 910   public
 911     //Alpha & Co
 912     {$IFDEF GLB_SDL}
 913     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 914     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 915     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 916     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 917       const aArgs: Pointer = nil): Boolean;
 918     {$ENDIF}
 919
 920     {$IFDEF GLB_DELPHI}
 921     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 922     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 923     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 924     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 925       const aArgs: Pointer = nil): Boolean;
 926     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 927       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 928     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 929       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 930     {$ENDIF}
 931
 932     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 933     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 934     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 935     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 936
 937     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 938     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 939     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 940
 941     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 942     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 943     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 944
 945     function RemoveAlpha: Boolean; virtual;
 946   public
 947     //Common
 948     function Clone: TglBitmap;
 949     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 950     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 951     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 952     procedure FreeData;
 953
 954     //ColorFill
 955     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 956     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 957     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 958
 959     //TexParameters
 960     procedure SetFilter(const aMin, aMag: Cardinal);
 961     procedure SetWrap(
 962       const S: Cardinal = GL_CLAMP_TO_EDGE;
 963       const T: Cardinal = GL_CLAMP_TO_EDGE;
 964       const R: Cardinal = GL_CLAMP_TO_EDGE);
 965
 966     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 967     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 968
 969     //Constructors
 970     constructor Create; overload;
 971     constructor Create(const aFileName: String); overload;
 972     constructor Create(const aStream: TStream); overload;
 973     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 974     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 975     {$IFDEF GLB_DELPHI}
 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     {$ENDIF}
 979   private
 980     {$IFDEF GLB_SUPPORT_PNG_READ}
 981     function LoadPNG(const aStream: TStream): Boolean; virtual;
 982     procedure SavePNG(const aStream: TStream); virtual;
 983     {$ENDIF}
 984     {$IFDEF GLB_SUPPORT_JPEG_READ}
 985     function LoadJPEG(const aStream: TStream): Boolean; virtual;
 986     procedure SaveJPEG(const aStream: TStream); virtual;
 987     {$ENDIF}
 988     function LoadBMP(const aStream: TStream): Boolean; virtual;
 989     procedure SaveBMP(const aStream: TStream); virtual;
 990
 991     function LoadTGA(const aStream: TStream): Boolean; virtual;
 992     procedure SaveTGA(const aStream: TStream); virtual;
 993
 994     function LoadDDS(const aStream: TStream): Boolean; virtual;
 995     procedure SaveDDS(const aStream: TStream); virtual;
 996   end;
 997
 998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 999   TglBitmap2D = class(TglBitmap)
1000   protected
1001     // Bildeinstellungen
1002     fLines: array of PByte;
1003
1004     (* TODO
1005     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1006     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1007     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1008     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1009     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1010     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1011     *)
1012
1013     function GetScanline(const aIndex: Integer): Pointer;
1014     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1015       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1016     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1017   public
1018     property Width;
1019     property Height;
1020     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1021
1022     procedure AfterConstruction; override;
1023
1024     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1025     procedure GetDataFromTexture;
1026     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1027
1028     function FlipHorz: Boolean; override;
1029     function FlipVert: Boolean; override;
1030
1031     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1032       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1033   end;
1034
1035 (* TODO
1036   TglBitmapCubeMap = class(TglBitmap2D)
1037   protected
1038     fGenMode: Integer;
1039
1040     // Hide GenTexture
1041     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1042   public
1043     procedure AfterConstruction; override;
1044
1045     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1046
1047     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1048     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1049   end;
1050
1051
1052   TglBitmapNormalMap = class(TglBitmapCubeMap)
1053   public
1054     procedure AfterConstruction; override;
1055
1056     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1057   end;
1058
1059
1060   TglBitmap1D = class(TglBitmap)
1061   protected
1062     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1063
1064     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1065     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1066   public
1067     // propertys
1068     property Width;
1069
1070     procedure AfterConstruction; override;
1071
1072     // Other
1073     function FlipHorz: Boolean; override;
1074
1075     // Generation
1076     procedure GenTexture(TestTextureSize: Boolean = true); override;
1077   end;
1078 *)
1079
1080 const
1081   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1082
1083 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1084 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1085 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1086 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1087 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1088 procedure glBitmapSetDefaultWrap(
1089   const S: Cardinal = GL_CLAMP_TO_EDGE;
1090   const T: Cardinal = GL_CLAMP_TO_EDGE;
1091   const R: Cardinal = GL_CLAMP_TO_EDGE);
1092
1093 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1094 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1095 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1096 function glBitmapGetDefaultFormat: TglBitmapFormat;
1097 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1098 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1099
1100 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1101 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1102 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1103
1104 var
1105   glBitmapDefaultDeleteTextureOnFree: Boolean;
1106   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1107   glBitmapDefaultFormat: TglBitmapFormat;
1108   glBitmapDefaultMipmap: TglBitmapMipMap;
1109   glBitmapDefaultFilterMin: Cardinal;
1110   glBitmapDefaultFilterMag: Cardinal;
1111   glBitmapDefaultWrapS: Cardinal;
1112   glBitmapDefaultWrapT: Cardinal;
1113   glBitmapDefaultWrapR: Cardinal;
1114
1115 {$IFDEF GLB_DELPHI}
1116 function CreateGrayPalette: HPALETTE;
1117 {$ENDIF}
1118
1119 implementation
1120
1121
1122     (* TODO
1123     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1124     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1125     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1126     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1127     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1128     *)
1129
1130 uses
1131   Math, syncobjs;
1132
1133 type
1134 ////////////////////////////////////////////////////////////////////////////////////////////////////
1135   TShiftRec = packed record
1136   case Integer of
1137     0: (r, g, b, a: Byte);
1138     1: (arr: array[0..3] of Byte);
1139   end;
1140
1141   TFormatDescriptor = class(TObject)
1142   private
1143     function GetRedMask: UInt64;
1144     function GetGreenMask: UInt64;
1145     function GetBlueMask: UInt64;
1146     function GetAlphaMask: UInt64;
1147   protected
1148     fFormat: TglBitmapFormat;
1149     fWithAlpha: TglBitmapFormat;
1150     fWithoutAlpha: TglBitmapFormat;
1151     fRGBInverted: TglBitmapFormat;
1152     fUncompressed: TglBitmapFormat;
1153     fPixelSize: Single;
1154     fIsCompressed: Boolean;
1155
1156     fRange: TglBitmapColorRec;
1157     fShift: TShiftRec;
1158
1159     fglFormat:         Cardinal;
1160     fglInternalFormat: Cardinal;
1161     fglDataFormat:     Cardinal;
1162
1163     function GetComponents: Integer; virtual;
1164   public
1165     property Format:       TglBitmapFormat read fFormat;
1166     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1167     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1168     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1169     property Components:   Integer         read GetComponents;
1170     property PixelSize:    Single          read fPixelSize;
1171     property IsCompressed: Boolean         read fIsCompressed;
1172
1173     property glFormat:         Cardinal read fglFormat;
1174     property glInternalFormat: Cardinal read fglInternalFormat;
1175     property glDataFormat:     Cardinal read fglDataFormat;
1176
1177     property Range: TglBitmapColorRec read fRange;
1178     property Shift: TShiftRec         read fShift;
1179
1180     property RedMask:   UInt64 read GetRedMask;
1181     property GreenMask: UInt64 read GetGreenMask;
1182     property BlueMask:  UInt64 read GetBlueMask;
1183     property AlphaMask: UInt64 read GetAlphaMask;
1184
1185     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1186     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1187
1188     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1189     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1190
1191     function CreateMappingData: Pointer; virtual;
1192     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1193
1194     function IsEmpty:  Boolean; virtual;
1195     function HasAlpha: Boolean; virtual;
1196     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
1197
1198     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1199
1200     constructor Create; virtual;
1201   public
1202     class procedure Init;
1203     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1204     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1205     class procedure Clear;
1206     class procedure Finalize;
1207   end;
1208   TFormatDescriptorClass = class of TFormatDescriptor;
1209
1210   TfdEmpty = class(TFormatDescriptor);
1211
1212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1213   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1214     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1215     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1216     constructor Create; override;
1217   end;
1218
1219   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1220     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1221     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1222     constructor Create; override;
1223   end;
1224
1225   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1226     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1227     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1228     constructor Create; override;
1229   end;
1230
1231   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1232     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1233     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1234     constructor Create; override;
1235   end;
1236
1237   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1238     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1239     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1240     constructor Create; override;
1241   end;
1242
1243   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1244     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1245     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1246     constructor Create; override;
1247   end;
1248
1249   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1250     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1251     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1252     constructor Create; override;
1253   end;
1254
1255   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1256     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1257     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1258     constructor Create; override;
1259   end;
1260
1261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1262   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1263     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1264     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1265     constructor Create; override;
1266   end;
1267
1268   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1269     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1270     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1271     constructor Create; override;
1272   end;
1273
1274   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1275     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1276     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1277     constructor Create; override;
1278   end;
1279
1280   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1281     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1282     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1283     constructor Create; override;
1284   end;
1285
1286   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1287     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1288     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1289     constructor Create; override;
1290   end;
1291
1292   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1293     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1294     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1295     constructor Create; override;
1296   end;
1297
1298   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1299     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1300     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1301     constructor Create; override;
1302   end;
1303
1304   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1305     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1306     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1307     constructor Create; override;
1308   end;
1309
1310   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1311     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1312     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1313     constructor Create; override;
1314   end;
1315
1316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1317   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1318     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1319     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1320     constructor Create; override;
1321   end;
1322
1323   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1324     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1325     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1326     constructor Create; override;
1327   end;
1328
1329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1330   TfdAlpha4 = class(TfdAlpha_UB1)
1331     constructor Create; override;
1332   end;
1333
1334   TfdAlpha8 = class(TfdAlpha_UB1)
1335     constructor Create; override;
1336   end;
1337
1338   TfdAlpha12 = class(TfdAlpha_US1)
1339     constructor Create; override;
1340   end;
1341
1342   TfdAlpha16 = class(TfdAlpha_US1)
1343     constructor Create; override;
1344   end;
1345
1346   TfdLuminance4 = class(TfdLuminance_UB1)
1347     constructor Create; override;
1348   end;
1349
1350   TfdLuminance8 = class(TfdLuminance_UB1)
1351     constructor Create; override;
1352   end;
1353
1354   TfdLuminance12 = class(TfdLuminance_US1)
1355     constructor Create; override;
1356   end;
1357
1358   TfdLuminance16 = class(TfdLuminance_US1)
1359     constructor Create; override;
1360   end;
1361
1362   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1363     constructor Create; override;
1364   end;
1365
1366   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1367     constructor Create; override;
1368   end;
1369
1370   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1371     constructor Create; override;
1372   end;
1373
1374   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1375     constructor Create; override;
1376   end;
1377
1378   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1379     constructor Create; override;
1380   end;
1381
1382   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1383     constructor Create; override;
1384   end;
1385
1386   TfdR3G3B2 = class(TfdUniversal_UB1)
1387     constructor Create; override;
1388   end;
1389
1390   TfdRGB4 = class(TfdUniversal_US1)
1391     constructor Create; override;
1392   end;
1393
1394   TfdR5G6B5 = class(TfdUniversal_US1)
1395     constructor Create; override;
1396   end;
1397
1398   TfdRGB5 = class(TfdUniversal_US1)
1399     constructor Create; override;
1400   end;
1401
1402   TfdRGB8 = class(TfdRGB_UB3)
1403     constructor Create; override;
1404   end;
1405
1406   TfdRGB10 = class(TfdUniversal_UI1)
1407     constructor Create; override;
1408   end;
1409
1410   TfdRGB12 = class(TfdRGB_US3)
1411     constructor Create; override;
1412   end;
1413
1414   TfdRGB16 = class(TfdRGB_US3)
1415     constructor Create; override;
1416   end;
1417
1418   TfdRGBA2 = class(TfdRGBA_UB4)
1419     constructor Create; override;
1420   end;
1421
1422   TfdRGBA4 = class(TfdUniversal_US1)
1423     constructor Create; override;
1424   end;
1425
1426   TfdRGB5A1 = class(TfdUniversal_US1)
1427     constructor Create; override;
1428   end;
1429
1430   TfdRGBA8 = class(TfdRGBA_UB4)
1431     constructor Create; override;
1432   end;
1433
1434   TfdRGB10A2 = class(TfdUniversal_UI1)
1435     constructor Create; override;
1436   end;
1437
1438   TfdRGBA12 = class(TfdRGBA_US4)
1439     constructor Create; override;
1440   end;
1441
1442   TfdRGBA16 = class(TfdRGBA_US4)
1443     constructor Create; override;
1444   end;
1445
1446   TfdBGR4 = class(TfdUniversal_US1)
1447     constructor Create; override;
1448   end;
1449
1450   TfdB5G6R5 = class(TfdUniversal_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdBGR5 = class(TfdUniversal_US1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdBGR8 = class(TfdBGR_UB3)
1459     constructor Create; override;
1460   end;
1461
1462   TfdBGR10 = class(TfdUniversal_UI1)
1463     constructor Create; override;
1464   end;
1465
1466   TfdBGR12 = class(TfdBGR_US3)
1467     constructor Create; override;
1468   end;
1469
1470   TfdBGR16 = class(TfdBGR_US3)
1471     constructor Create; override;
1472   end;
1473
1474   TfdBGRA2 = class(TfdBGRA_UB4)
1475     constructor Create; override;
1476   end;
1477
1478   TfdBGRA4 = class(TfdUniversal_US1)
1479     constructor Create; override;
1480   end;
1481
1482   TfdBGR5A1 = class(TfdUniversal_US1)
1483     constructor Create; override;
1484   end;
1485
1486   TfdBGRA8 = class(TfdBGRA_UB4)
1487     constructor Create; override;
1488   end;
1489
1490   TfdBGR10A2 = class(TfdUniversal_UI1)
1491     constructor Create; override;
1492   end;
1493
1494   TfdBGRA12 = class(TfdBGRA_US4)
1495     constructor Create; override;
1496   end;
1497
1498   TfdBGRA16 = class(TfdBGRA_US4)
1499     constructor Create; override;
1500   end;
1501
1502   TfdDepth16 = class(TfdDepth_US1)
1503     constructor Create; override;
1504   end;
1505
1506   TfdDepth24 = class(TfdDepth_UI1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdDepth32 = class(TfdDepth_UI1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1515     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1516     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1517     constructor Create; override;
1518   end;
1519
1520   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
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     constructor Create; override;
1524   end;
1525
1526   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1527     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1528     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1529     constructor Create; override;
1530   end;
1531
1532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1533   TbmpBitfieldFormat = class(TFormatDescriptor)
1534   private
1535     procedure SetRedMask  (const aValue: UInt64);
1536     procedure SetGreenMask(const aValue: UInt64);
1537     procedure SetBlueMask (const aValue: UInt64);
1538     procedure SetAlphaMask(const aValue: UInt64);
1539
1540     procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
1541   public
1542     property RedMask:   UInt64 read GetRedMask   write SetRedMask;
1543     property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
1544     property BlueMask:  UInt64 read GetBlueMask  write SetBlueMask;
1545     property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
1546
1547     property PixelSize: Single read fPixelSize write fPixelSize;
1548
1549     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1550     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1551   end;
1552
1553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1554   TbmpColorTableEnty = packed record
1555     b, g, r, a: Byte;
1556   end;
1557   TbmpColorTable = array of TbmpColorTableEnty;
1558   TbmpColorTableFormat = class(TFormatDescriptor)
1559   private
1560     fColorTable: TbmpColorTable;
1561   public
1562     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1563     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1564     property Range:      TglBitmapColorRec read fRange      write fRange;
1565     property Shift:      TShiftRec         read fShift      write fShift;
1566     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1567
1568     procedure CreateColorTable;
1569
1570     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1571     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1572     destructor Destroy; override;
1573   end;
1574
1575 const
1576   LUMINANCE_WEIGHT_R = 0.30;
1577   LUMINANCE_WEIGHT_G = 0.59;
1578   LUMINANCE_WEIGHT_B = 0.11;
1579
1580   ALPHA_WEIGHT_R = 0.30;
1581   ALPHA_WEIGHT_G = 0.59;
1582   ALPHA_WEIGHT_B = 0.11;
1583
1584   DEPTH_WEIGHT_R = 0.333333333;
1585   DEPTH_WEIGHT_G = 0.333333333;
1586   DEPTH_WEIGHT_B = 0.333333333;
1587
1588   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1589
1590   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1591     TfdEmpty,
1592
1593     TfdAlpha4,
1594     TfdAlpha8,
1595     TfdAlpha12,
1596     TfdAlpha16,
1597
1598     TfdLuminance4,
1599     TfdLuminance8,
1600     TfdLuminance12,
1601     TfdLuminance16,
1602
1603     TfdLuminance4Alpha4,
1604     TfdLuminance6Alpha2,
1605     TfdLuminance8Alpha8,
1606     TfdLuminance12Alpha4,
1607     TfdLuminance12Alpha12,
1608     TfdLuminance16Alpha16,
1609
1610     TfdR3G3B2,
1611     TfdRGB4,
1612     TfdR5G6B5,
1613     TfdRGB5,
1614     TfdRGB8,
1615     TfdRGB10,
1616     TfdRGB12,
1617     TfdRGB16,
1618
1619     TfdRGBA2,
1620     TfdRGBA4,
1621     TfdRGB5A1,
1622     TfdRGBA8,
1623     TfdRGB10A2,
1624     TfdRGBA12,
1625     TfdRGBA16,
1626
1627     TfdBGR4,
1628     TfdB5G6R5,
1629     TfdBGR5,
1630     TfdBGR8,
1631     TfdBGR10,
1632     TfdBGR12,
1633     TfdBGR16,
1634
1635     TfdBGRA2,
1636     TfdBGRA4,
1637     TfdBGR5A1,
1638     TfdBGRA8,
1639     TfdBGR10A2,
1640     TfdBGRA12,
1641     TfdBGRA16,
1642
1643     TfdDepth16,
1644     TfdDepth24,
1645     TfdDepth32,
1646
1647     TfdS3tcDtx1RGBA,
1648     TfdS3tcDtx3RGBA,
1649     TfdS3tcDtx5RGBA
1650   );
1651
1652 var
1653   FormatDescriptorCS: TCriticalSection;
1654   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1655
1656 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1657 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1658 begin
1659   result.Fields := [];
1660
1661   if X >= 0 then
1662     result.Fields := result.Fields + [ffX];
1663   if Y >= 0 then
1664     result.Fields := result.Fields + [ffY];
1665
1666   result.X := Max(0, X);
1667   result.Y := Max(0, Y);
1668 end;
1669
1670 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1671 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1672 begin
1673   result.r := r;
1674   result.g := g;
1675   result.b := b;
1676   result.a := a;
1677 end;
1678
1679 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1680 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1681 var
1682   i: Integer;
1683 begin
1684   result := false;
1685   for i := 0 to high(r1.arr) do
1686     if (r1.arr[i] <> r2.arr[i]) then
1687       exit;
1688   result := true;
1689 end;
1690
1691 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1692 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1693 begin
1694   result.r := r;
1695   result.g := g;
1696   result.b := b;
1697   result.a := a;
1698 end;
1699
1700 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1701 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1702 begin
1703   result := [];
1704
1705   if (aFormat in [
1706         //4 bbp
1707         tfLuminance4,
1708
1709         //8bpp
1710         tfR3G3B2, tfLuminance8,
1711
1712         //16bpp
1713         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1714         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1715
1716         //24bpp
1717         tfBGR8, tfRGB8,
1718
1719         //32bpp
1720         tfRGB10, tfRGB10A2, tfRGBA8,
1721         tfBGR10, tfBGR10A2, tfBGRA8]) then
1722     result := result + [ftBMP];
1723
1724   if (aFormat in [
1725         //8 bpp
1726         tfLuminance8, tfAlpha8,
1727
1728         //16 bpp
1729         tfLuminance16, tfLuminance8Alpha8,
1730         tfRGB5, tfRGB5A1, tfRGBA4,
1731         tfBGR5, tfBGR5A1, tfBGRA4,
1732
1733         //24 bpp
1734         tfRGB8, tfBGR8,
1735
1736         //32 bpp
1737         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1738     result := result + [ftTGA];
1739
1740   if (aFormat in [
1741         //8 bpp
1742         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1743         tfR3G3B2, tfRGBA2, tfBGRA2,
1744
1745         //16 bpp
1746         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1747         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1748         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1749
1750         //24 bpp
1751         tfRGB8, tfBGR8,
1752
1753         //32 bbp
1754         tfLuminance16Alpha16,
1755         tfRGBA8, tfRGB10A2,
1756         tfBGRA8, tfBGR10A2,
1757
1758         //compressed
1759         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1760     result := result + [ftDDS];
1761
1762   (* TODO
1763   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1764   if aFormat in [
1765     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1766     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1767     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1768     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1769     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1770     tfDepth16, tfDepth24, tfDepth32]
1771   then
1772     result := result + [ftPNG];
1773   {$ENDIF}
1774
1775   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1776   if Format in [
1777     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1778     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1779     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1780     tfDepth16, tfDepth24, tfDepth32]
1781   then
1782     result := result + [ftJPEG];
1783   {$ENDIF}
1784
1785   if aFormat in [
1786     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1787     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1788     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1789     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1790     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1791     tfDepth16, tfDepth24, tfDepth32]
1792   then
1793     result := result + [ftDDS, ftTGA, ftBMP];
1794   *)
1795 end;
1796
1797 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1798 function IsPowerOfTwo(aNumber: Integer): Boolean;
1799 begin
1800   while (aNumber and 1) = 0 do
1801     aNumber := aNumber shr 1;
1802   result := aNumber = 1;
1803 end;
1804
1805 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1806 function GetTopMostBit(aBitSet: UInt64): Integer;
1807 begin
1808   result := 0;
1809   while aBitSet > 0 do begin
1810     inc(result);
1811     aBitSet := aBitSet shr 1;
1812   end;
1813 end;
1814
1815 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 function CountSetBits(aBitSet: UInt64): Integer;
1817 begin
1818   result := 0;
1819   while aBitSet > 0 do begin
1820     if (aBitSet and 1) = 1 then
1821       inc(result);
1822     aBitSet := aBitSet shr 1;
1823   end;
1824 end;
1825
1826 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1827 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1828 begin
1829   result := Trunc(
1830     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1831     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1832     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1833 end;
1834
1835 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1836 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1837 begin
1838   result := Trunc(
1839     DEPTH_WEIGHT_R * aPixel.Data.r +
1840     DEPTH_WEIGHT_G * aPixel.Data.g +
1841     DEPTH_WEIGHT_B * aPixel.Data.b);
1842 end;
1843
1844 {$IFDEF GLB_NATIVE_OGL}
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1847 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1848 var
1849   GL_LibHandle: Pointer = nil;
1850
1851 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1852 begin
1853   result :=  nil;
1854
1855   if not Assigned(aLibHandle) then
1856     aLibHandle := GL_LibHandle;
1857
1858 {$IF DEFINED(GLB_WIN)}
1859   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1860   if Assigned(result) then
1861     exit;
1862
1863   if Assigned(wglGetProcAddress) then
1864     result := wglGetProcAddress(aProcName);
1865 {$ELSEIF DEFINED(GLB_LINUX)}
1866   if Assigned(glXGetProcAddress) then begin
1867     result := glXGetProcAddress(aProcName);
1868     if Assigned(result) then
1869       exit;
1870   end;
1871
1872   if Assigned(glXGetProcAddressARB) then begin
1873     result := glXGetProcAddressARB(aProcName);
1874     if Assigned(result) then
1875       exit;
1876   end;
1877
1878   result := dlsym(aLibHandle, aProcName);
1879 {$ENDIF}
1880   if not Assigned(result) then
1881     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1882 end;
1883
1884 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1885 var
1886   GLU_LibHandle: Pointer = nil;
1887   OpenGLInitialized: Boolean;
1888   InitOpenGLCS: TCriticalSection;
1889
1890 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1891 procedure glbInitOpenGL;
1892
1893   ////////////////////////////////////////////////////////////////////////////////
1894   function glbLoadLibrary(const aName: PChar): Pointer;
1895   begin
1896     {$IF DEFINED(GLB_WIN)}
1897     result := {%H-}Pointer(LoadLibrary(aName));
1898     {$ELSEIF DEFINED(GLB_LINUX)}
1899     result := dlopen(Name, RTLD_LAZY);
1900     {$ELSE}
1901     result := nil;
1902     {$ENDIF}
1903   end;
1904
1905   ////////////////////////////////////////////////////////////////////////////////
1906   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1907   begin
1908     result := false;
1909     if not Assigned(aLibHandle) then
1910       exit;
1911
1912     {$IF DEFINED(GLB_WIN)}
1913     Result := FreeLibrary({%H-}HINST(aLibHandle));
1914     {$ELSEIF DEFINED(GLB_LINUX)}
1915     Result := dlclose(aLibHandle) = 0;
1916     {$ENDIF}
1917   end;
1918
1919 begin
1920   if Assigned(GL_LibHandle) then
1921     glbFreeLibrary(GL_LibHandle);
1922
1923   if Assigned(GLU_LibHandle) then
1924     glbFreeLibrary(GLU_LibHandle);
1925
1926   GL_LibHandle := glbLoadLibrary(libopengl);
1927   if not Assigned(GL_LibHandle) then
1928     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1929
1930   GLU_LibHandle := glbLoadLibrary(libglu);
1931   if not Assigned(GLU_LibHandle) then
1932     raise EglBitmapException.Create('unable to load library: ' + libglu);
1933
1934   try
1935   {$IF DEFINED(GLB_WIN)}
1936     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1937   {$ELSEIF DEFINED(GLB_LINUX)}
1938     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1939     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1940   {$ENDIF}
1941
1942     glEnable := glbGetProcAddress('glEnable');
1943     glDisable := glbGetProcAddress('glDisable');
1944     glGetString := glbGetProcAddress('glGetString');
1945     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1946     glTexParameteri := glbGetProcAddress('glTexParameteri');
1947     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1948     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1949     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1950     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1951     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1952     glGenTextures := glbGetProcAddress('glGenTextures');
1953     glBindTexture := glbGetProcAddress('glBindTexture');
1954     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1955     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1956     glReadPixels := glbGetProcAddress('glReadPixels');
1957     glPixelStorei := glbGetProcAddress('glPixelStorei');
1958     glTexImage1D := glbGetProcAddress('glTexImage1D');
1959     glTexImage2D := glbGetProcAddress('glTexImage2D');
1960     glGetTexImage := glbGetProcAddress('glGetTexImage');
1961
1962     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1963     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1964   finally
1965     glbFreeLibrary(GL_LibHandle);
1966     glbFreeLibrary(GLU_LibHandle);
1967   end;
1968 end;
1969 {$ENDIF}
1970
1971 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1972 procedure glbReadOpenGLExtensions;
1973 var
1974   {$IFDEF GLB_DELPHI}
1975   Context: HGLRC;
1976   {$ENDIF}
1977   Buffer: AnsiString;
1978   MajorVersion, MinorVersion: Integer;
1979
1980   ///////////////////////////////////////////////////////////////////////////////////////////
1981   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1982   var
1983     Separator: Integer;
1984   begin
1985     aMinor := 0;
1986     aMajor := 0;
1987
1988     Separator := Pos(AnsiString('.'), aBuffer);
1989     if (Separator > 1) and (Separator < Length(aBuffer)) and
1990        (aBuffer[Separator - 1] in ['0'..'9']) and
1991        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1992
1993       Dec(Separator);
1994       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1995         Dec(Separator);
1996
1997       Delete(aBuffer, 1, Separator);
1998       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1999
2000       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2001         Inc(Separator);
2002
2003       Delete(aBuffer, Separator, 255);
2004       Separator := Pos(AnsiString('.'), aBuffer);
2005
2006       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2007       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2008     end;
2009   end;
2010
2011   ///////////////////////////////////////////////////////////////////////////////////////////
2012   function CheckExtension(const Extension: AnsiString): Boolean;
2013   var
2014     ExtPos: Integer;
2015   begin
2016     ExtPos := Pos(Extension, Buffer);
2017     result := ExtPos > 0;
2018     if result then
2019       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2020   end;
2021
2022 begin
2023 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2024   InitOpenGLCS.Enter;
2025   try
2026     if not OpenGLInitialized then begin
2027       glbInitOpenGL;
2028       OpenGLInitialized := true;
2029     end;
2030   finally
2031     InitOpenGLCS.Leave;
2032   end;
2033 {$ENDIF}
2034
2035 {$IFDEF GLB_DELPHI}
2036   Context := wglGetCurrentContext;
2037   if (Context <> gLastContext) then begin
2038     gLastContext := Context;
2039 {$ENDIF}
2040
2041     // Version
2042     Buffer := glGetString(GL_VERSION);
2043     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2044
2045     GL_VERSION_1_2 := false;
2046     GL_VERSION_1_3 := false;
2047     GL_VERSION_1_4 := false;
2048     GL_VERSION_2_0 := false;
2049     if MajorVersion = 1 then begin
2050       if MinorVersion >= 2 then
2051         GL_VERSION_1_2 := true;
2052
2053       if MinorVersion >= 3 then
2054         GL_VERSION_1_3 := true;
2055
2056       if MinorVersion >= 4 then
2057         GL_VERSION_1_4 := true;
2058     end else if MajorVersion >= 2 then begin
2059       GL_VERSION_1_2 := true;
2060       GL_VERSION_1_3 := true;
2061       GL_VERSION_1_4 := true;
2062       GL_VERSION_2_0 := true;
2063     end;
2064
2065     // Extensions
2066     Buffer := glGetString(GL_EXTENSIONS);
2067     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2068     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2069     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2070     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2071     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2072     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2073     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2074     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2075     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2076     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2077
2078     if GL_VERSION_1_3 then begin
2079       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2080       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2081       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2082     end else begin
2083       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2084       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2085       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2086     end;
2087 {$IFDEF GLB_DELPHI}
2088   end;
2089 {$ENDIF}
2090 end;
2091 {$ENDIF}
2092
2093 (* TODO GLB_DELPHI
2094 {$IFDEF GLB_DELPHI}
2095 function CreateGrayPalette: HPALETTE;
2096 var
2097   Idx: Integer;
2098   Pal: PLogPalette;
2099 begin
2100   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2101
2102   Pal.palVersion := $300;
2103   Pal.palNumEntries := 256;
2104
2105   {$IFOPT R+}
2106     {$DEFINE GLB_TEMPRANGECHECK}
2107     {$R-}
2108   {$ENDIF}
2109
2110   for Idx := 0 to 256 - 1 do begin
2111     Pal.palPalEntry[Idx].peRed   := Idx;
2112     Pal.palPalEntry[Idx].peGreen := Idx;
2113     Pal.palPalEntry[Idx].peBlue  := Idx;
2114     Pal.palPalEntry[Idx].peFlags := 0;
2115   end;
2116
2117   {$IFDEF GLB_TEMPRANGECHECK}
2118     {$UNDEF GLB_TEMPRANGECHECK}
2119     {$R+}
2120   {$ENDIF}
2121
2122   result := CreatePalette(Pal^);
2123
2124   FreeMem(Pal);
2125 end;
2126 {$ENDIF}
2127 *)
2128
2129 (* TODO GLB_SDL_IMAGE
2130 {$IFDEF GLB_SDL_IMAGE}
2131 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2132 begin
2133   result := TStream(context^.unknown.data1).Seek(offset, whence);
2134 end;
2135
2136 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2137 begin
2138   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2139 end;
2140
2141 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2142 begin
2143   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2144 end;
2145
2146 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2147 begin
2148   result := 0;
2149 end;
2150
2151 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2152 begin
2153   result := SDL_AllocRW;
2154
2155   if result = nil then
2156     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2157
2158   result^.seek := glBitmapRWseek;
2159   result^.read := glBitmapRWread;
2160   result^.write := glBitmapRWwrite;
2161   result^.close := glBitmapRWclose;
2162   result^.unknown.data1 := Stream;
2163 end;
2164 {$ENDIF}
2165 *)
2166
2167 (* TODO LoadFuncs
2168 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2169 var
2170   glBitmap: TglBitmap2D;
2171 begin
2172   result := false;
2173   Texture := 0;
2174
2175   {$IFDEF GLB_DELPHI}
2176   if Instance = 0 then
2177     Instance := HInstance;
2178
2179   if (LoadFromRes) then
2180     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2181   else
2182   {$ENDIF}
2183     glBitmap := TglBitmap2D.Create(FileName);
2184
2185   try
2186     glBitmap.DeleteTextureOnFree := false;
2187     glBitmap.FreeDataAfterGenTexture := false;
2188     glBitmap.GenTexture(true);
2189     if (glBitmap.ID > 0) then begin
2190       Texture := glBitmap.ID;
2191       result := true;
2192     end;
2193   finally
2194     glBitmap.Free;
2195   end;
2196 end;
2197
2198 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2199 var
2200   CM: TglBitmapCubeMap;
2201 begin
2202   Texture := 0;
2203
2204   {$IFDEF GLB_DELPHI}
2205   if Instance = 0 then
2206     Instance := HInstance;
2207   {$ENDIF}
2208
2209   CM := TglBitmapCubeMap.Create;
2210   try
2211     CM.DeleteTextureOnFree := false;
2212
2213     // Maps
2214     {$IFDEF GLB_DELPHI}
2215     if (LoadFromRes) then
2216       CM.LoadFromResource(Instance, PositiveX)
2217     else
2218     {$ENDIF}
2219       CM.LoadFromFile(PositiveX);
2220     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2221
2222     {$IFDEF GLB_DELPHI}
2223     if (LoadFromRes) then
2224       CM.LoadFromResource(Instance, NegativeX)
2225     else
2226     {$ENDIF}
2227       CM.LoadFromFile(NegativeX);
2228     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2229
2230     {$IFDEF GLB_DELPHI}
2231     if (LoadFromRes) then
2232       CM.LoadFromResource(Instance, PositiveY)
2233     else
2234     {$ENDIF}
2235       CM.LoadFromFile(PositiveY);
2236     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2237
2238     {$IFDEF GLB_DELPHI}
2239     if (LoadFromRes) then
2240       CM.LoadFromResource(Instance, NegativeY)
2241     else
2242     {$ENDIF}
2243       CM.LoadFromFile(NegativeY);
2244     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2245
2246     {$IFDEF GLB_DELPHI}
2247     if (LoadFromRes) then
2248       CM.LoadFromResource(Instance, PositiveZ)
2249     else
2250     {$ENDIF}
2251       CM.LoadFromFile(PositiveZ);
2252     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2253
2254     {$IFDEF GLB_DELPHI}
2255     if (LoadFromRes) then
2256       CM.LoadFromResource(Instance, NegativeZ)
2257     else
2258     {$ENDIF}
2259       CM.LoadFromFile(NegativeZ);
2260     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2261
2262     Texture := CM.ID;
2263     result := true;
2264   finally
2265     CM.Free;
2266   end;
2267 end;
2268
2269 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2270 var
2271   NM: TglBitmapNormalMap;
2272 begin
2273   Texture := 0;
2274
2275   NM := TglBitmapNormalMap.Create;
2276   try
2277     NM.DeleteTextureOnFree := false;
2278     NM.GenerateNormalMap(Size);
2279
2280     Texture := NM.ID;
2281     result := true;
2282   finally
2283     NM.Free;
2284   end;
2285 end;
2286 *)
2287
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2290 begin
2291   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2296 begin
2297   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2298 end;
2299
2300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2301 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2302 begin
2303   glBitmapDefaultMipmap := aValue;
2304 end;
2305
2306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2307 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2308 begin
2309   glBitmapDefaultFormat := aFormat;
2310 end;
2311
2312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2313 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2314 begin
2315   glBitmapDefaultFilterMin := aMin;
2316   glBitmapDefaultFilterMag := aMag;
2317 end;
2318
2319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2321 begin
2322   glBitmapDefaultWrapS := S;
2323   glBitmapDefaultWrapT := T;
2324   glBitmapDefaultWrapR := R;
2325 end;
2326
2327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2328 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2329 begin
2330   result := glBitmapDefaultDeleteTextureOnFree;
2331 end;
2332
2333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2335 begin
2336   result := glBitmapDefaultFreeDataAfterGenTextures;
2337 end;
2338
2339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2340 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2341 begin
2342   result := glBitmapDefaultMipmap;
2343 end;
2344
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 function glBitmapGetDefaultFormat: TglBitmapFormat;
2347 begin
2348   result := glBitmapDefaultFormat;
2349 end;
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2353 begin
2354   aMin := glBitmapDefaultFilterMin;
2355   aMag := glBitmapDefaultFilterMag;
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2360 begin
2361   S := glBitmapDefaultWrapS;
2362   T := glBitmapDefaultWrapT;
2363   R := glBitmapDefaultWrapR;
2364 end;
2365
2366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 function TFormatDescriptor.GetRedMask: UInt64;
2370 begin
2371   result := fRange.r shl fShift.r;
2372 end;
2373
2374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2375 function TFormatDescriptor.GetGreenMask: UInt64;
2376 begin
2377   result := fRange.g shl fShift.g;
2378 end;
2379
2380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2381 function TFormatDescriptor.GetBlueMask: UInt64;
2382 begin
2383   result := fRange.b shl fShift.b;
2384 end;
2385
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 function TFormatDescriptor.GetAlphaMask: UInt64;
2388 begin
2389   result := fRange.a shl fShift.a;
2390 end;
2391
2392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2393 function TFormatDescriptor.GetComponents: Integer;
2394 var
2395   i: Integer;
2396 begin
2397   result := 0;
2398   for i := 0 to 3 do
2399     if (fRange.arr[i] > 0) then
2400       inc(result);
2401 end;
2402
2403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2405 var
2406   w, h: Integer;
2407 begin
2408   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2409     w := Max(1, aSize.X);
2410     h := Max(1, aSize.Y);
2411     result := GetSize(w, h);
2412   end else
2413     result := 0;
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2418 begin
2419   result := 0;
2420   if (aWidth <= 0) or (aHeight <= 0) then
2421     exit;
2422   result := Ceil(aWidth * aHeight * fPixelSize);
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 function TFormatDescriptor.CreateMappingData: Pointer;
2427 begin
2428   result := nil;
2429 end;
2430
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2433 begin
2434   //DUMMY
2435 end;
2436
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 function TFormatDescriptor.IsEmpty: Boolean;
2439 begin
2440   result := (fFormat = tfEmpty);
2441 end;
2442
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 function TFormatDescriptor.HasAlpha: Boolean;
2445 begin
2446   result := (fRange.a > 0);
2447 end;
2448
2449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2450 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
2451 begin
2452   result := false;
2453
2454   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2455     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2456
2457   if (aRedMask   <> RedMask) then
2458     exit;
2459   if (aGreenMask <> GreenMask) then
2460     exit;
2461   if (aBlueMask  <> BlueMask) then
2462     exit;
2463   if (aAlphaMask <> AlphaMask) then
2464     exit;
2465   result := true;
2466 end;
2467
2468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2469 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2470 begin
2471   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2472   aPixel.Data   := fRange;
2473   aPixel.Range  := fRange;
2474   aPixel.Format := fFormat;
2475 end;
2476
2477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2478 constructor TFormatDescriptor.Create;
2479 begin
2480   inherited Create;
2481
2482   fFormat       := tfEmpty;
2483   fWithAlpha    := tfEmpty;
2484   fWithoutAlpha := tfEmpty;
2485   fRGBInverted  := tfEmpty;
2486   fUncompressed := tfEmpty;
2487   fPixelSize    := 0.0;
2488   fIsCompressed := false;
2489
2490   fglFormat         := 0;
2491   fglInternalFormat := 0;
2492   fglDataFormat     := 0;
2493
2494   FillChar(fRange, 0, SizeOf(fRange));
2495   FillChar(fShift, 0, SizeOf(fShift));
2496 end;
2497
2498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2501 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2502 begin
2503   aData^ := aPixel.Data.a;
2504   inc(aData);
2505 end;
2506
2507 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2508 begin
2509   aPixel.Data.r := 0;
2510   aPixel.Data.g := 0;
2511   aPixel.Data.b := 0;
2512   aPixel.Data.a := aData^;
2513   inc(aData^);
2514 end;
2515
2516 constructor TfdAlpha_UB1.Create;
2517 begin
2518   inherited Create;
2519   fPixelSize        := 1.0;
2520   fRange.a          := $FF;
2521   fglFormat         := GL_ALPHA;
2522   fglDataFormat     := GL_UNSIGNED_BYTE;
2523 end;
2524
2525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2529 begin
2530   aData^ := LuminanceWeight(aPixel);
2531   inc(aData);
2532 end;
2533
2534 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2535 begin
2536   aPixel.Data.r := aData^;
2537   aPixel.Data.g := aData^;
2538   aPixel.Data.b := aData^;
2539   aPixel.Data.a := 0;
2540   inc(aData);
2541 end;
2542
2543 constructor TfdLuminance_UB1.Create;
2544 begin
2545   inherited Create;
2546   fPixelSize        := 1.0;
2547   fRange.r          := $FF;
2548   fRange.g          := $FF;
2549   fRange.b          := $FF;
2550   fglFormat         := GL_LUMINANCE;
2551   fglDataFormat     := GL_UNSIGNED_BYTE;
2552 end;
2553
2554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2558 var
2559   i: Integer;
2560 begin
2561   aData^ := 0;
2562   for i := 0 to 3 do
2563     if (fRange.arr[i] > 0) then
2564       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2565   inc(aData);
2566 end;
2567
2568 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2569 var
2570   i: Integer;
2571 begin
2572   for i := 0 to 3 do
2573     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2574   inc(aData);
2575 end;
2576
2577 constructor TfdUniversal_UB1.Create;
2578 begin
2579   inherited Create;
2580   fPixelSize := 1.0;
2581 end;
2582
2583 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2586 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2587 begin
2588   inherited Map(aPixel, aData, aMapData);
2589   aData^ := aPixel.Data.a;
2590   inc(aData);
2591 end;
2592
2593 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 begin
2595   inherited Unmap(aData, aPixel, aMapData);
2596   aPixel.Data.a := aData^;
2597   inc(aData);
2598 end;
2599
2600 constructor TfdLuminanceAlpha_UB2.Create;
2601 begin
2602   inherited Create;
2603   fPixelSize        := 2.0;
2604   fRange.a          := $FF;
2605   fShift.a          :=   8;
2606   fglFormat         := GL_LUMINANCE_ALPHA;
2607   fglDataFormat     := GL_UNSIGNED_BYTE;
2608 end;
2609
2610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2614 begin
2615   aData^ := aPixel.Data.r;
2616   inc(aData);
2617   aData^ := aPixel.Data.g;
2618   inc(aData);
2619   aData^ := aPixel.Data.b;
2620   inc(aData);
2621 end;
2622
2623 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2624 begin
2625   aPixel.Data.r := aData^;
2626   inc(aData);
2627   aPixel.Data.g := aData^;
2628   inc(aData);
2629   aPixel.Data.b := aData^;
2630   inc(aData);
2631   aPixel.Data.a := 0;
2632 end;
2633
2634 constructor TfdRGB_UB3.Create;
2635 begin
2636   inherited Create;
2637   fPixelSize        := 3.0;
2638   fRange.r          := $FF;
2639   fRange.g          := $FF;
2640   fRange.b          := $FF;
2641   fShift.r          :=   0;
2642   fShift.g          :=   8;
2643   fShift.b          :=  16;
2644   fglFormat         := GL_RGB;
2645   fglDataFormat     := GL_UNSIGNED_BYTE;
2646 end;
2647
2648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2651 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2652 begin
2653   aData^ := aPixel.Data.b;
2654   inc(aData);
2655   aData^ := aPixel.Data.g;
2656   inc(aData);
2657   aData^ := aPixel.Data.r;
2658   inc(aData);
2659 end;
2660
2661 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2662 begin
2663   aPixel.Data.b := aData^;
2664   inc(aData);
2665   aPixel.Data.g := aData^;
2666   inc(aData);
2667   aPixel.Data.r := aData^;
2668   inc(aData);
2669   aPixel.Data.a := 0;
2670 end;
2671
2672 constructor TfdBGR_UB3.Create;
2673 begin
2674   fPixelSize        := 3.0;
2675   fRange.r          := $FF;
2676   fRange.g          := $FF;
2677   fRange.b          := $FF;
2678   fShift.r          :=  16;
2679   fShift.g          :=   8;
2680   fShift.b          :=   0;
2681   fglFormat         := GL_BGR;
2682   fglDataFormat     := GL_UNSIGNED_BYTE;
2683 end;
2684
2685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2688 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2689 begin
2690   inherited Map(aPixel, aData, aMapData);
2691   aData^ := aPixel.Data.a;
2692   inc(aData);
2693 end;
2694
2695 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2696 begin
2697   inherited Unmap(aData, aPixel, aMapData);
2698   aPixel.Data.a := aData^;
2699   inc(aData);
2700 end;
2701
2702 constructor TfdRGBA_UB4.Create;
2703 begin
2704   inherited Create;
2705   fPixelSize        := 4.0;
2706   fRange.a          := $FF;
2707   fShift.a          :=  24;
2708   fglFormat         := GL_RGBA;
2709   fglDataFormat     := GL_UNSIGNED_BYTE;
2710 end;
2711
2712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2715 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2716 begin
2717   inherited Map(aPixel, aData, aMapData);
2718   aData^ := aPixel.Data.a;
2719   inc(aData);
2720 end;
2721
2722 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2723 begin
2724   inherited Unmap(aData, aPixel, aMapData);
2725   aPixel.Data.a := aData^;
2726   inc(aData);
2727 end;
2728
2729 constructor TfdBGRA_UB4.Create;
2730 begin
2731   inherited Create;
2732   fPixelSize        := 4.0;
2733   fRange.a          := $FF;
2734   fShift.a          :=  24;
2735   fglFormat         := GL_BGRA;
2736   fglDataFormat     := GL_UNSIGNED_BYTE;
2737 end;
2738
2739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2743 begin
2744   PWord(aData)^ := aPixel.Data.a;
2745   inc(aData, 2);
2746 end;
2747
2748 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2749 begin
2750   aPixel.Data.r := 0;
2751   aPixel.Data.g := 0;
2752   aPixel.Data.b := 0;
2753   aPixel.Data.a := PWord(aData)^;
2754   inc(aData, 2);
2755 end;
2756
2757 constructor TfdAlpha_US1.Create;
2758 begin
2759   inherited Create;
2760   fPixelSize        := 2.0;
2761   fRange.a          := $FFFF;
2762   fglFormat         := GL_ALPHA;
2763   fglDataFormat     := GL_UNSIGNED_SHORT;
2764 end;
2765
2766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2767 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2769 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2770 begin
2771   PWord(aData)^ := LuminanceWeight(aPixel);
2772   inc(aData, 2);
2773 end;
2774
2775 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2776 begin
2777   aPixel.Data.r := PWord(aData)^;
2778   aPixel.Data.g := PWord(aData)^;
2779   aPixel.Data.b := PWord(aData)^;
2780   aPixel.Data.a := 0;
2781   inc(aData, 2);
2782 end;
2783
2784 constructor TfdLuminance_US1.Create;
2785 begin
2786   inherited Create;
2787   fPixelSize        := 2.0;
2788   fRange.r          := $FFFF;
2789   fRange.g          := $FFFF;
2790   fRange.b          := $FFFF;
2791   fglFormat         := GL_LUMINANCE;
2792   fglDataFormat     := GL_UNSIGNED_SHORT;
2793 end;
2794
2795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2796 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2799 var
2800   i: Integer;
2801 begin
2802   PWord(aData)^ := 0;
2803   for i := 0 to 3 do
2804     if (fRange.arr[i] > 0) then
2805       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2806   inc(aData, 2);
2807 end;
2808
2809 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2810 var
2811   i: Integer;
2812 begin
2813   for i := 0 to 3 do
2814     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2815   inc(aData, 2);
2816 end;
2817
2818 constructor TfdUniversal_US1.Create;
2819 begin
2820   inherited Create;
2821   fPixelSize := 2.0;
2822 end;
2823
2824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2828 begin
2829   PWord(aData)^ := DepthWeight(aPixel);
2830   inc(aData, 2);
2831 end;
2832
2833 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2834 begin
2835   aPixel.Data.r := PWord(aData)^;
2836   aPixel.Data.g := PWord(aData)^;
2837   aPixel.Data.b := PWord(aData)^;
2838   aPixel.Data.a := 0;
2839   inc(aData, 2);
2840 end;
2841
2842 constructor TfdDepth_US1.Create;
2843 begin
2844   inherited Create;
2845   fPixelSize        := 2.0;
2846   fRange.r          := $FFFF;
2847   fRange.g          := $FFFF;
2848   fRange.b          := $FFFF;
2849   fglFormat         := GL_DEPTH_COMPONENT;
2850   fglDataFormat     := GL_UNSIGNED_SHORT;
2851 end;
2852
2853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2857 begin
2858   inherited Map(aPixel, aData, aMapData);
2859   PWord(aData)^ := aPixel.Data.a;
2860   inc(aData, 2);
2861 end;
2862
2863 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2864 begin
2865   inherited Unmap(aData, aPixel, aMapData);
2866   aPixel.Data.a := PWord(aData)^;
2867   inc(aData, 2);
2868 end;
2869
2870 constructor TfdLuminanceAlpha_US2.Create;
2871 begin
2872   inherited Create;
2873   fPixelSize        :=   4.0;
2874   fRange.a          := $FFFF;
2875   fShift.a          :=    16;
2876   fglFormat         := GL_LUMINANCE_ALPHA;
2877   fglDataFormat     := GL_UNSIGNED_SHORT;
2878 end;
2879
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2884 begin
2885   PWord(aData)^ := aPixel.Data.r;
2886   inc(aData, 2);
2887   PWord(aData)^ := aPixel.Data.g;
2888   inc(aData, 2);
2889   PWord(aData)^ := aPixel.Data.b;
2890   inc(aData, 2);
2891 end;
2892
2893 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2894 begin
2895   aPixel.Data.r := PWord(aData)^;
2896   inc(aData, 2);
2897   aPixel.Data.g := PWord(aData)^;
2898   inc(aData, 2);
2899   aPixel.Data.b := PWord(aData)^;
2900   inc(aData, 2);
2901   aPixel.Data.a := 0;
2902 end;
2903
2904 constructor TfdRGB_US3.Create;
2905 begin
2906   inherited Create;
2907   fPixelSize        :=   6.0;
2908   fRange.r          := $FFFF;
2909   fRange.g          := $FFFF;
2910   fRange.b          := $FFFF;
2911   fShift.r          :=     0;
2912   fShift.g          :=    16;
2913   fShift.b          :=    32;
2914   fglFormat         := GL_RGB;
2915   fglDataFormat     := GL_UNSIGNED_SHORT;
2916 end;
2917
2918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2921 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2922 begin
2923   PWord(aData)^ := aPixel.Data.b;
2924   inc(aData, 2);
2925   PWord(aData)^ := aPixel.Data.g;
2926   inc(aData, 2);
2927   PWord(aData)^ := aPixel.Data.r;
2928   inc(aData, 2);
2929 end;
2930
2931 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 begin
2933   aPixel.Data.b := PWord(aData)^;
2934   inc(aData, 2);
2935   aPixel.Data.g := PWord(aData)^;
2936   inc(aData, 2);
2937   aPixel.Data.r := PWord(aData)^;
2938   inc(aData, 2);
2939   aPixel.Data.a := 0;
2940 end;
2941
2942 constructor TfdBGR_US3.Create;
2943 begin
2944   inherited Create;
2945   fPixelSize        :=   6.0;
2946   fRange.r          := $FFFF;
2947   fRange.g          := $FFFF;
2948   fRange.b          := $FFFF;
2949   fShift.r          :=    32;
2950   fShift.g          :=    16;
2951   fShift.b          :=     0;
2952   fglFormat         := GL_BGR;
2953   fglDataFormat     := GL_UNSIGNED_SHORT;
2954 end;
2955
2956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2957 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2959 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2960 begin
2961   inherited Map(aPixel, aData, aMapData);
2962   PWord(aData)^ := aPixel.Data.a;
2963   inc(aData, 2);
2964 end;
2965
2966 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2967 begin
2968   inherited Unmap(aData, aPixel, aMapData);
2969   aPixel.Data.a := PWord(aData)^;
2970   inc(aData, 2);
2971 end;
2972
2973 constructor TfdRGBA_US4.Create;
2974 begin
2975   inherited Create;
2976   fPixelSize        :=   8.0;
2977   fRange.a          := $FFFF;
2978   fShift.a          :=    48;
2979   fglFormat         := GL_RGBA;
2980   fglDataFormat     := GL_UNSIGNED_SHORT;
2981 end;
2982
2983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2984 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2986 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2987 begin
2988   inherited Map(aPixel, aData, aMapData);
2989   PWord(aData)^ := aPixel.Data.a;
2990   inc(aData, 2);
2991 end;
2992
2993 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2994 begin
2995   inherited Unmap(aData, aPixel, aMapData);
2996   aPixel.Data.a := PWord(aData)^;
2997   inc(aData, 2);
2998 end;
2999
3000 constructor TfdBGRA_US4.Create;
3001 begin
3002   inherited Create;
3003   fPixelSize        :=   8.0;
3004   fRange.a          := $FFFF;
3005   fShift.a          :=    48;
3006   fglFormat         := GL_BGRA;
3007   fglDataFormat     := GL_UNSIGNED_SHORT;
3008 end;
3009
3010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3011 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3013 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3014 var
3015   i: Integer;
3016 begin
3017   PCardinal(aData)^ := 0;
3018   for i := 0 to 3 do
3019     if (fRange.arr[i] > 0) then
3020       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3021   inc(aData, 4);
3022 end;
3023
3024 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3025 var
3026   i: Integer;
3027 begin
3028   for i := 0 to 3 do
3029     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3030   inc(aData, 2);
3031 end;
3032
3033 constructor TfdUniversal_UI1.Create;
3034 begin
3035   inherited Create;
3036   fPixelSize := 4.0;
3037 end;
3038
3039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3040 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3042 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3043 begin
3044   PCardinal(aData)^ := DepthWeight(aPixel);
3045   inc(aData, 4);
3046 end;
3047
3048 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3049 begin
3050   aPixel.Data.r := PCardinal(aData)^;
3051   aPixel.Data.g := PCardinal(aData)^;
3052   aPixel.Data.b := PCardinal(aData)^;
3053   aPixel.Data.a := 0;
3054   inc(aData, 4);
3055 end;
3056
3057 constructor TfdDepth_UI1.Create;
3058 begin
3059   inherited Create;
3060   fPixelSize        := 4.0;
3061   fRange.r          := $FFFFFFFF;
3062   fRange.g          := $FFFFFFFF;
3063   fRange.b          := $FFFFFFFF;
3064   fglFormat         := GL_DEPTH_COMPONENT;
3065   fglDataFormat     := GL_UNSIGNED_INT;
3066 end;
3067
3068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3071 constructor TfdAlpha4.Create;
3072 begin
3073   inherited Create;
3074   fFormat           := tfAlpha4;
3075   fWithAlpha        := tfAlpha4;
3076   fglInternalFormat := GL_ALPHA4;
3077 end;
3078
3079 constructor TfdAlpha8.Create;
3080 begin
3081   inherited Create;
3082   fFormat           := tfAlpha8;
3083   fWithAlpha        := tfAlpha8;
3084   fglInternalFormat := GL_ALPHA8;
3085 end;
3086
3087 constructor TfdAlpha12.Create;
3088 begin
3089   inherited Create;
3090   fFormat           := tfAlpha12;
3091   fWithAlpha        := tfAlpha12;
3092   fglInternalFormat := GL_ALPHA12;
3093 end;
3094
3095 constructor TfdAlpha16.Create;
3096 begin
3097   inherited Create;
3098   fFormat           := tfAlpha16;
3099   fWithAlpha        := tfAlpha16;
3100   fglInternalFormat := GL_ALPHA16;
3101 end;
3102
3103 constructor TfdLuminance4.Create;
3104 begin
3105   inherited Create;
3106   fFormat           := tfLuminance4;
3107   fWithAlpha        := tfLuminance4Alpha4;
3108   fWithoutAlpha     := tfLuminance4;
3109   fglInternalFormat := GL_LUMINANCE4;
3110 end;
3111
3112 constructor TfdLuminance8.Create;
3113 begin
3114   inherited Create;
3115   fFormat           := tfLuminance8;
3116   fWithAlpha        := tfLuminance8Alpha8;
3117   fWithoutAlpha     := tfLuminance8;
3118   fglInternalFormat := GL_LUMINANCE8;
3119 end;
3120
3121 constructor TfdLuminance12.Create;
3122 begin
3123   inherited Create;
3124   fFormat           := tfLuminance12;
3125   fWithAlpha        := tfLuminance12Alpha12;
3126   fWithoutAlpha     := tfLuminance12;
3127   fglInternalFormat := GL_LUMINANCE12;
3128 end;
3129
3130 constructor TfdLuminance16.Create;
3131 begin
3132   inherited Create;
3133   fFormat           := tfLuminance16;
3134   fWithAlpha        := tfLuminance16Alpha16;
3135   fWithoutAlpha     := tfLuminance16;
3136   fglInternalFormat := GL_LUMINANCE16;
3137 end;
3138
3139 constructor TfdLuminance4Alpha4.Create;
3140 begin
3141   inherited Create;
3142   fFormat           := tfLuminance4Alpha4;
3143   fWithAlpha        := tfLuminance4Alpha4;
3144   fWithoutAlpha     := tfLuminance4;
3145   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3146 end;
3147
3148 constructor TfdLuminance6Alpha2.Create;
3149 begin
3150   inherited Create;
3151   fFormat           := tfLuminance6Alpha2;
3152   fWithAlpha        := tfLuminance6Alpha2;
3153   fWithoutAlpha     := tfLuminance8;
3154   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3155 end;
3156
3157 constructor TfdLuminance8Alpha8.Create;
3158 begin
3159   inherited Create;
3160   fFormat           := tfLuminance8Alpha8;
3161   fWithAlpha        := tfLuminance8Alpha8;
3162   fWithoutAlpha     := tfLuminance8;
3163   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3164 end;
3165
3166 constructor TfdLuminance12Alpha4.Create;
3167 begin
3168   inherited Create;
3169   fFormat           := tfLuminance12Alpha4;
3170   fWithAlpha        := tfLuminance12Alpha4;
3171   fWithoutAlpha     := tfLuminance12;
3172   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3173 end;
3174
3175 constructor TfdLuminance12Alpha12.Create;
3176 begin
3177   inherited Create;
3178   fFormat           := tfLuminance12Alpha12;
3179   fWithAlpha        := tfLuminance12Alpha12;
3180   fWithoutAlpha     := tfLuminance12;
3181   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3182 end;
3183
3184 constructor TfdLuminance16Alpha16.Create;
3185 begin
3186   inherited Create;
3187   fFormat           := tfLuminance16Alpha16;
3188   fWithAlpha        := tfLuminance16Alpha16;
3189   fWithoutAlpha     := tfLuminance16;
3190   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3191 end;
3192
3193 constructor TfdR3G3B2.Create;
3194 begin
3195   inherited Create;
3196   fFormat           := tfR3G3B2;
3197   fWithAlpha        := tfRGBA2;
3198   fWithoutAlpha     := tfR3G3B2;
3199   fRange.r          := $7;
3200   fRange.g          := $7;
3201   fRange.b          := $3;
3202   fShift.r          :=  0;
3203   fShift.g          :=  3;
3204   fShift.b          :=  6;
3205   fglFormat         := GL_RGB;
3206   fglInternalFormat := GL_R3_G3_B2;
3207   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3208 end;
3209
3210 constructor TfdRGB4.Create;
3211 begin
3212   inherited Create;
3213   fFormat           := tfRGB4;
3214   fWithAlpha        := tfRGBA4;
3215   fWithoutAlpha     := tfRGB4;
3216   fRGBInverted      := tfBGR4;
3217   fRange.r          := $F;
3218   fRange.g          := $F;
3219   fRange.b          := $F;
3220   fShift.r          :=  0;
3221   fShift.g          :=  4;
3222   fShift.b          :=  8;
3223   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3224   fglInternalFormat := GL_RGB4;
3225   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3226 end;
3227
3228 constructor TfdR5G6B5.Create;
3229 begin
3230   inherited Create;
3231   fFormat           := tfR5G6B5;
3232   fWithAlpha        := tfRGBA4;
3233   fWithoutAlpha     := tfR5G6B5;
3234   fRGBInverted      := tfB5G6R5;
3235   fRange.r          := $1F;
3236   fRange.g          := $3F;
3237   fRange.b          := $1F;
3238   fShift.r          :=   0;
3239   fShift.g          :=   5;
3240   fShift.b          :=  11;
3241   fglFormat         := GL_RGB;
3242   fglInternalFormat := GL_RGB565;
3243   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3244 end;
3245
3246 constructor TfdRGB5.Create;
3247 begin
3248   inherited Create;
3249   fFormat           := tfRGB5;
3250   fWithAlpha        := tfRGB5A1;
3251   fWithoutAlpha     := tfRGB5;
3252   fRGBInverted      := tfBGR5;
3253   fRange.r          := $1F;
3254   fRange.g          := $1F;
3255   fRange.b          := $1F;
3256   fShift.r          :=   0;
3257   fShift.g          :=   5;
3258   fShift.b          :=  10;
3259   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3260   fglInternalFormat := GL_RGB5;
3261   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3262 end;
3263
3264 constructor TfdRGB8.Create;
3265 begin
3266   inherited Create;
3267   fFormat           := tfRGB8;
3268   fWithAlpha        := tfRGBA8;
3269   fWithoutAlpha     := tfRGB8;
3270   fRGBInverted      := tfBGR8;
3271   fglInternalFormat := GL_RGB8;
3272 end;
3273
3274 constructor TfdRGB10.Create;
3275 begin
3276   inherited Create;
3277   fFormat           := tfRGB10;
3278   fWithAlpha        := tfRGB10A2;
3279   fWithoutAlpha     := tfRGB10;
3280   fRGBInverted      := tfBGR10;
3281   fRange.r          := $3FF;
3282   fRange.g          := $3FF;
3283   fRange.b          := $3FF;
3284   fShift.r          :=    0;
3285   fShift.g          :=   10;
3286   fShift.b          :=   20;
3287   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3288   fglInternalFormat := GL_RGB10;
3289   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3290 end;
3291
3292 constructor TfdRGB12.Create;
3293 begin
3294   inherited Create;
3295   fFormat           := tfRGB12;
3296   fWithAlpha        := tfRGBA12;
3297   fWithoutAlpha     := tfRGB12;
3298   fRGBInverted      := tfBGR12;
3299   fglInternalFormat := GL_RGB12;
3300 end;
3301
3302 constructor TfdRGB16.Create;
3303 begin
3304   inherited Create;
3305   fFormat           := tfRGB16;
3306   fWithAlpha        := tfRGBA16;
3307   fWithoutAlpha     := tfRGB16;
3308   fRGBInverted      := tfBGR16;
3309   fglInternalFormat := GL_RGB16;
3310 end;
3311
3312 constructor TfdRGBA2.Create;
3313 begin
3314   inherited Create;
3315   fFormat           := tfRGBA2;
3316   fWithAlpha        := tfRGBA2;
3317   fWithoutAlpha     := tfR3G3B2;
3318   fRGBInverted      := tfBGRA2;
3319   fglInternalFormat := GL_RGBA2;
3320 end;
3321
3322 constructor TfdRGBA4.Create;
3323 begin
3324   inherited Create;
3325   fFormat           := tfRGBA4;
3326   fWithAlpha        := tfRGBA4;
3327   fWithoutAlpha     := tfRGB4;
3328   fRGBInverted      := tfBGRA4;
3329   fRange.r          := $F;
3330   fRange.g          := $F;
3331   fRange.b          := $F;
3332   fRange.a          := $F;
3333   fShift.r          :=  0;
3334   fShift.g          :=  4;
3335   fShift.b          :=  8;
3336   fShift.a          := 12;
3337   fglFormat         := GL_RGBA;
3338   fglInternalFormat := GL_RGBA4;
3339   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3340 end;
3341
3342 constructor TfdRGB5A1.Create;
3343 begin
3344   inherited Create;
3345   fFormat           := tfRGB5A1;
3346   fWithAlpha        := tfRGB5A1;
3347   fWithoutAlpha     := tfRGB5;
3348   fRGBInverted      := tfBGR5A1;
3349   fRange.r          := $1F;
3350   fRange.g          := $1F;
3351   fRange.b          := $1F;
3352   fRange.a          := $01;
3353   fShift.r          :=   0;
3354   fShift.g          :=   5;
3355   fShift.b          :=  10;
3356   fShift.a          :=  15;
3357   fglFormat         := GL_RGBA;
3358   fglInternalFormat := GL_RGB5_A1;
3359   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3360 end;
3361
3362 constructor TfdRGBA8.Create;
3363 begin
3364   inherited Create;
3365   fFormat           := tfRGBA8;
3366   fWithAlpha        := tfRGBA8;
3367   fWithoutAlpha     := tfRGB8;
3368   fRGBInverted      := tfBGRA8;
3369   fglInternalFormat := GL_RGBA8;
3370 end;
3371
3372 constructor TfdRGB10A2.Create;
3373 begin
3374   inherited Create;
3375   fFormat           := tfRGB10A2;
3376   fWithAlpha        := tfRGB10A2;
3377   fWithoutAlpha     := tfRGB10;
3378   fRGBInverted      := tfBGR10A2;
3379   fRange.r          := $3FF;
3380   fRange.g          := $3FF;
3381   fRange.b          := $3FF;
3382   fRange.a          := $003;
3383   fShift.r          :=    0;
3384   fShift.g          :=   10;
3385   fShift.b          :=   20;
3386   fShift.a          :=   30;
3387   fglFormat         := GL_RGBA;
3388   fglInternalFormat := GL_RGB10_A2;
3389   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3390 end;
3391
3392 constructor TfdRGBA12.Create;
3393 begin
3394   inherited Create;
3395   fFormat           := tfRGBA12;
3396   fWithAlpha        := tfRGBA12;
3397   fWithoutAlpha     := tfRGB12;
3398   fRGBInverted      := tfBGRA12;
3399   fglInternalFormat := GL_RGBA12;
3400 end;
3401
3402 constructor TfdRGBA16.Create;
3403 begin
3404   inherited Create;
3405   fFormat           := tfRGBA16;
3406   fWithAlpha        := tfRGBA16;
3407   fWithoutAlpha     := tfRGB16;
3408   fRGBInverted      := tfBGRA16;
3409   fglInternalFormat := GL_RGBA16;
3410 end;
3411
3412 constructor TfdBGR4.Create;
3413 begin
3414   inherited Create;
3415   fPixelSize        := 2.0;
3416   fFormat           := tfBGR4;
3417   fWithAlpha        := tfBGRA4;
3418   fWithoutAlpha     := tfBGR4;
3419   fRGBInverted      := tfRGB4;
3420   fRange.r          := $F;
3421   fRange.g          := $F;
3422   fRange.b          := $F;
3423   fRange.a          := $0;
3424   fShift.r          :=  8;
3425   fShift.g          :=  4;
3426   fShift.b          :=  0;
3427   fShift.a          :=  0;
3428   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3429   fglInternalFormat := GL_RGB4;
3430   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3431 end;
3432
3433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3436 constructor TfdB5G6R5.Create;
3437 begin
3438   inherited Create;
3439   fFormat           := tfB5G6R5;
3440   fWithAlpha        := tfBGRA4;
3441   fWithoutAlpha     := tfB5G6R5;
3442   fRGBInverted      := tfR5G6B5;
3443   fRange.r          := $1F;
3444   fRange.g          := $3F;
3445   fRange.b          := $1F;
3446   fShift.r          :=  11;
3447   fShift.g          :=   5;
3448   fShift.b          :=   0;
3449   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3450   fglInternalFormat := GL_RGB8;
3451   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3452 end;
3453
3454 constructor TfdBGR5.Create;
3455 begin
3456   inherited Create;
3457   fPixelSize        := 2.0;
3458   fFormat           := tfBGR5;
3459   fWithAlpha        := tfBGR5A1;
3460   fWithoutAlpha     := tfBGR5;
3461   fRGBInverted      := tfRGB5;
3462   fRange.r          := $1F;
3463   fRange.g          := $1F;
3464   fRange.b          := $1F;
3465   fRange.a          := $00;
3466   fShift.r          :=  10;
3467   fShift.g          :=   5;
3468   fShift.b          :=   0;
3469   fShift.a          :=   0;
3470   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3471   fglInternalFormat := GL_RGB5;
3472   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3473 end;
3474
3475 constructor TfdBGR8.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGR8;
3479   fWithAlpha        := tfBGRA8;
3480   fWithoutAlpha     := tfBGR8;
3481   fRGBInverted      := tfRGB8;
3482   fglInternalFormat := GL_RGB8;
3483 end;
3484
3485 constructor TfdBGR10.Create;
3486 begin
3487   inherited Create;
3488   fFormat           := tfBGR10;
3489   fWithAlpha        := tfBGR10A2;
3490   fWithoutAlpha     := tfBGR10;
3491   fRGBInverted      := tfRGB10;
3492   fRange.r          := $3FF;
3493   fRange.g          := $3FF;
3494   fRange.b          := $3FF;
3495   fRange.a          := $000;
3496   fShift.r          :=   20;
3497   fShift.g          :=   10;
3498   fShift.b          :=    0;
3499   fShift.a          :=    0;
3500   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3501   fglInternalFormat := GL_RGB10;
3502   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3503 end;
3504
3505 constructor TfdBGR12.Create;
3506 begin
3507   inherited Create;
3508   fFormat           := tfBGR12;
3509   fWithAlpha        := tfBGRA12;
3510   fWithoutAlpha     := tfBGR12;
3511   fRGBInverted      := tfRGB12;
3512   fglInternalFormat := GL_RGB12;
3513 end;
3514
3515 constructor TfdBGR16.Create;
3516 begin
3517   inherited Create;
3518   fFormat           := tfBGR16;
3519   fWithAlpha        := tfBGRA16;
3520   fWithoutAlpha     := tfBGR16;
3521   fRGBInverted      := tfRGB16;
3522   fglInternalFormat := GL_RGB16;
3523 end;
3524
3525 constructor TfdBGRA2.Create;
3526 begin
3527   inherited Create;
3528   fFormat           := tfBGRA2;
3529   fWithAlpha        := tfBGRA4;
3530   fWithoutAlpha     := tfBGR4;
3531   fRGBInverted      := tfRGBA2;
3532   fglInternalFormat := GL_RGBA2;
3533 end;
3534
3535 constructor TfdBGRA4.Create;
3536 begin
3537   inherited Create;
3538   fFormat           := tfBGRA4;
3539   fWithAlpha        := tfBGRA4;
3540   fWithoutAlpha     := tfBGR4;
3541   fRGBInverted      := tfRGBA4;
3542   fRange.r          := $F;
3543   fRange.g          := $F;
3544   fRange.b          := $F;
3545   fRange.a          := $F;
3546   fShift.r          :=  8;
3547   fShift.g          :=  4;
3548   fShift.b          :=  0;
3549   fShift.a          := 12;
3550   fglFormat         := GL_BGRA;
3551   fglInternalFormat := GL_RGBA4;
3552   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3553 end;
3554
3555 constructor TfdBGR5A1.Create;
3556 begin
3557   inherited Create;
3558   fFormat           := tfBGR5A1;
3559   fWithAlpha        := tfBGR5A1;
3560   fWithoutAlpha     := tfBGR5;
3561   fRGBInverted      := tfRGB5A1;
3562   fRange.r          := $1F;
3563   fRange.g          := $1F;
3564   fRange.b          := $1F;
3565   fRange.a          := $01;
3566   fShift.r          :=  10;
3567   fShift.g          :=   5;
3568   fShift.b          :=   0;
3569   fShift.a          :=  15;
3570   fglFormat         := GL_BGRA;
3571   fglInternalFormat := GL_RGB5_A1;
3572   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3573 end;
3574
3575 constructor TfdBGRA8.Create;
3576 begin
3577   inherited Create;
3578   fFormat           := tfBGRA8;
3579   fWithAlpha        := tfBGRA8;
3580   fWithoutAlpha     := tfBGR8;
3581   fRGBInverted      := tfRGBA8;
3582   fglInternalFormat := GL_RGBA8;
3583 end;
3584
3585 constructor TfdBGR10A2.Create;
3586 begin
3587   inherited Create;
3588   fFormat           := tfBGR10A2;
3589   fWithAlpha        := tfBGR10A2;
3590   fWithoutAlpha     := tfBGR10;
3591   fRGBInverted      := tfRGB10A2;
3592   fRange.r          := $3FF;
3593   fRange.g          := $3FF;
3594   fRange.b          := $3FF;
3595   fRange.a          := $003;
3596   fShift.r          :=   20;
3597   fShift.g          :=   10;
3598   fShift.b          :=    0;
3599   fShift.a          :=   30;
3600   fglFormat         := GL_BGRA;
3601   fglInternalFormat := GL_RGB10_A2;
3602   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3603 end;
3604
3605 constructor TfdBGRA12.Create;
3606 begin
3607   inherited Create;
3608   fFormat           := tfBGRA12;
3609   fWithAlpha        := tfBGRA12;
3610   fWithoutAlpha     := tfBGR12;
3611   fRGBInverted      := tfRGBA12;
3612   fglInternalFormat := GL_RGBA12;
3613 end;
3614
3615 constructor TfdBGRA16.Create;
3616 begin
3617   inherited Create;
3618   fFormat           := tfBGRA16;
3619   fWithAlpha        := tfBGRA16;
3620   fWithoutAlpha     := tfBGR16;
3621   fRGBInverted      := tfRGBA16;
3622   fglInternalFormat := GL_RGBA16;
3623 end;
3624
3625 constructor TfdDepth16.Create;
3626 begin
3627   inherited Create;
3628   fFormat           := tfDepth16;
3629   fWithAlpha        := tfEmpty;
3630   fWithoutAlpha     := tfDepth16;
3631   fglInternalFormat := GL_DEPTH_COMPONENT16;
3632 end;
3633
3634 constructor TfdDepth24.Create;
3635 begin
3636   inherited Create;
3637   fFormat           := tfDepth24;
3638   fWithAlpha        := tfEmpty;
3639   fWithoutAlpha     := tfDepth24;
3640   fglInternalFormat := GL_DEPTH_COMPONENT24;
3641 end;
3642
3643 constructor TfdDepth32.Create;
3644 begin
3645   inherited Create;
3646   fFormat           := tfDepth32;
3647   fWithAlpha        := tfEmpty;
3648   fWithoutAlpha     := tfDepth32;
3649   fglInternalFormat := GL_DEPTH_COMPONENT32;
3650 end;
3651
3652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3655 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3656 begin
3657   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3658 end;
3659
3660 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3661 begin
3662   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3663 end;
3664
3665 constructor TfdS3tcDtx1RGBA.Create;
3666 begin
3667   inherited Create;
3668   fFormat           := tfS3tcDtx1RGBA;
3669   fWithAlpha        := tfS3tcDtx1RGBA;
3670   fUncompressed     := tfRGB5A1;
3671   fPixelSize        := 0.5;
3672   fIsCompressed     := true;
3673   fglFormat         := GL_COMPRESSED_RGBA;
3674   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3675   fglDataFormat     := GL_UNSIGNED_BYTE;
3676 end;
3677
3678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3679 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3681 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3682 begin
3683   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3684 end;
3685
3686 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3687 begin
3688   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3689 end;
3690
3691 constructor TfdS3tcDtx3RGBA.Create;
3692 begin
3693   inherited Create;
3694   fFormat           := tfS3tcDtx3RGBA;
3695   fWithAlpha        := tfS3tcDtx3RGBA;
3696   fUncompressed     := tfRGBA8;
3697   fPixelSize        := 1.0;
3698   fIsCompressed     := true;
3699   fglFormat         := GL_COMPRESSED_RGBA;
3700   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3701   fglDataFormat     := GL_UNSIGNED_BYTE;
3702 end;
3703
3704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3707 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3708 begin
3709   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3710 end;
3711
3712 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3713 begin
3714   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3715 end;
3716
3717 constructor TfdS3tcDtx5RGBA.Create;
3718 begin
3719   inherited Create;
3720   fFormat           := tfS3tcDtx3RGBA;
3721   fWithAlpha        := tfS3tcDtx3RGBA;
3722   fUncompressed     := tfRGBA8;
3723   fPixelSize        := 1.0;
3724   fIsCompressed     := true;
3725   fglFormat         := GL_COMPRESSED_RGBA;
3726   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3727   fglDataFormat     := GL_UNSIGNED_BYTE;
3728 end;
3729
3730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3733 class procedure TFormatDescriptor.Init;
3734 begin
3735   if not Assigned(FormatDescriptorCS) then
3736     FormatDescriptorCS := TCriticalSection.Create;
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3741 begin
3742   FormatDescriptorCS.Enter;
3743   try
3744     result := FormatDescriptors[aFormat];
3745     if not Assigned(result) then begin
3746       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3747       FormatDescriptors[aFormat] := result;
3748     end;
3749   finally
3750     FormatDescriptorCS.Leave;
3751   end;
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3756 begin
3757   result := Get(Get(aFormat).WithAlpha);
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 class procedure TFormatDescriptor.Clear;
3762 var
3763   f: TglBitmapFormat;
3764 begin
3765   FormatDescriptorCS.Enter;
3766   try
3767     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3768       FreeAndNil(FormatDescriptors[f]);
3769   finally
3770     FormatDescriptorCS.Leave;
3771   end;
3772 end;
3773
3774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3775 class procedure TFormatDescriptor.Finalize;
3776 begin
3777   Clear;
3778   FreeAndNil(FormatDescriptorCS);
3779 end;
3780
3781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3784 procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
3785 begin
3786   Update(aValue, fRange.r, fShift.r);
3787 end;
3788
3789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3790 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
3791 begin
3792   Update(aValue, fRange.g, fShift.g);
3793 end;
3794
3795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3796 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
3797 begin
3798   Update(aValue, fRange.b, fShift.b);
3799 end;
3800
3801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3802 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
3803 begin
3804   Update(aValue, fRange.a, fShift.a);
3805 end;
3806
3807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3808 procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
3809   aShift: Byte);
3810 begin
3811   aShift := 0;
3812   aRange := 0;
3813   if (aMask = 0) then
3814     exit;
3815   while (aMask > 0) and ((aMask and 1) = 0) do begin
3816     inc(aShift);
3817     aMask := aMask shr 1;
3818   end;
3819   aRange := 1;
3820   while (aMask > 0) do begin
3821     aRange := aRange shl 1;
3822     aMask  := aMask  shr 1;
3823   end;
3824   dec(aRange);
3825
3826   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3827 end;
3828
3829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3830 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3831 var
3832   data: UInt64;
3833   s: Integer;
3834 type
3835   PUInt64 = ^UInt64;
3836 begin
3837   data :=
3838     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3839     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3840     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3841     ((aPixel.Data.a and fRange.a) shl fShift.a);
3842   s := Round(fPixelSize);
3843   case s of
3844     1:           aData^  := data;
3845     2:     PWord(aData)^ := data;
3846     4: PCardinal(aData)^ := data;
3847     8:   PUInt64(aData)^ := data;
3848   else
3849     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3850   end;
3851   inc(aData, s);
3852 end;
3853
3854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3855 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3856 var
3857   data: UInt64;
3858   s, i: Integer;
3859 type
3860   PUInt64 = ^UInt64;
3861 begin
3862   s := Round(fPixelSize);
3863   case s of
3864     1: data :=           aData^;
3865     2: data :=     PWord(aData)^;
3866     4: data := PCardinal(aData)^;
3867     8: data :=   PUInt64(aData)^;
3868   else
3869     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3870   end;
3871   for i := 0 to 3 do
3872     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3873   inc(aData, s);
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3879 procedure TbmpColorTableFormat.CreateColorTable;
3880 var
3881   i: Integer;
3882 begin
3883   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3884     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3885
3886   if (Format = tfLuminance4) then
3887     SetLength(fColorTable, 16)
3888   else
3889     SetLength(fColorTable, 256);
3890
3891   case Format of
3892     tfLuminance4: begin
3893       for i := 0 to High(fColorTable) do begin
3894         fColorTable[i].r := 16 * i;
3895         fColorTable[i].g := 16 * i;
3896         fColorTable[i].b := 16 * i;
3897         fColorTable[i].a := 0;
3898       end;
3899     end;
3900
3901     tfLuminance8: begin
3902       for i := 0 to High(fColorTable) do begin
3903         fColorTable[i].r := i;
3904         fColorTable[i].g := i;
3905         fColorTable[i].b := i;
3906         fColorTable[i].a := 0;
3907       end;
3908     end;
3909
3910     tfR3G3B2: begin
3911       for i := 0 to High(fColorTable) do begin
3912         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3913         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3914         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3915         fColorTable[i].a := 0;
3916       end;
3917     end;
3918   end;
3919 end;
3920
3921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3922 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3923 var
3924   d: Byte;
3925 begin
3926   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3927     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3928
3929   case Format of
3930     tfLuminance4: begin
3931       if (aMapData = nil) then
3932         aData^ := 0;
3933       d := LuminanceWeight(aPixel) and Range.r;
3934       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3935       inc(aMapData, 4);
3936       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3937         inc(aData);
3938         aMapData := nil;
3939       end;
3940     end;
3941
3942     tfLuminance8: begin
3943       aData^ := LuminanceWeight(aPixel) and Range.r;
3944       inc(aData);
3945     end;
3946
3947     tfR3G3B2: begin
3948       aData^ := Round(
3949         ((aPixel.Data.r and Range.r) shl Shift.r) or
3950         ((aPixel.Data.g and Range.g) shl Shift.g) or
3951         ((aPixel.Data.b and Range.b) shl Shift.b));
3952       inc(aData);
3953     end;
3954   end;
3955 end;
3956
3957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3958 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3959 type
3960   PUInt64 = ^UInt64;
3961 var
3962   idx: UInt64;
3963   s: Integer;
3964   bits: Byte;
3965   f: Single;
3966 begin
3967   s    := Trunc(fPixelSize);
3968   f    := fPixelSize - s;
3969   bits := Round(8 * f);
3970   case s of
3971     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
3972     1: idx :=           aData^;
3973     2: idx :=     PWord(aData)^;
3974     4: idx := PCardinal(aData)^;
3975     8: idx :=   PUInt64(aData)^;
3976   else
3977     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3978   end;
3979   if (idx >= Length(fColorTable)) then
3980     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3981   with fColorTable[idx] do begin
3982     aPixel.Data.r := r;
3983     aPixel.Data.g := g;
3984     aPixel.Data.b := b;
3985     aPixel.Data.a := a;
3986   end;
3987   inc(aMapData, bits);
3988   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3989     inc(aData, 1);
3990     dec(aMapData, 8);
3991   end;
3992   inc(aData, s);
3993 end;
3994
3995 destructor TbmpColorTableFormat.Destroy;
3996 begin
3997   SetLength(fColorTable, 0);
3998   inherited Destroy;
3999 end;
4000
4001 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4002 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4004 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4005 var
4006   i: Integer;
4007 begin
4008   for i := 0 to 3 do begin
4009     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4010       if (aSourceFD.Range.arr[i] > 0) then
4011         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4012       else
4013         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4014     end;
4015   end;
4016 end;
4017
4018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4019 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4020 begin
4021   with aFuncRec do begin
4022     if (Source.Range.r   > 0) then
4023       Dest.Data.r := Source.Data.r;
4024     if (Source.Range.g > 0) then
4025       Dest.Data.g := Source.Data.g;
4026     if (Source.Range.b  > 0) then
4027       Dest.Data.b := Source.Data.b;
4028     if (Source.Range.a > 0) then
4029       Dest.Data.a := Source.Data.a;
4030   end;
4031 end;
4032
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4035 var
4036   i: Integer;
4037 begin
4038   with aFuncRec do begin
4039     for i := 0 to 3 do
4040       if (Source.Range.arr[i] > 0) then
4041         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4042   end;
4043 end;
4044
4045 type
4046   TShiftData = packed record
4047     case Integer of
4048       0: (r, g, b, a: SmallInt);
4049       1: (arr: array[0..3] of SmallInt);
4050   end;
4051   PShiftData = ^TShiftData;
4052
4053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4054 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4055 var
4056   i: Integer;
4057 begin
4058   with aFuncRec do
4059     for i := 0 to 3 do
4060       if (Source.Range.arr[i] > 0) then
4061         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4062 end;
4063
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4066 begin
4067   with aFuncRec do begin
4068     Dest.Data := Source.Data;
4069     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4070       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4071       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4072       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4073     end;
4074     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4075       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4076     end;
4077   end;
4078 end;
4079
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4082 var
4083   i: Integer;
4084 begin
4085   with aFuncRec do begin
4086     for i := 0 to 3 do
4087       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4088   end;
4089 end;
4090
4091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4092 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4093 var
4094   Temp: Single;
4095 begin
4096   with FuncRec do begin
4097     if (FuncRec.Args = nil) then begin //source has no alpha
4098       Temp :=
4099         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4100         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4101         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4102       Dest.Data.a := Round(Dest.Range.a * Temp);
4103     end else
4104       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4105   end;
4106 end;
4107
4108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4110 type
4111   PglBitmapPixelData = ^TglBitmapPixelData;
4112 begin
4113   with FuncRec do begin
4114     Dest.Data.r := Source.Data.r;
4115     Dest.Data.g := Source.Data.g;
4116     Dest.Data.b := Source.Data.b;
4117
4118     with PglBitmapPixelData(Args)^ do
4119       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4120           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4121           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4122         Dest.Data.a := 0
4123       else
4124         Dest.Data.a := Dest.Range.a;
4125   end;
4126 end;
4127
4128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4129 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4130 begin
4131   with FuncRec do begin
4132     Dest.Data.r := Source.Data.r;
4133     Dest.Data.g := Source.Data.g;
4134     Dest.Data.b := Source.Data.b;
4135     Dest.Data.a := PCardinal(Args)^;
4136   end;
4137 end;
4138
4139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4140 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4141 type
4142   PRGBPix = ^TRGBPix;
4143   TRGBPix = array [0..2] of byte;
4144 var
4145   Temp: Byte;
4146 begin
4147   while aWidth > 0 do begin
4148     Temp := PRGBPix(aData)^[0];
4149     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4150     PRGBPix(aData)^[2] := Temp;
4151
4152     if aHasAlpha then
4153       Inc(aData, 4)
4154     else
4155       Inc(aData, 3);
4156     dec(aWidth);
4157   end;
4158 end;
4159
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4163 function TglBitmap.GetWidth: Integer;
4164 begin
4165   if (ffX in fDimension.Fields) then
4166     result := fDimension.X
4167   else
4168     result := -1;
4169 end;
4170
4171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 function TglBitmap.GetHeight: Integer;
4173 begin
4174   if (ffY in fDimension.Fields) then
4175     result := fDimension.Y
4176   else
4177     result := -1;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 function TglBitmap.GetFileWidth: Integer;
4182 begin
4183   result := Max(1, Width);
4184 end;
4185
4186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4187 function TglBitmap.GetFileHeight: Integer;
4188 begin
4189   result := Max(1, Height);
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4194 begin
4195   if fCustomData = aValue then
4196     exit;
4197   fCustomData := aValue;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 procedure TglBitmap.SetCustomName(const aValue: String);
4202 begin
4203   if fCustomName = aValue then
4204     exit;
4205   fCustomName := aValue;
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4210 begin
4211   if fCustomNameW = aValue then
4212     exit;
4213   fCustomNameW := aValue;
4214 end;
4215
4216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4217 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4218 begin
4219   if fDeleteTextureOnFree = aValue then
4220     exit;
4221   fDeleteTextureOnFree := aValue;
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4226 begin
4227   if fFormat = aValue then
4228     exit;
4229   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4230     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
4231   SetDataPointer(Data, aValue, Width, Height);
4232 end;
4233
4234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4235 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4236 begin
4237   if fFreeDataAfterGenTexture = aValue then
4238     exit;
4239   fFreeDataAfterGenTexture := aValue;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure TglBitmap.SetID(const aValue: Cardinal);
4244 begin
4245   if fID = aValue then
4246     exit;
4247   fID := aValue;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4252 begin
4253   if fMipMap = aValue then
4254     exit;
4255   fMipMap := aValue;
4256 end;
4257
4258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4260 begin
4261   if fTarget = aValue then
4262     exit;
4263   fTarget := aValue;
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4268 var
4269   MaxAnisotropic: Integer;
4270 begin
4271   fAnisotropic := aValue;
4272   if (ID > 0) then begin
4273     if GL_EXT_texture_filter_anisotropic then begin
4274       if fAnisotropic > 0 then begin
4275         Bind(false);
4276         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4277         if aValue > MaxAnisotropic then
4278           fAnisotropic := MaxAnisotropic;
4279         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4280       end;
4281     end else begin
4282       fAnisotropic := 0;
4283     end;
4284   end;
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 procedure TglBitmap.CreateID;
4289 begin
4290   if (ID <> 0) then
4291     glDeleteTextures(1, @fID);
4292   glGenTextures(1, @fID);
4293   Bind(false);
4294 end;
4295
4296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4297 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4298 begin
4299   // Set Up Parameters
4300   SetWrap(fWrapS, fWrapT, fWrapR);
4301   SetFilter(fFilterMin, fFilterMag);
4302   SetAnisotropic(fAnisotropic);
4303   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4304
4305   // Mip Maps Generation Mode
4306   aBuildWithGlu := false;
4307   if (MipMap = mmMipmap) then begin
4308     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4309       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4310     else
4311       aBuildWithGlu := true;
4312   end else if (MipMap = mmMipmapGlu) then
4313     aBuildWithGlu := true;
4314 end;
4315
4316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4317 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4318   const aWidth: Integer; const aHeight: Integer);
4319 var
4320   s: Single;
4321 begin
4322   if (Data <> aData) then begin
4323     if (Assigned(Data)) then
4324       FreeMem(Data);
4325     fData := aData;
4326   end;
4327
4328   FillChar(fDimension, SizeOf(fDimension), 0);
4329   if not Assigned(fData) then begin
4330     fFormat    := tfEmpty;
4331     fPixelSize := 0;
4332     fRowSize   := 0;
4333   end else begin
4334     if aWidth <> -1 then begin
4335       fDimension.Fields := fDimension.Fields + [ffX];
4336       fDimension.X := aWidth;
4337     end;
4338
4339     if aHeight <> -1 then begin
4340       fDimension.Fields := fDimension.Fields + [ffY];
4341       fDimension.Y := aHeight;
4342     end;
4343
4344     s := TFormatDescriptor.Get(aFormat).PixelSize;
4345     fFormat    := aFormat;
4346     fPixelSize := Ceil(s);
4347     fRowSize   := Ceil(s * aWidth);
4348   end;
4349 end;
4350
4351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4352 function TglBitmap.FlipHorz: Boolean;
4353 begin
4354   result := false;
4355 end;
4356
4357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4358 function TglBitmap.FlipVert: Boolean;
4359 begin
4360   result := false;
4361 end;
4362
4363 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4364 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4366 procedure TglBitmap.AfterConstruction;
4367 begin
4368   inherited AfterConstruction;
4369
4370   fID         := 0;
4371   fTarget     := 0;
4372   fIsResident := false;
4373
4374   fFormat                  := glBitmapGetDefaultFormat;
4375   fMipMap                  := glBitmapDefaultMipmap;
4376   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4377   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4378
4379   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4380   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4381 end;
4382
4383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4384 procedure TglBitmap.BeforeDestruction;
4385 begin
4386   SetDataPointer(nil, tfEmpty);
4387   if (fID > 0) and fDeleteTextureOnFree then
4388     glDeleteTextures(1, @fID);
4389   inherited BeforeDestruction;
4390 end;
4391
4392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4393 procedure TglBitmap.LoadFromFile(const aFilename: String);
4394 var
4395   fs: TFileStream;
4396 begin
4397   if not FileExists(aFilename) then
4398     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4399   fFilename := aFilename;
4400   fs := TFileStream.Create(fFilename, fmOpenRead);
4401   try
4402     fs.Position := 0;
4403     LoadFromStream(fs);
4404   finally
4405     fs.Free;
4406   end;
4407 end;
4408
4409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4410 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4411 begin
4412   {$IFDEF GLB_SUPPORT_PNG_READ}
4413   if not LoadPNG(aStream) then
4414   {$ENDIF}
4415   {$IFDEF GLB_SUPPORT_JPEG_READ}
4416   if not LoadJPEG(aStream) then
4417   {$ENDIF}
4418   if not LoadDDS(aStream) then
4419   if not LoadTGA(aStream) then
4420   if not LoadBMP(aStream) then
4421     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4426   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4427 var
4428   tmpData: PByte;
4429   size: Integer;
4430 begin
4431   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4432   GetMem(tmpData, size);
4433   try
4434     FillChar(tmpData^, size, #$FF);
4435     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4436   except
4437     FreeMem(tmpData);
4438     raise;
4439   end;
4440   AddFunc(Self, aFunc, false, Format, aArgs);
4441 end;
4442
4443 {$IFDEF GLB_DELPHI}
4444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4445 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4446 var
4447   rs: TResourceStream;
4448   TempPos: Integer;
4449   ResTypeStr: String;
4450   TempResType: PChar;
4451 begin
4452   if not Assigned(ResType) then begin
4453     TempPos     := Pos('.', Resource);
4454     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4455     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4456     TempResType := PChar(ResTypeStr);
4457   end else
4458     TempResType := ResType
4459
4460   rs := TResourceStream.Create(Instance, Resource, TempResType);
4461   try
4462     LoadFromStream(rs);
4463   finally
4464     rs.Free;
4465   end;
4466 end;
4467
4468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4469 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4470 var
4471   rs: TResourceStream;
4472 begin
4473   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4474   try
4475     LoadFromStream(rs);
4476   finally
4477     rs.Free;
4478   end;
4479 end;
4480 {$ENDIF}
4481
4482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4483 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4484 var
4485   fs: TFileStream;
4486 begin
4487   fs := TFileStream.Create(aFileName, fmCreate);
4488   try
4489     fs.Position := 0;
4490     SaveToStream(fs, aFileType);
4491   finally
4492     fs.Free;
4493   end;
4494 end;
4495
4496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4497 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4498 begin
4499   case aFileType of
4500     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4501     ftPNG:  SavePng(aStream);
4502     {$ENDIF}
4503     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4504     ftJPEG: SaveJPEG(aStream);
4505     {$ENDIF}
4506     ftDDS:  SaveDDS(aStream);
4507     ftTGA:  SaveTGA(aStream);
4508     ftBMP:  SaveBMP(aStream);
4509   end;
4510 end;
4511
4512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4513 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4514 begin
4515   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4516 end;
4517
4518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4519 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4520   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4521 var
4522   DestData, TmpData, SourceData: pByte;
4523   TempHeight, TempWidth: Integer;
4524   SourceFD, DestFD: TFormatDescriptor;
4525   SourceMD, DestMD: Pointer;
4526
4527   FuncRec: TglBitmapFunctionRec;
4528 begin
4529   Assert(Assigned(Data));
4530   Assert(Assigned(aSource));
4531   Assert(Assigned(aSource.Data));
4532
4533   result := false;
4534   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4535     SourceFD := TFormatDescriptor.Get(aSource.Format);
4536     DestFD   := TFormatDescriptor.Get(aFormat);
4537
4538     // inkompatible Formats so CreateTemp
4539     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4540       aCreateTemp := true;
4541
4542     // Values
4543     TempHeight := Max(1, aSource.Height);
4544     TempWidth  := Max(1, aSource.Width);
4545
4546     FuncRec.Sender := Self;
4547     FuncRec.Args   := aArgs;
4548
4549     TmpData := nil;
4550     if aCreateTemp then begin
4551       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4552       DestData := TmpData;
4553     end else
4554       DestData := Data;
4555
4556     try
4557       SourceFD.PreparePixel(FuncRec.Source);
4558       DestFD.PreparePixel  (FuncRec.Dest);
4559
4560       SourceMD := SourceFD.CreateMappingData;
4561       DestMD   := DestFD.CreateMappingData;
4562
4563       FuncRec.Size            := aSource.Dimension;
4564       FuncRec.Position.Fields := FuncRec.Size.Fields;
4565
4566       try
4567         SourceData := aSource.Data;
4568         FuncRec.Position.Y := 0;
4569         while FuncRec.Position.Y < TempHeight do begin
4570           FuncRec.Position.X := 0;
4571           while FuncRec.Position.X < TempWidth do begin
4572             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4573             aFunc(FuncRec);
4574             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4575             inc(FuncRec.Position.X);
4576           end;
4577           inc(FuncRec.Position.Y);
4578         end;
4579
4580         // Updating Image or InternalFormat
4581         if aCreateTemp then
4582           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4583         else if (aFormat <> fFormat) then
4584           Format := aFormat;
4585
4586         result := true;
4587       finally
4588         SourceFD.FreeMappingData(SourceMD);
4589         DestFD.FreeMappingData(DestMD);
4590       end;
4591     except
4592       if aCreateTemp then
4593         FreeMem(TmpData);
4594       raise;
4595     end;
4596   end;
4597 end;
4598
4599 {$IFDEF GLB_SDL}
4600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4601 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4602 var
4603   Row, RowSize: Integer;
4604   SourceData, TmpData: PByte;
4605   TempDepth: Integer;
4606   Pix: TglBitmapPixelData;
4607   FormatDesc: TglBitmapFormatDescriptor;
4608
4609   function GetRowPointer(Row: Integer): pByte;
4610   begin
4611     result := Surface.pixels;
4612     Inc(result, Row * RowSize);
4613   end;
4614
4615 begin
4616   result := false;
4617
4618   (* TODO
4619   if not FormatIsUncompressed(InternalFormat) then
4620     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4621   *)
4622
4623   FormatDesc := FORMAT_DESCRIPTORS[Format];
4624   if Assigned(Data) then begin
4625     case Trunc(FormatDesc.GetSize) of
4626       1: TempDepth :=  8;
4627       2: TempDepth := 16;
4628       3: TempDepth := 24;
4629       4: TempDepth := 32;
4630     else
4631       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
4632     end;
4633     FormatDesc.PreparePixel(Pix);
4634     with Pix.PixelDesc do
4635       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4636         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
4637
4638     SourceData := Data;
4639     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);
4640
4641     for Row := 0 to FileHeight -1 do begin
4642       TmpData := GetRowPointer(Row);
4643       if Assigned(TmpData) then begin
4644         Move(SourceData^, TmpData^, RowSize);
4645         inc(SourceData, RowSize);
4646       end;
4647     end;
4648     result := true;
4649   end;
4650 end;
4651
4652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4653 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4654 var
4655   pSource, pData, pTempData: PByte;
4656   Row, RowSize, TempWidth, TempHeight: Integer;
4657   IntFormat, f: TglBitmapInternalFormat;
4658   FormatDesc: TglBitmapFormatDescriptor;
4659
4660   function GetRowPointer(Row: Integer): pByte;
4661   begin
4662     result := Surface^.pixels;
4663     Inc(result, Row * RowSize);
4664   end;
4665
4666 begin
4667   result := false;
4668   if (Assigned(Surface)) then begin
4669     with Surface^.format^ do begin
4670       IntFormat := tfEmpty;
4671       for f := Low(f) to High(f) do begin
4672         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
4673           IntFormat := f;
4674           break;
4675         end;
4676       end;
4677       if (IntFormat = tfEmpty) then
4678         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4679     end;
4680
4681     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
4682     TempWidth  := Surface^.w;
4683     TempHeight := Surface^.h;
4684     RowSize := Trunc(TempWidth * FormatDesc.GetSize);
4685     GetMem(pData, TempHeight * RowSize);
4686     try
4687       pTempData := pData;
4688       for Row := 0 to TempHeight -1 do begin
4689         pSource := GetRowPointer(Row);
4690         if (Assigned(pSource)) then begin
4691           Move(pSource^, pTempData^, RowSize);
4692           Inc(pTempData, RowSize);
4693         end;
4694       end;
4695       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4696       result := true;
4697     except
4698       FreeMem(pData);
4699       raise;
4700     end;
4701   end;
4702 end;
4703
4704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4705 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4706 var
4707   Row, Col, AlphaInterleave: Integer;
4708   pSource, pDest: PByte;
4709
4710   function GetRowPointer(Row: Integer): pByte;
4711   begin
4712     result := aSurface.pixels;
4713     Inc(result, Row * Width);
4714   end;
4715
4716 begin
4717   result := false;
4718   if Assigned(Data) then begin
4719     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4720       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4721
4722       AlphaInterleave := 0;
4723       case Format of
4724         ifLuminance8Alpha8:
4725           AlphaInterleave := 1;
4726         ifBGRA8, ifRGBA8:
4727           AlphaInterleave := 3;
4728       end;
4729
4730       pSource := Data;
4731       for Row := 0 to Height -1 do begin
4732         pDest := GetRowPointer(Row);
4733         if Assigned(pDest) then begin
4734           for Col := 0 to Width -1 do begin
4735             Inc(pSource, AlphaInterleave);
4736             pDest^ := pSource^;
4737             Inc(pDest);
4738             Inc(pSource);
4739           end;
4740         end;
4741       end;
4742       result := true;
4743     end;
4744   end;
4745 end;
4746
4747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4748 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4749 var
4750   bmp: TglBitmap2D;
4751 begin
4752   bmp := TglBitmap2D.Create;
4753   try
4754     bmp.AssignFromSurface(Surface);
4755     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
4756   finally
4757     bmp.Free;
4758   end;
4759 end;
4760 {$ENDIF}
4761
4762 {$IFDEF GLB_DELPHI}
4763 //TODO rework & test
4764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4765 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4766 var
4767   Row: Integer;
4768   pSource, pData: PByte;
4769 begin
4770   result := false;
4771   if Assigned(Data) then begin
4772     if Assigned(aBitmap) then begin
4773       aBitmap.Width  := Width;
4774       aBitmap.Height := Height;
4775
4776       case Format of
4777         tfAlpha8, ifLuminance, ifDepth8:
4778           begin
4779             Bitmap.PixelFormat := pf8bit;
4780             Bitmap.Palette := CreateGrayPalette;
4781           end;
4782         ifRGB5A1:
4783           Bitmap.PixelFormat := pf15bit;
4784         ifR5G6B5:
4785           Bitmap.PixelFormat := pf16bit;
4786         ifRGB8, ifBGR8:
4787           Bitmap.PixelFormat := pf24bit;
4788         ifRGBA8, ifBGRA8:
4789           Bitmap.PixelFormat := pf32bit;
4790         else
4791           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4792       end;
4793
4794       pSource := Data;
4795       for Row := 0 to FileHeight -1 do begin
4796         pData := Bitmap.Scanline[Row];
4797
4798         Move(pSource^, pData^, fRowSize);
4799         Inc(pSource, fRowSize);
4800
4801         // swap RGB(A) to BGR(A)
4802         if InternalFormat in [ifRGB8, ifRGBA8] then
4803           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4804       end;
4805
4806       result := true;
4807     end;
4808   end;
4809 end;
4810
4811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4812 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4813 var
4814   pSource, pData, pTempData: PByte;
4815   Row, RowSize, TempWidth, TempHeight: Integer;
4816   IntFormat: TglBitmapInternalFormat;
4817 begin
4818   result := false;
4819
4820   if (Assigned(Bitmap)) then begin
4821     case Bitmap.PixelFormat of
4822       pf8bit:
4823         IntFormat := ifLuminance;
4824       pf15bit:
4825         IntFormat := ifRGB5A1;
4826       pf16bit:
4827         IntFormat := ifR5G6B5;
4828       pf24bit:
4829         IntFormat := ifBGR8;
4830       pf32bit:
4831         IntFormat := ifBGRA8;
4832       else
4833         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4834     end;
4835
4836     TempWidth := Bitmap.Width;
4837     TempHeight := Bitmap.Height;
4838
4839     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4840
4841     GetMem(pData, TempHeight * RowSize);
4842     try
4843       pTempData := pData;
4844
4845       for Row := 0 to TempHeight -1 do begin
4846         pSource := Bitmap.Scanline[Row];
4847
4848         if (Assigned(pSource)) then begin
4849           Move(pSource^, pTempData^, RowSize);
4850           Inc(pTempData, RowSize);
4851         end;
4852       end;
4853
4854       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4855
4856       result := true;
4857     except
4858       FreeMem(pData);
4859       raise;
4860     end;
4861   end;
4862 end;
4863
4864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4865 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4866 var
4867   Row, Col, AlphaInterleave: Integer;
4868   pSource, pDest: PByte;
4869 begin
4870   result := false;
4871
4872   if Assigned(Data) then begin
4873     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4874       if Assigned(Bitmap) then begin
4875         Bitmap.PixelFormat := pf8bit;
4876         Bitmap.Palette := CreateGrayPalette;
4877         Bitmap.Width := Width;
4878         Bitmap.Height := Height;
4879
4880         case InternalFormat of
4881           ifLuminanceAlpha:
4882             AlphaInterleave := 1;
4883           ifRGBA8, ifBGRA8:
4884             AlphaInterleave := 3;
4885           else
4886             AlphaInterleave := 0;
4887         end;
4888
4889         // Copy Data
4890         pSource := Data;
4891
4892         for Row := 0 to Height -1 do begin
4893           pDest := Bitmap.Scanline[Row];
4894
4895           if Assigned(pDest) then begin
4896             for Col := 0 to Width -1 do begin
4897               Inc(pSource, AlphaInterleave);
4898               pDest^ := pSource^;
4899               Inc(pDest);
4900               Inc(pSource);
4901             end;
4902           end;
4903         end;
4904
4905         result := true;
4906       end;
4907     end;
4908   end;
4909 end;
4910
4911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4912 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4913 var
4914   tex: TglBitmap2D;
4915 begin
4916   tex := TglBitmap2D.Create;
4917   try
4918     tex.AssignFromBitmap(Bitmap);
4919     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4920   finally
4921     tex.Free;
4922   end;
4923 end;
4924
4925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4926 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4927   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4928 var
4929   RS: TResourceStream;
4930   TempPos: Integer;
4931   ResTypeStr: String;
4932   TempResType: PChar;
4933 begin
4934   if Assigned(ResType) then
4935     TempResType := ResType
4936   else
4937     begin
4938       TempPos := Pos('.', Resource);
4939       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4940       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4941       TempResType := PChar(ResTypeStr);
4942     end;
4943
4944   RS := TResourceStream.Create(Instance, Resource, TempResType);
4945   try
4946     result := AddAlphaFromStream(RS, Func, CustomData);
4947   finally
4948     RS.Free;
4949   end;
4950 end;
4951
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4954   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4955 var
4956   RS: TResourceStream;
4957 begin
4958   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4959   try
4960     result := AddAlphaFromStream(RS, Func, CustomData);
4961   finally
4962     RS.Free;
4963   end;
4964 end;
4965 {$ENDIF}
4966
4967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4968 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4969 begin
4970   (* TODO
4971   if not FormatIsUncompressed(InternalFormat) then
4972     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4973   *)
4974   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4975 end;
4976
4977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4978 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4979 var
4980   FS: TFileStream;
4981 begin
4982   FS := TFileStream.Create(FileName, fmOpenRead);
4983   try
4984     result := AddAlphaFromStream(FS, aFunc, aArgs);
4985   finally
4986     FS.Free;
4987   end;
4988 end;
4989
4990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4991 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4992 var
4993   tex: TglBitmap2D;
4994 begin
4995   tex := TglBitmap2D.Create(aStream);
4996   try
4997     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4998   finally
4999     tex.Free;
5000   end;
5001 end;
5002
5003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5004 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5005 var
5006   DestData, DestData2, SourceData: pByte;
5007   TempHeight, TempWidth: Integer;
5008   SourceFD, DestFD: TFormatDescriptor;
5009   SourceMD, DestMD, DestMD2: Pointer;
5010
5011   FuncRec: TglBitmapFunctionRec;
5012 begin
5013   result := false;
5014
5015   Assert(Assigned(Data));
5016   Assert(Assigned(aBitmap));
5017   Assert(Assigned(aBitmap.Data));
5018
5019   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5020     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5021
5022     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5023     DestFD   := TFormatDescriptor.Get(Format);
5024
5025     if not Assigned(aFunc) then begin
5026       aFunc        := glBitmapAlphaFunc;
5027       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5028     end else
5029       FuncRec.Args := aArgs;
5030
5031     // Values
5032     TempHeight := aBitmap.FileHeight;
5033     TempWidth  := aBitmap.FileWidth;
5034
5035     FuncRec.Sender          := Self;
5036     FuncRec.Size            := Dimension;
5037     FuncRec.Position.Fields := FuncRec.Size.Fields;
5038
5039     DestData   := Data;
5040     DestData2  := Data;
5041     SourceData := aBitmap.Data;
5042
5043     // Mapping
5044     SourceFD.PreparePixel(FuncRec.Source);
5045     DestFD.PreparePixel  (FuncRec.Dest);
5046
5047     SourceMD := SourceFD.CreateMappingData;
5048     DestMD   := DestFD.CreateMappingData;
5049     DestMD2  := DestFD.CreateMappingData;
5050     try
5051       FuncRec.Position.Y := 0;
5052       while FuncRec.Position.Y < TempHeight do begin
5053         FuncRec.Position.X := 0;
5054         while FuncRec.Position.X < TempWidth do begin
5055           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5056           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5057           aFunc(FuncRec);
5058           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5059           inc(FuncRec.Position.X);
5060         end;
5061         inc(FuncRec.Position.Y);
5062       end;
5063     finally
5064       SourceFD.FreeMappingData(SourceMD);
5065       DestFD.FreeMappingData(DestMD);
5066       DestFD.FreeMappingData(DestMD2);
5067     end;
5068   end;
5069 end;
5070
5071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5072 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5073 begin
5074   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5075 end;
5076
5077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5078 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5079 var
5080   PixelData: TglBitmapPixelData;
5081 begin
5082   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5083   result := AddAlphaFromColorKeyFloat(
5084     aRed   / PixelData.Range.r,
5085     aGreen / PixelData.Range.g,
5086     aBlue  / PixelData.Range.b,
5087     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5088 end;
5089
5090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5091 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5092 var
5093   values: array[0..2] of Single;
5094   tmp: Cardinal;
5095   i: Integer;
5096   PixelData: TglBitmapPixelData;
5097 begin
5098   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5099   with PixelData do begin
5100     values[0] := aRed;
5101     values[1] := aGreen;
5102     values[2] := aBlue;
5103
5104     for i := 0 to 2 do begin
5105       tmp          := Trunc(Range.arr[i] * aDeviation);
5106       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5107       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5108     end;
5109     Data.a  := 0;
5110     Range.a := 0;
5111   end;
5112   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5113 end;
5114
5115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5116 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5117 begin
5118   result := AddAlphaFromValueFloat(aAlpha / $FF);
5119 end;
5120
5121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5122 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5123 var
5124   PixelData: TglBitmapPixelData;
5125 begin
5126   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5127   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5128 end;
5129
5130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5131 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5132 var
5133   PixelData: TglBitmapPixelData;
5134 begin
5135   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5136   with PixelData do
5137     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5138   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5139 end;
5140
5141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5142 function TglBitmap.RemoveAlpha: Boolean;
5143 var
5144   FormatDesc: TFormatDescriptor;
5145 begin
5146   result := false;
5147   FormatDesc := TFormatDescriptor.Get(Format);
5148   if Assigned(Data) then begin
5149     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5150       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
5151     result := ConvertTo(FormatDesc.WithoutAlpha);
5152   end;
5153 end;
5154
5155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5156 function TglBitmap.Clone: TglBitmap;
5157 var
5158   Temp: TglBitmap;
5159   TempPtr: PByte;
5160   Size: Integer;
5161 begin
5162   result := nil;
5163   Temp := (ClassType.Create as TglBitmap);
5164   try
5165     // copy texture data if assigned
5166     if Assigned(Data) then begin
5167       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5168       GetMem(TempPtr, Size);
5169       try
5170         Move(Data^, TempPtr^, Size);
5171         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5172       except
5173         FreeMem(TempPtr);
5174         raise;
5175       end;
5176     end else
5177       Temp.SetDataPointer(nil, Format, Width, Height);
5178
5179         // copy properties
5180     Temp.fID                      := ID;
5181     Temp.fTarget                  := Target;
5182     Temp.fFormat                  := Format;
5183     Temp.fMipMap                  := MipMap;
5184     Temp.fAnisotropic             := Anisotropic;
5185     Temp.fBorderColor             := fBorderColor;
5186     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5187     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5188     Temp.fFilterMin               := fFilterMin;
5189     Temp.fFilterMag               := fFilterMag;
5190     Temp.fWrapS                   := fWrapS;
5191     Temp.fWrapT                   := fWrapT;
5192     Temp.fWrapR                   := fWrapR;
5193     Temp.fFilename                := fFilename;
5194     Temp.fCustomName              := fCustomName;
5195     Temp.fCustomNameW             := fCustomNameW;
5196     Temp.fCustomData              := fCustomData;
5197
5198     result := Temp;
5199   except
5200     FreeAndNil(Temp);
5201     raise;
5202   end;
5203 end;
5204
5205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5206 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5207 var
5208   SourceFD, DestFD: TFormatDescriptor;
5209   SourcePD, DestPD: TglBitmapPixelData;
5210   ShiftData: TShiftData;
5211
5212   function CanCopyDirect: Boolean;
5213   begin
5214     result :=
5215       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5216       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5217       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5218       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5219   end;
5220
5221   function CanShift: Boolean;
5222   begin
5223     result :=
5224       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5225       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5226       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5227       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5228   end;
5229
5230   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5231   begin
5232     result := 0;
5233     while (aSource > aDest) and (aSource > 0) do begin
5234       inc(result);
5235       aSource := aSource shr 1;
5236     end;
5237   end;
5238
5239 begin
5240   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5241     SourceFD := TFormatDescriptor.Get(Format);
5242     DestFD   := TFormatDescriptor.Get(aFormat);
5243
5244     SourceFD.PreparePixel(SourcePD);
5245     DestFD.PreparePixel  (DestPD);
5246
5247     if CanCopyDirect then
5248       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5249     else if CanShift then begin
5250       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5251       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5252       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5253       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5254       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5255     end else
5256       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5257   end else
5258     result := true;
5259 end;
5260
5261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5262 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5263 begin
5264   if aUseRGB or aUseAlpha then
5265     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5266       ((PtrInt(aUseAlpha) and 1) shl 1) or
5267        (PtrInt(aUseRGB)   and 1)      ));
5268 end;
5269
5270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5271 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5272 begin
5273   fBorderColor[0] := aRed;
5274   fBorderColor[1] := aGreen;
5275   fBorderColor[2] := aBlue;
5276   fBorderColor[3] := aAlpha;
5277   if (ID > 0) then begin
5278     Bind(false);
5279     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5280   end;
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 procedure TglBitmap.FreeData;
5285 begin
5286   SetDataPointer(nil, tfEmpty);
5287 end;
5288
5289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5290 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5291   const aAlpha: Byte);
5292 begin
5293   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5294 end;
5295
5296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5297 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5298 var
5299   PixelData: TglBitmapPixelData;
5300 begin
5301   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5302   FillWithColorFloat(
5303     aRed   / PixelData.Range.r,
5304     aGreen / PixelData.Range.g,
5305     aBlue  / PixelData.Range.b,
5306     aAlpha / PixelData.Range.a);
5307 end;
5308
5309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5310 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5311 var
5312   PixelData: TglBitmapPixelData;
5313 begin
5314   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5315   with PixelData do begin
5316     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5317     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5318     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5319     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5320   end;
5321   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5322 end;
5323
5324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5325 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5326 begin
5327   //check MIN filter
5328   case aMin of
5329     GL_NEAREST:
5330       fFilterMin := GL_NEAREST;
5331     GL_LINEAR:
5332       fFilterMin := GL_LINEAR;
5333     GL_NEAREST_MIPMAP_NEAREST:
5334       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5335     GL_LINEAR_MIPMAP_NEAREST:
5336       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5337     GL_NEAREST_MIPMAP_LINEAR:
5338       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5339     GL_LINEAR_MIPMAP_LINEAR:
5340       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5341     else
5342       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5343   end;
5344
5345   //check MAG filter
5346   case aMag of
5347     GL_NEAREST:
5348       fFilterMag := GL_NEAREST;
5349     GL_LINEAR:
5350       fFilterMag := GL_LINEAR;
5351     else
5352       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5353   end;
5354
5355   //apply filter
5356   if (ID > 0) then begin
5357     Bind(false);
5358     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5359
5360     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5361       case fFilterMin of
5362         GL_NEAREST, GL_LINEAR:
5363           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5364         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5365           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5366         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5367           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5368       end;
5369     end else
5370       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5371   end;
5372 end;
5373
5374 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5375 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5376
5377   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5378   begin
5379     case aValue of
5380       GL_CLAMP:
5381         aTarget := GL_CLAMP;
5382
5383       GL_REPEAT:
5384         aTarget := GL_REPEAT;
5385
5386       GL_CLAMP_TO_EDGE: begin
5387         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5388           aTarget := GL_CLAMP_TO_EDGE
5389         else
5390           aTarget := GL_CLAMP;
5391       end;
5392
5393       GL_CLAMP_TO_BORDER: begin
5394         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5395           aTarget := GL_CLAMP_TO_BORDER
5396         else
5397           aTarget := GL_CLAMP;
5398       end;
5399
5400       GL_MIRRORED_REPEAT: begin
5401         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5402           aTarget := GL_MIRRORED_REPEAT
5403         else
5404           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5405       end;
5406     else
5407       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5408     end;
5409   end;
5410
5411 begin
5412   CheckAndSetWrap(S, fWrapS);
5413   CheckAndSetWrap(T, fWrapT);
5414   CheckAndSetWrap(R, fWrapR);
5415
5416   if (ID > 0) then begin
5417     Bind(false);
5418     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5419     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5420     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5421   end;
5422 end;
5423
5424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5425 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5426 begin
5427   if aEnableTextureUnit then
5428     glEnable(Target);
5429   if (ID > 0) then
5430     glBindTexture(Target, ID);
5431 end;
5432
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5435 begin
5436   if aDisableTextureUnit then
5437     glDisable(Target);
5438   glBindTexture(Target, 0);
5439 end;
5440
5441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5442 constructor TglBitmap.Create;
5443 begin
5444 {$IFDEF GLB_NATIVE_OGL}
5445   glbReadOpenGLExtensions;
5446 {$ENDIF}
5447   if (ClassType = TglBitmap) then
5448     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5449   inherited Create;
5450 end;
5451
5452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5453 constructor TglBitmap.Create(const aFileName: String);
5454 begin
5455   Create;
5456   LoadFromFile(FileName);
5457 end;
5458
5459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5460 constructor TglBitmap.Create(const aStream: TStream);
5461 begin
5462   Create;
5463   LoadFromStream(aStream);
5464 end;
5465
5466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5467 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5468 var
5469   Image: PByte;
5470   ImageSize: Integer;
5471 begin
5472   Create;
5473   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5474   GetMem(Image, ImageSize);
5475   try
5476     FillChar(Image^, ImageSize, #$FF);
5477     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5478   except
5479     FreeMem(Image);
5480     raise;
5481   end;
5482 end;
5483
5484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5485 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5486   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5487 begin
5488   Create;
5489   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5490 end;
5491
5492 {$IFDEF GLB_DELPHI}
5493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5494 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5495 begin
5496   Create;
5497   LoadFromResource(aInstance, aResource, aResType);
5498 end;
5499
5500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5501 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5502 begin
5503   Create;
5504   LoadFromResourceID(aInstance, aResourceID, aResType);
5505 end;
5506 {$ENDIF}
5507
5508 {$IFDEF GLB_SUPPORT_PNG_READ}
5509 {$IF DEFINED(GLB_SDL_IMAGE)}
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5513 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5514 var
5515   Surface: PSDL_Surface;
5516   RWops: PSDL_RWops;
5517 begin
5518   result := false;
5519   RWops := glBitmapCreateRWops(aStream);
5520   try
5521     if IMG_isPNG(RWops) > 0 then begin
5522       Surface := IMG_LoadPNG_RW(RWops);
5523       try
5524         AssignFromSurface(Surface);
5525         Rresult := true;
5526       finally
5527         SDL_FreeSurface(Surface);
5528       end;
5529     end;
5530   finally
5531     SDL_FreeRW(RWops);
5532   end;
5533 end;
5534
5535 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5537 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5538 begin
5539   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5540 end;
5541
5542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5543 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5544 var
5545   StreamPos: Int64;
5546   signature: array [0..7] of byte;
5547   png: png_structp;
5548   png_info: png_infop;
5549
5550   TempHeight, TempWidth: Integer;
5551   Format: TglBitmapInternalFormat;
5552
5553   png_data: pByte;
5554   png_rows: array of pByte;
5555   Row, LineSize: Integer;
5556 begin
5557   result := false;
5558
5559   if not init_libPNG then
5560     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5561
5562   try
5563     // signature
5564     StreamPos := Stream.Position;
5565     Stream.Read(signature, 8);
5566     Stream.Position := StreamPos;
5567
5568     if png_check_sig(@signature, 8) <> 0 then begin
5569       // png read struct
5570       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5571       if png = nil then
5572         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5573
5574       // png info
5575       png_info := png_create_info_struct(png);
5576       if png_info = nil then begin
5577         png_destroy_read_struct(@png, nil, nil);
5578         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5579       end;
5580
5581       // set read callback
5582       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5583
5584       // read informations
5585       png_read_info(png, png_info);
5586
5587       // size
5588       TempHeight := png_get_image_height(png, png_info);
5589       TempWidth := png_get_image_width(png, png_info);
5590
5591       // format
5592       case png_get_color_type(png, png_info) of
5593         PNG_COLOR_TYPE_GRAY:
5594           Format := tfLuminance8;
5595         PNG_COLOR_TYPE_GRAY_ALPHA:
5596           Format := tfLuminance8Alpha8;
5597         PNG_COLOR_TYPE_RGB:
5598           Format := tfRGB8;
5599         PNG_COLOR_TYPE_RGB_ALPHA:
5600           Format := tfRGBA8;
5601         else
5602           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5603       end;
5604
5605       // cut upper 8 bit from 16 bit formats
5606       if png_get_bit_depth(png, png_info) > 8 then
5607         png_set_strip_16(png);
5608
5609       // expand bitdepth smaller than 8
5610       if png_get_bit_depth(png, png_info) < 8 then
5611         png_set_expand(png);
5612
5613       // allocating mem for scanlines
5614       LineSize := png_get_rowbytes(png, png_info);
5615       GetMem(png_data, TempHeight * LineSize);
5616       try
5617         SetLength(png_rows, TempHeight);
5618         for Row := Low(png_rows) to High(png_rows) do begin
5619           png_rows[Row] := png_data;
5620           Inc(png_rows[Row], Row * LineSize);
5621         end;
5622
5623         // read complete image into scanlines
5624         png_read_image(png, @png_rows[0]);
5625
5626         // read end
5627         png_read_end(png, png_info);
5628
5629         // destroy read struct
5630         png_destroy_read_struct(@png, @png_info, nil);
5631
5632         SetLength(png_rows, 0);
5633
5634         // set new data
5635         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5636
5637         result := true;
5638       except
5639         FreeMem(png_data);
5640         raise;
5641       end;
5642     end;
5643   finally
5644     quit_libPNG;
5645   end;
5646 end;
5647
5648 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5650 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5651 var
5652   StreamPos: Int64;
5653   Png: TPNGObject;
5654   Header: Array[0..7] of Byte;
5655   Row, Col, PixSize, LineSize: Integer;
5656   NewImage, pSource, pDest, pAlpha: pByte;
5657   Format: TglBitmapInternalFormat;
5658
5659 const
5660   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5661
5662 begin
5663   result := false;
5664
5665   StreamPos := Stream.Position;
5666   Stream.Read(Header[0], SizeOf(Header));
5667   Stream.Position := StreamPos;
5668
5669   {Test if the header matches}
5670   if Header = PngHeader then begin
5671     Png := TPNGObject.Create;
5672     try
5673       Png.LoadFromStream(Stream);
5674
5675       case Png.Header.ColorType of
5676         COLOR_GRAYSCALE:
5677           Format := ifLuminance;
5678         COLOR_GRAYSCALEALPHA:
5679           Format := ifLuminanceAlpha;
5680         COLOR_RGB:
5681           Format := ifBGR8;
5682         COLOR_RGBALPHA:
5683           Format := ifBGRA8;
5684         else
5685           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5686       end;
5687
5688       PixSize := Trunc(FormatGetSize(Format));
5689       LineSize := Integer(Png.Header.Width) * PixSize;
5690
5691       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5692       try
5693         pDest := NewImage;
5694
5695         case Png.Header.ColorType of
5696           COLOR_RGB, COLOR_GRAYSCALE:
5697             begin
5698               for Row := 0 to Png.Height -1 do begin
5699                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5700                 Inc(pDest, LineSize);
5701               end;
5702             end;
5703           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5704             begin
5705               PixSize := PixSize -1;
5706
5707               for Row := 0 to Png.Height -1 do begin
5708                 pSource := Png.Scanline[Row];
5709                 pAlpha := pByte(Png.AlphaScanline[Row]);
5710
5711                 for Col := 0 to Png.Width -1 do begin
5712                   Move (pSource^, pDest^, PixSize);
5713                   Inc(pSource, PixSize);
5714                   Inc(pDest, PixSize);
5715
5716                   pDest^ := pAlpha^;
5717                   inc(pAlpha);
5718                   Inc(pDest);
5719                 end;
5720               end;
5721             end;
5722           else
5723             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5724         end;
5725
5726         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5727
5728         result := true;
5729       except
5730         FreeMem(NewImage);
5731         raise;
5732       end;
5733     finally
5734       Png.Free;
5735     end;
5736   end;
5737 end;
5738 {$IFEND}
5739 {$ENDIF}
5740
5741 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5742 {$IFDEF GLB_LIB_PNG}
5743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5744 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5745 begin
5746   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5747 end;
5748 {$ENDIF}
5749
5750 {$IF DEFINED(GLB_LIB_PNG)}
5751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5752 procedure TglBitmap.SavePNG(const aStream: TStream);
5753 var
5754   png: png_structp;
5755   png_info: png_infop;
5756   png_rows: array of pByte;
5757   LineSize: Integer;
5758   ColorType: Integer;
5759   Row: Integer;
5760 begin
5761   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5762     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5763
5764   if not init_libPNG then
5765     raise Exception.Create('SavePNG - unable to initialize libPNG.');
5766
5767   try
5768     case FInternalFormat of
5769       ifAlpha, ifLuminance, ifDepth8:
5770         ColorType := PNG_COLOR_TYPE_GRAY;
5771       ifLuminanceAlpha:
5772         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5773       ifBGR8, ifRGB8:
5774         ColorType := PNG_COLOR_TYPE_RGB;
5775       ifBGRA8, ifRGBA8:
5776         ColorType := PNG_COLOR_TYPE_RGBA;
5777       else
5778         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5779     end;
5780     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5781
5782     // creating array for scanline
5783     SetLength(png_rows, Height);
5784     try
5785       for Row := 0 to Height - 1 do begin
5786         png_rows[Row] := Data;
5787         Inc(png_rows[Row], Row * LineSize)
5788       end;
5789
5790       // write struct
5791       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5792       if png = nil then
5793         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5794
5795       // create png info
5796       png_info := png_create_info_struct(png);
5797       if png_info = nil then begin
5798         png_destroy_write_struct(@png, nil);
5799         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5800       end;
5801
5802       // set read callback
5803       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5804
5805       // set compression
5806       png_set_compression_level(png, 6);
5807
5808       if InternalFormat in [ifBGR8, ifBGRA8] then
5809         png_set_bgr(png);
5810
5811       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5812       png_write_info(png, png_info);
5813       png_write_image(png, @png_rows[0]);
5814       png_write_end(png, png_info);
5815       png_destroy_write_struct(@png, @png_info);
5816     finally
5817       SetLength(png_rows, 0);
5818     end;
5819   finally
5820     quit_libPNG;
5821   end;
5822 end;
5823
5824 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5826 procedure TglBitmap.SavePNG(const aStream: TStream);
5827 var
5828   Png: TPNGObject;
5829
5830   pSource, pDest: pByte;
5831   X, Y, PixSize: Integer;
5832   ColorType: Cardinal;
5833   Alpha: Boolean;
5834
5835   pTemp: pByte;
5836   Temp: Byte;
5837 begin
5838   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5839     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5840
5841   case FInternalFormat of
5842     ifAlpha, ifLuminance, ifDepth8: begin
5843       ColorType := COLOR_GRAYSCALE;
5844       PixSize := 1;
5845       Alpha := false;
5846     end;
5847     ifLuminanceAlpha: begin
5848       ColorType := COLOR_GRAYSCALEALPHA;
5849       PixSize := 1;
5850       Alpha := true;
5851     end;
5852     ifBGR8, ifRGB8: begin
5853       ColorType := COLOR_RGB;
5854       PixSize := 3;
5855       Alpha := false;
5856     end;
5857     ifBGRA8, ifRGBA8: begin
5858       ColorType := COLOR_RGBALPHA;
5859       PixSize := 3;
5860       Alpha := true
5861     end;
5862   else
5863     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5864   end;
5865
5866   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5867   try
5868     // Copy ImageData
5869     pSource := Data;
5870     for Y := 0 to Height -1 do begin
5871       pDest := png.ScanLine[Y];
5872       for X := 0 to Width -1 do begin
5873         Move(pSource^, pDest^, PixSize);
5874         Inc(pDest, PixSize);
5875         Inc(pSource, PixSize);
5876         if Alpha then begin
5877           png.AlphaScanline[Y]^[X] := pSource^;
5878           Inc(pSource);
5879         end;
5880       end;
5881
5882       // convert RGB line to BGR
5883       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5884         pTemp := png.ScanLine[Y];
5885         for X := 0 to Width -1 do begin
5886           Temp := pByteArray(pTemp)^[0];
5887           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5888           pByteArray(pTemp)^[2] := Temp;
5889           Inc(pTemp, 3);
5890         end;
5891       end;
5892     end;
5893
5894     // Save to Stream
5895     Png.CompressionLevel := 6;
5896     Png.SaveToStream(Stream);
5897   finally
5898     FreeAndNil(Png);
5899   end;
5900 end;
5901 {$IFEND}
5902 {$ENDIF}
5903
5904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5905 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5907 {$IFDEF GLB_LIB_JPEG}
5908 type
5909   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5910   glBitmap_libJPEG_source_mgr = record
5911     pub: jpeg_source_mgr;
5912
5913     SrcStream: TStream;
5914     SrcBuffer: array [1..4096] of byte;
5915   end;
5916
5917   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5918   glBitmap_libJPEG_dest_mgr = record
5919     pub: jpeg_destination_mgr;
5920
5921     DestStream: TStream;
5922     DestBuffer: array [1..4096] of byte;
5923   end;
5924
5925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5926 {
5927 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5928 var
5929   Msg: String;
5930 begin
5931   SetLength(Msg, 256);
5932   cinfo^.err^.format_message(cinfo, pChar(Msg));
5933   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5934   cinfo^.global_state := 0;
5935   jpeg_abort(cinfo);
5936 end;
5937 }
5938
5939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5940 {
5941 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5942 var
5943   Msg: String;
5944 begin
5945   SetLength(Msg, 256);
5946   cinfo^.err^.format_message(cinfo, pChar(Msg));
5947   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
5948   cinfo^.global_state := 0;
5949 end;
5950 }
5951
5952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5953 {
5954 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5955 begin
5956 end;
5957 }
5958
5959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5960 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5961 var
5962   src: glBitmap_libJPEG_source_mgr_ptr;
5963   bytes: integer;
5964 begin
5965   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5966
5967   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5968         if (bytes <= 0) then begin
5969                 src^.SrcBuffer[1] := $FF;
5970                 src^.SrcBuffer[2] := JPEG_EOI;
5971                 bytes := 2;
5972         end;
5973
5974         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5975         src^.pub.bytes_in_buffer := bytes;
5976
5977   result := true;
5978 end;
5979
5980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5981 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5982 var
5983   src: glBitmap_libJPEG_source_mgr_ptr;
5984 begin
5985   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5986
5987   if num_bytes > 0 then begin
5988     // wanted byte isn't in buffer so set stream position and read buffer
5989     if num_bytes > src^.pub.bytes_in_buffer then begin
5990       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5991       src^.pub.fill_input_buffer(cinfo);
5992     end else begin
5993       // wanted byte is in buffer so only skip
5994                 inc(src^.pub.next_input_byte, num_bytes);
5995                 dec(src^.pub.bytes_in_buffer, num_bytes);
5996     end;
5997   end;
5998 end;
5999
6000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6001 {
6002 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6003 begin
6004 end;
6005 }
6006
6007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6008 {
6009 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6010 begin
6011 end;
6012 }
6013
6014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6015 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6016 var
6017   dest: glBitmap_libJPEG_dest_mgr_ptr;
6018 begin
6019   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6020
6021   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6022     // write complete buffer
6023     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6024
6025     // reset buffer
6026     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6027     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6028   end;
6029
6030   result := true;
6031 end;
6032
6033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6034 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6035 var
6036   Idx: Integer;
6037   dest: glBitmap_libJPEG_dest_mgr_ptr;
6038 begin
6039   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6040
6041   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6042     // check for endblock
6043     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6044       // write endblock
6045       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6046
6047       // leave
6048       break;
6049     end else
6050       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6051   end;
6052 end;
6053 {$ENDIF}
6054
6055 {$IFDEF GLB_SUPPORT_JPEG_READ}
6056 {$IF DEFINED(GLB_SDL_IMAGE)}
6057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6058 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6059 var
6060   Surface: PSDL_Surface;
6061   RWops: PSDL_RWops;
6062 begin
6063   result := false;
6064
6065   RWops := glBitmapCreateRWops(Stream);
6066   try
6067     if IMG_isJPG(RWops) > 0 then begin
6068       Surface := IMG_LoadJPG_RW(RWops);
6069       try
6070         AssignFromSurface(Surface);
6071         result := true;
6072       finally
6073         SDL_FreeSurface(Surface);
6074       end;
6075     end;
6076   finally
6077     SDL_FreeRW(RWops);
6078   end;
6079 end;
6080
6081 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6083 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6084 var
6085   StreamPos: Int64;
6086   Temp: array[0..1]of Byte;
6087
6088   jpeg: jpeg_decompress_struct;
6089   jpeg_err: jpeg_error_mgr;
6090
6091   IntFormat: TglBitmapInternalFormat;
6092   pImage: pByte;
6093   TempHeight, TempWidth: Integer;
6094
6095   pTemp: pByte;
6096   Row: Integer;
6097 begin
6098   result := false;
6099
6100   if not init_libJPEG then
6101     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6102
6103   try
6104     // reading first two bytes to test file and set cursor back to begin
6105     StreamPos := Stream.Position;
6106     Stream.Read(Temp[0], 2);
6107     Stream.Position := StreamPos;
6108
6109     // if Bitmap then read file.
6110     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6111       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
6112       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6113
6114       // error managment
6115       jpeg.err := jpeg_std_error(@jpeg_err);
6116       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6117       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6118
6119       // decompression struct
6120       jpeg_create_decompress(@jpeg);
6121
6122       // allocation space for streaming methods
6123       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6124
6125       // seeting up custom functions
6126       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6127         pub.init_source       := glBitmap_libJPEG_init_source;
6128         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6129         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6130         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6131         pub.term_source       := glBitmap_libJPEG_term_source;
6132
6133         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6134         pub.next_input_byte := nil;   // until buffer loaded
6135
6136         SrcStream := Stream;
6137       end;
6138
6139       // set global decoding state
6140       jpeg.global_state := DSTATE_START;
6141
6142       // read header of jpeg
6143       jpeg_read_header(@jpeg, false);
6144
6145       // setting output parameter
6146       case jpeg.jpeg_color_space of
6147         JCS_GRAYSCALE:
6148           begin
6149             jpeg.out_color_space := JCS_GRAYSCALE;
6150             IntFormat := ifLuminance;
6151           end;
6152         else
6153           jpeg.out_color_space := JCS_RGB;
6154           IntFormat := ifRGB8;
6155       end;
6156
6157       // reading image
6158       jpeg_start_decompress(@jpeg);
6159
6160       TempHeight := jpeg.output_height;
6161       TempWidth := jpeg.output_width;
6162
6163       // creating new image
6164       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6165       try
6166         pTemp := pImage;
6167
6168         for Row := 0 to TempHeight -1 do begin
6169           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6170           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
6171         end;
6172
6173         // finish decompression
6174         jpeg_finish_decompress(@jpeg);
6175
6176         // destroy decompression
6177         jpeg_destroy_decompress(@jpeg);
6178
6179         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6180
6181         result := true;
6182       except
6183         FreeMem(pImage);
6184         raise;
6185       end;
6186     end;
6187   finally
6188     quit_libJPEG;
6189   end;
6190 end;
6191
6192 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6194 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6195 var
6196   bmp: TBitmap;
6197   jpg: TJPEGImage;
6198   StreamPos: Int64;
6199   Temp: array[0..1]of Byte;
6200 begin
6201   result := false;
6202
6203   // reading first two bytes to test file and set cursor back to begin
6204   StreamPos := Stream.Position;
6205   Stream.Read(Temp[0], 2);
6206   Stream.Position := StreamPos;
6207
6208   // if Bitmap then read file.
6209   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6210     bmp := TBitmap.Create;
6211     try
6212       jpg := TJPEGImage.Create;
6213       try
6214         jpg.LoadFromStream(Stream);
6215         bmp.Assign(jpg);
6216         result := AssignFromBitmap(bmp);
6217       finally
6218         jpg.Free;
6219       end;
6220     finally
6221       bmp.Free;
6222     end;
6223   end;
6224 end;
6225 {$IFEND}
6226 {$ENDIF}
6227
6228 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6229 {$IF DEFEFINED(GLB_LIB_JPEG)}
6230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6231 procedure TglBitmap.SaveJPEG(Stream: TStream);
6232 var
6233   jpeg: jpeg_compress_struct;
6234   jpeg_err: jpeg_error_mgr;
6235   Row: Integer;
6236   pTemp, pTemp2: pByte;
6237
6238   procedure CopyRow(pDest, pSource: pByte);
6239   var
6240     X: Integer;
6241   begin
6242     for X := 0 to Width - 1 do begin
6243       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6244       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6245       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6246       Inc(pDest, 3);
6247       Inc(pSource, 3);
6248     end;
6249   end;
6250
6251 begin
6252   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6253     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6254
6255   if not init_libJPEG then
6256     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6257
6258   try
6259     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
6260     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6261
6262     // error managment
6263     jpeg.err := jpeg_std_error(@jpeg_err);
6264     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6265     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6266
6267     // compression struct
6268     jpeg_create_compress(@jpeg);
6269
6270     // allocation space for streaming methods
6271     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6272
6273     // seeting up custom functions
6274     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6275       pub.init_destination    := glBitmap_libJPEG_init_destination;
6276       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6277       pub.term_destination    := glBitmap_libJPEG_term_destination;
6278
6279       pub.next_output_byte  := @DestBuffer[1];
6280       pub.free_in_buffer    := Length(DestBuffer);
6281
6282       DestStream := Stream;
6283     end;
6284
6285     // very important state
6286     jpeg.global_state := CSTATE_START;
6287     jpeg.image_width  := Width;
6288     jpeg.image_height := Height;
6289     case InternalFormat of
6290       ifAlpha, ifLuminance, ifDepth8: begin
6291         jpeg.input_components := 1;
6292         jpeg.in_color_space := JCS_GRAYSCALE;
6293       end;
6294       ifRGB8, ifBGR8: begin
6295         jpeg.input_components := 3;
6296         jpeg.in_color_space := JCS_RGB;
6297       end;
6298     end;
6299
6300     jpeg_set_defaults(@jpeg);
6301     jpeg_set_quality(@jpeg, 95, true);
6302     jpeg_start_compress(@jpeg, true);
6303     pTemp := Data;
6304
6305     if InternalFormat = ifBGR8 then
6306       GetMem(pTemp2, fRowSize)
6307     else
6308       pTemp2 := pTemp;
6309
6310     try
6311       for Row := 0 to jpeg.image_height -1 do begin
6312         // prepare row
6313         if InternalFormat = ifBGR8 then
6314           CopyRow(pTemp2, pTemp)
6315         else
6316           pTemp2 := pTemp;
6317
6318         // write row
6319         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6320         inc(pTemp, fRowSize);
6321       end;
6322     finally
6323       // free memory
6324       if InternalFormat = ifBGR8 then
6325         FreeMem(pTemp2);
6326     end;
6327     jpeg_finish_compress(@jpeg);
6328     jpeg_destroy_compress(@jpeg);
6329   finally
6330     quit_libJPEG;
6331   end;
6332 end;
6333
6334 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6336 procedure TglBitmap.SaveJPEG(Stream: TStream);
6337 var
6338   Bmp: TBitmap;
6339   Jpg: TJPEGImage;
6340 begin
6341   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6342     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6343
6344   Bmp := TBitmap.Create;
6345   try
6346     Jpg := TJPEGImage.Create;
6347     try
6348       AssignToBitmap(Bmp);
6349       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6350         Jpg.Grayscale := true;
6351         Jpg.PixelFormat := jf8Bit;
6352       end;
6353       Jpg.Assign(Bmp);
6354       Jpg.SaveToStream(Stream);
6355     finally
6356       FreeAndNil(Jpg);
6357     end;
6358   finally
6359     FreeAndNil(Bmp);
6360   end;
6361 end;
6362 {$ENDIF}
6363 {$ENDIF}
6364
6365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6366 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6368 const
6369   BMP_MAGIC          = $4D42;
6370
6371   BMP_COMP_RGB       = 0;
6372   BMP_COMP_RLE8      = 1;
6373   BMP_COMP_RLE4      = 2;
6374   BMP_COMP_BITFIELDS = 3;
6375
6376 type
6377   TBMPHeader = packed record
6378     bfType: Word;
6379     bfSize: Cardinal;
6380     bfReserved1: Word;
6381     bfReserved2: Word;
6382     bfOffBits: Cardinal;
6383   end;
6384
6385   TBMPInfo = packed record
6386     biSize: Cardinal;
6387     biWidth: Longint;
6388     biHeight: Longint;
6389     biPlanes: Word;
6390     biBitCount: Word;
6391     biCompression: Cardinal;
6392     biSizeImage: Cardinal;
6393     biXPelsPerMeter: Longint;
6394     biYPelsPerMeter: Longint;
6395     biClrUsed: Cardinal;
6396     biClrImportant: Cardinal;
6397   end;
6398
6399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6400 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6401
6402   //////////////////////////////////////////////////////////////////////////////////////////////////
6403   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6404   begin
6405     result := tfEmpty;
6406     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6407     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6408
6409     //Read Compression
6410     case aInfo.biCompression of
6411       BMP_COMP_RLE4,
6412       BMP_COMP_RLE8: begin
6413         raise EglBitmapException.Create('RLE compression is not supported');
6414       end;
6415       BMP_COMP_BITFIELDS: begin
6416         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6417           aStream.Read(aMask.r, SizeOf(aMask.r));
6418           aStream.Read(aMask.g, SizeOf(aMask.g));
6419           aStream.Read(aMask.b, SizeOf(aMask.b));
6420           aStream.Read(aMask.a, SizeOf(aMask.a));
6421         end else
6422           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6423       end;
6424     end;
6425
6426     //get suitable format
6427     case aInfo.biBitCount of
6428        8: result := tfLuminance8;
6429       16: result := tfBGR5;
6430       24: result := tfBGR8;
6431       32: result := tfBGRA8;
6432     end;
6433   end;
6434
6435   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6436   var
6437     i, c: Integer;
6438     ColorTable: TbmpColorTable;
6439   begin
6440     result := nil;
6441     if (aInfo.biBitCount >= 16) then
6442       exit;
6443     aFormat := tfLuminance8;
6444     c := aInfo.biClrUsed;
6445     if (c = 0) then
6446       c := 1 shl aInfo.biBitCount;
6447     SetLength(ColorTable, c);
6448     for i := 0 to c-1 do begin
6449       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6450       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6451         aFormat := tfRGB8;
6452     end;
6453
6454     result := TbmpColorTableFormat.Create;
6455     result.PixelSize  := aInfo.biBitCount / 8;
6456     result.ColorTable := ColorTable;
6457     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6458   end;
6459
6460   //////////////////////////////////////////////////////////////////////////////////////////////////
6461   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6462     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6463   var
6464     TmpFormat: TglBitmapFormat;
6465     FormatDesc: TFormatDescriptor;
6466   begin
6467     result := nil;
6468     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6469       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6470         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6471         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6472           aFormat := FormatDesc.Format;
6473           exit;
6474         end;
6475       end;
6476
6477       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6478         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6479       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6480         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6481
6482       result := TbmpBitfieldFormat.Create;
6483       result.PixelSize := aInfo.biBitCount / 8;
6484       result.RedMask   := aMask.r;
6485       result.GreenMask := aMask.g;
6486       result.BlueMask  := aMask.b;
6487       result.AlphaMask := aMask.a;
6488     end;
6489   end;
6490
6491 var
6492   //simple types
6493   StartPos: Int64;
6494   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6495   PaddingBuff: Cardinal;
6496   LineBuf, ImageData, TmpData: PByte;
6497   SourceMD, DestMD: Pointer;
6498   BmpFormat: TglBitmapFormat;
6499
6500   //records
6501   Mask: TglBitmapColorRec;
6502   Header: TBMPHeader;
6503   Info: TBMPInfo;
6504
6505   //classes
6506   SpecialFormat: TFormatDescriptor;
6507   FormatDesc: TFormatDescriptor;
6508
6509   //////////////////////////////////////////////////////////////////////////////////////////////////
6510   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6511   var
6512     i: Integer;
6513     Pixel: TglBitmapPixelData;
6514   begin
6515     aStream.Read(aLineBuf^, rbLineSize);
6516     SpecialFormat.PreparePixel(Pixel);
6517     for i := 0 to Info.biWidth-1 do begin
6518       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6519       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6520       FormatDesc.Map(Pixel, aData, DestMD);
6521     end;
6522   end;
6523
6524 begin
6525   result        := false;
6526   BmpFormat     := tfEmpty;
6527   SpecialFormat := nil;
6528   LineBuf       := nil;
6529   SourceMD      := nil;
6530   DestMD        := nil;
6531
6532   // Header
6533   StartPos := aStream.Position;
6534   aStream.Read(Header{%H-}, SizeOf(Header));
6535
6536   if Header.bfType = BMP_MAGIC then begin
6537     try try
6538       BmpFormat        := ReadInfo(Info, Mask);
6539       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6540       if not Assigned(SpecialFormat) then
6541         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6542       aStream.Position := StartPos + Header.bfOffBits;
6543
6544       if (BmpFormat <> tfEmpty) then begin
6545         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6546         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6547         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6548         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6549
6550         //get Memory
6551         DestMD    := FormatDesc.CreateMappingData;
6552         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6553         GetMem(ImageData, ImageSize);
6554         if Assigned(SpecialFormat) then begin
6555           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6556           SourceMD := SpecialFormat.CreateMappingData;
6557         end;
6558
6559         //read Data
6560         try try
6561           FillChar(ImageData^, ImageSize, $FF);
6562           TmpData := ImageData;
6563           if (Info.biHeight > 0) then
6564             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6565           for i := 0 to Abs(Info.biHeight)-1 do begin
6566             if Assigned(SpecialFormat) then
6567               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6568             else
6569               aStream.Read(TmpData^, wbLineSize);   //else only read data
6570             if (Info.biHeight > 0) then
6571               dec(TmpData, wbLineSize)
6572             else
6573               inc(TmpData, wbLineSize);
6574             aStream.Read(PaddingBuff{%H-}, Padding);
6575           end;
6576           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6577           result := true;
6578         finally
6579           if Assigned(LineBuf) then
6580             FreeMem(LineBuf);
6581           if Assigned(SourceMD) then
6582             SpecialFormat.FreeMappingData(SourceMD);
6583           FormatDesc.FreeMappingData(DestMD);
6584         end;
6585         except
6586           FreeMem(ImageData);
6587           raise;
6588         end;
6589       end else
6590         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6591     except
6592       aStream.Position := StartPos;
6593       raise;
6594     end;
6595     finally
6596       FreeAndNil(SpecialFormat);
6597     end;
6598   end
6599     else aStream.Position := StartPos;
6600 end;
6601
6602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6603 procedure TglBitmap.SaveBMP(const aStream: TStream);
6604 var
6605   Header: TBMPHeader;
6606   Info: TBMPInfo;
6607   Converter: TbmpColorTableFormat;
6608   FormatDesc: TFormatDescriptor;
6609   SourceFD, DestFD: Pointer;
6610   pData, srcData, dstData, ConvertBuffer: pByte;
6611
6612   Pixel: TglBitmapPixelData;
6613   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6614   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6615
6616   PaddingBuff: Cardinal;
6617
6618   function GetLineWidth : Integer;
6619   begin
6620     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6621   end;
6622
6623 begin
6624   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6625     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6626
6627   Converter  := nil;
6628   FormatDesc := TFormatDescriptor.Get(Format);
6629   ImageSize  := FormatDesc.GetSize(Dimension);
6630
6631   FillChar(Header{%H-}, SizeOf(Header), 0);
6632   Header.bfType      := BMP_MAGIC;
6633   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6634   Header.bfReserved1 := 0;
6635   Header.bfReserved2 := 0;
6636   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6637
6638   FillChar(Info{%H-}, SizeOf(Info), 0);
6639   Info.biSize        := SizeOf(Info);
6640   Info.biWidth       := Width;
6641   Info.biHeight      := Height;
6642   Info.biPlanes      := 1;
6643   Info.biCompression := BMP_COMP_RGB;
6644   Info.biSizeImage   := ImageSize;
6645
6646   try
6647     case Format of
6648       tfLuminance4: begin
6649         Info.biBitCount  := 4;
6650         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6651         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6652         Converter           := TbmpColorTableFormat.Create;
6653         Converter.PixelSize := 0.5;
6654         Converter.Format    := Format;
6655         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6656         Converter.CreateColorTable;
6657       end;
6658
6659       tfR3G3B2, tfLuminance8: begin
6660         Info.biBitCount  :=  8;
6661         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6662         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6663         Converter           := TbmpColorTableFormat.Create;
6664         Converter.PixelSize := 1;
6665         Converter.Format    := Format;
6666         if (Format = tfR3G3B2) then begin
6667           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6668           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6669         end else
6670           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6671         Converter.CreateColorTable;
6672       end;
6673
6674       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6675       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6676         Info.biBitCount    := 16;
6677         Info.biCompression := BMP_COMP_BITFIELDS;
6678       end;
6679
6680       tfBGR8, tfRGB8: begin
6681         Info.biBitCount := 24;
6682       end;
6683
6684       tfRGB10, tfRGB10A2, tfRGBA8,
6685       tfBGR10, tfBGR10A2, tfBGRA8: begin
6686         Info.biBitCount    := 32;
6687         Info.biCompression := BMP_COMP_BITFIELDS;
6688       end;
6689     else
6690       raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6691     end;
6692     Info.biXPelsPerMeter := 2835;
6693     Info.biYPelsPerMeter := 2835;
6694
6695     // prepare bitmasks
6696     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6697       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6698       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6699
6700       RedMask    := FormatDesc.RedMask;
6701       GreenMask  := FormatDesc.GreenMask;
6702       BlueMask   := FormatDesc.BlueMask;
6703       AlphaMask  := FormatDesc.AlphaMask;
6704     end;
6705
6706     // headers
6707     aStream.Write(Header, SizeOf(Header));
6708     aStream.Write(Info, SizeOf(Info));
6709
6710     // colortable
6711     if Assigned(Converter) then
6712       aStream.Write(Converter.ColorTable[0].b,
6713         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6714
6715     // bitmasks
6716     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6717       aStream.Write(RedMask,   SizeOf(Cardinal));
6718       aStream.Write(GreenMask, SizeOf(Cardinal));
6719       aStream.Write(BlueMask,  SizeOf(Cardinal));
6720       aStream.Write(AlphaMask, SizeOf(Cardinal));
6721     end;
6722
6723     // image data
6724     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6725     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6726     Padding     := GetLineWidth - wbLineSize;
6727     PaddingBuff := 0;
6728
6729     pData := Data;
6730     inc(pData, (Height-1) * rbLineSize);
6731
6732     // prepare row buffer. But only for RGB because RGBA supports color masks
6733     // so it's possible to change color within the image.
6734     if Assigned(Converter) then begin
6735       FormatDesc.PreparePixel(Pixel);
6736       GetMem(ConvertBuffer, wbLineSize);
6737       SourceFD := FormatDesc.CreateMappingData;
6738       DestFD   := Converter.CreateMappingData;
6739     end else
6740       ConvertBuffer := nil;
6741
6742     try
6743       for LineIdx := 0 to Height - 1 do begin
6744         // preparing row
6745         if Assigned(Converter) then begin
6746           srcData := pData;
6747           dstData := ConvertBuffer;
6748           for PixelIdx := 0 to Info.biWidth-1 do begin
6749             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6750             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6751             Converter.Map(Pixel, dstData, DestFD);
6752           end;
6753           aStream.Write(ConvertBuffer^, wbLineSize);
6754         end else begin
6755           aStream.Write(pData^, rbLineSize);
6756         end;
6757         dec(pData, rbLineSize);
6758         if (Padding > 0) then
6759           aStream.Write(PaddingBuff, Padding);
6760       end;
6761     finally
6762       // destroy row buffer
6763       if Assigned(ConvertBuffer) then begin
6764         FormatDesc.FreeMappingData(SourceFD);
6765         Converter.FreeMappingData(DestFD);
6766         FreeMem(ConvertBuffer);
6767       end;
6768     end;
6769   finally
6770     if Assigned(Converter) then
6771       Converter.Free;
6772   end;
6773 end;
6774
6775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6776 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6778 type
6779   TTGAHeader = packed record
6780     ImageID: Byte;
6781     ColorMapType: Byte;
6782     ImageType: Byte;
6783     //ColorMapSpec: Array[0..4] of Byte;
6784     ColorMapStart: Word;
6785     ColorMapLength: Word;
6786     ColorMapEntrySize: Byte;
6787     OrigX: Word;
6788     OrigY: Word;
6789     Width: Word;
6790     Height: Word;
6791     Bpp: Byte;
6792     ImageDesc: Byte;
6793   end;
6794
6795 const
6796   TGA_UNCOMPRESSED_RGB  =  2;
6797   TGA_UNCOMPRESSED_GRAY =  3;
6798   TGA_COMPRESSED_RGB    = 10;
6799   TGA_COMPRESSED_GRAY   = 11;
6800
6801   TGA_NONE_COLOR_TABLE  = 0;
6802
6803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6804 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6805 var
6806   Header: TTGAHeader;
6807   ImageData: PByte;
6808   StartPosition: Int64;
6809   PixelSize, LineSize: Integer;
6810   tgaFormat: TglBitmapFormat;
6811   FormatDesc: TFormatDescriptor;
6812   Counter: packed record
6813     X, Y: packed record
6814       low, high, dir: Integer;
6815     end;
6816   end;
6817
6818 const
6819   CACHE_SIZE = $4000;
6820
6821   ////////////////////////////////////////////////////////////////////////////////////////
6822   procedure ReadUncompressed;
6823   var
6824     i, j: Integer;
6825     buf, tmp1, tmp2: PByte;
6826   begin
6827     buf := nil;
6828     if (Counter.X.dir < 0) then
6829       buf := GetMem(LineSize);
6830     try
6831       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6832         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6833         if (Counter.X.dir < 0) then begin               //flip X
6834           aStream.Read(buf^, LineSize);
6835           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6836           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6837             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6838               tmp1^ := tmp2^;
6839               inc(tmp1);
6840               inc(tmp2);
6841             end;
6842             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6843           end;
6844         end else
6845           aStream.Read(tmp1^, LineSize);
6846         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6847       end;
6848     finally
6849       if Assigned(buf) then
6850         FreeMem(buf);
6851     end;
6852   end;
6853
6854   ////////////////////////////////////////////////////////////////////////////////////////
6855   procedure ReadCompressed;
6856
6857     /////////////////////////////////////////////////////////////////
6858     var
6859       TmpData: PByte;
6860       LinePixelsRead: Integer;
6861     procedure CheckLine;
6862     begin
6863       if (LinePixelsRead >= Header.Width) then begin
6864         LinePixelsRead := 0;
6865         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6866         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6867         if (Counter.X.dir < 0) then                       //if x flipped then
6868           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6869       end;
6870     end;
6871
6872     /////////////////////////////////////////////////////////////////
6873     var
6874       Cache: PByte;
6875       CacheSize, CachePos: Integer;
6876     procedure CachedRead(out Buffer; Count: Integer);
6877     var
6878       BytesRead: Integer;
6879     begin
6880       if (CachePos + Count > CacheSize) then begin
6881         //if buffer overflow save non read bytes
6882         BytesRead := 0;
6883         if (CacheSize - CachePos > 0) then begin
6884           BytesRead := CacheSize - CachePos;
6885           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6886           inc(CachePos, BytesRead);
6887         end;
6888
6889         //load cache from file
6890         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6891         aStream.Read(Cache^, CacheSize);
6892         CachePos := 0;
6893
6894         //read rest of requested bytes
6895         if (Count - BytesRead > 0) then begin
6896           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6897           inc(CachePos, Count - BytesRead);
6898         end;
6899       end else begin
6900         //if no buffer overflow just read the data
6901         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6902         inc(CachePos, Count);
6903       end;
6904     end;
6905
6906     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6907     begin
6908       case PixelSize of
6909         1: begin
6910           aBuffer^ := aData^;
6911           inc(aBuffer, Counter.X.dir);
6912         end;
6913         2: begin
6914           PWord(aBuffer)^ := PWord(aData)^;
6915           inc(aBuffer, 2 * Counter.X.dir);
6916         end;
6917         3: begin
6918           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6919           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6920           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6921           inc(aBuffer, 3 * Counter.X.dir);
6922         end;
6923         4: begin
6924           PCardinal(aBuffer)^ := PCardinal(aData)^;
6925           inc(aBuffer, 4 * Counter.X.dir);
6926         end;
6927       end;
6928     end;
6929
6930   var
6931     TotalPixelsToRead, TotalPixelsRead: Integer;
6932     Temp: Byte;
6933     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6934     PixelRepeat: Boolean;
6935     PixelsToRead, PixelCount: Integer;
6936   begin
6937     CacheSize := 0;
6938     CachePos  := 0;
6939
6940     TotalPixelsToRead := Header.Width * Header.Height;
6941     TotalPixelsRead   := 0;
6942     LinePixelsRead    := 0;
6943
6944     GetMem(Cache, CACHE_SIZE);
6945     try
6946       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6947       if (Counter.X.dir < 0) then                       //if x flipped then
6948         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6949
6950       repeat
6951         //read CommandByte
6952         CachedRead(Temp, 1);
6953         PixelRepeat  := (Temp and $80) > 0;
6954         PixelsToRead := (Temp and $7F) + 1;
6955         inc(TotalPixelsRead, PixelsToRead);
6956
6957         if PixelRepeat then
6958           CachedRead(buf[0], PixelSize);
6959         while (PixelsToRead > 0) do begin
6960           CheckLine;
6961           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6962           while (PixelCount > 0) do begin
6963             if not PixelRepeat then
6964               CachedRead(buf[0], PixelSize);
6965             PixelToBuffer(@buf[0], TmpData);
6966             inc(LinePixelsRead);
6967             dec(PixelsToRead);
6968             dec(PixelCount);
6969           end;
6970         end;
6971       until (TotalPixelsRead >= TotalPixelsToRead);
6972     finally
6973       FreeMem(Cache);
6974     end;
6975   end;
6976
6977   function IsGrayFormat: Boolean;
6978   begin
6979     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6980   end;
6981
6982 begin
6983   result := false;
6984
6985   // reading header to test file and set cursor back to begin
6986   StartPosition := aStream.Position;
6987   aStream.Read(Header{%H-}, SizeOf(Header));
6988
6989   // no colormapped files
6990   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6991     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6992   begin
6993     try
6994       if Header.ImageID <> 0 then       // skip image ID
6995         aStream.Position := aStream.Position + Header.ImageID;
6996
6997       case Header.Bpp of
6998          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6999                0: tgaFormat := tfLuminance8;
7000                8: tgaFormat := tfAlpha8;
7001             end;
7002
7003         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7004                0: tgaFormat := tfLuminance16;
7005                8: tgaFormat := tfLuminance8Alpha8;
7006             end else case (Header.ImageDesc and $F) of
7007                0: tgaFormat := tfBGR5;
7008                1: tgaFormat := tfBGR5A1;
7009                4: tgaFormat := tfBGRA4;
7010             end;
7011
7012         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7013                0: tgaFormat := tfBGR8;
7014             end;
7015
7016         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7017                2: tgaFormat := tfBGR10A2;
7018                8: tgaFormat := tfBGRA8;
7019             end;
7020       end;
7021
7022       if (tgaFormat = tfEmpty) then
7023         raise EglBitmapException.Create('LoadTga - unsupported format');
7024
7025       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7026       PixelSize  := FormatDesc.GetSize(1, 1);
7027       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7028
7029       GetMem(ImageData, LineSize * Header.Height);
7030       try
7031         //column direction
7032         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7033           Counter.X.low  := Header.Height-1;;
7034           Counter.X.high := 0;
7035           Counter.X.dir  := -1;
7036         end else begin
7037           Counter.X.low  := 0;
7038           Counter.X.high := Header.Height-1;
7039           Counter.X.dir  := 1;
7040         end;
7041
7042         // Row direction
7043         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7044           Counter.Y.low  := 0;
7045           Counter.Y.high := Header.Height-1;
7046           Counter.Y.dir  := 1;
7047         end else begin
7048           Counter.Y.low  := Header.Height-1;;
7049           Counter.Y.high := 0;
7050           Counter.Y.dir  := -1;
7051         end;
7052
7053         // Read Image
7054         case Header.ImageType of
7055           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7056             ReadUncompressed;
7057           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7058             ReadCompressed;
7059         end;
7060
7061         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7062         result := true;
7063       except
7064         FreeMem(ImageData);
7065         raise;
7066       end;
7067     finally
7068       aStream.Position := StartPosition;
7069     end;
7070   end
7071     else aStream.Position := StartPosition;
7072 end;
7073
7074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7075 procedure TglBitmap.SaveTGA(const aStream: TStream);
7076 var
7077   Header: TTGAHeader;
7078   LineSize, Size, x, y: Integer;
7079   Pixel: TglBitmapPixelData;
7080   LineBuf, SourceData, DestData: PByte;
7081   SourceMD, DestMD: Pointer;
7082   FormatDesc: TFormatDescriptor;
7083   Converter: TFormatDescriptor;
7084 begin
7085   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7086     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
7087
7088   //prepare header
7089   FillChar(Header{%H-}, SizeOf(Header), 0);
7090
7091   //set ImageType
7092   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7093                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7094     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7095   else
7096     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7097
7098   //set BitsPerPixel
7099   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7100     Header.Bpp := 8
7101   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7102                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7103     Header.Bpp := 16
7104   else if (Format in [tfBGR8, tfRGB8]) then
7105     Header.Bpp := 24
7106   else
7107     Header.Bpp := 32;
7108
7109   //set AlphaBitCount
7110   case Format of
7111     tfRGB5A1, tfBGR5A1:
7112       Header.ImageDesc := 1 and $F;
7113     tfRGB10A2, tfBGR10A2:
7114       Header.ImageDesc := 2 and $F;
7115     tfRGBA4, tfBGRA4:
7116       Header.ImageDesc := 4 and $F;
7117     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7118       Header.ImageDesc := 8 and $F;
7119   end;
7120
7121   Header.Width     := Width;
7122   Header.Height    := Height;
7123   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7124   aStream.Write(Header, SizeOf(Header));
7125
7126   // convert RGB(A) to BGR(A)
7127   Converter  := nil;
7128   FormatDesc := TFormatDescriptor.Get(Format);
7129   Size       := FormatDesc.GetSize(Dimension);
7130   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7131     if (FormatDesc.RGBInverted = tfEmpty) then
7132       raise EglBitmapException.Create('inverted RGB format is empty');
7133     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7134     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7135        (Converter.PixelSize <> FormatDesc.PixelSize) then
7136       raise EglBitmapException.Create('invalid inverted RGB format');
7137   end;
7138
7139   if Assigned(Converter) then begin
7140     LineSize := FormatDesc.GetSize(Width, 1);
7141     LineBuf  := GetMem(LineSize);
7142     SourceMD := FormatDesc.CreateMappingData;
7143     DestMD   := Converter.CreateMappingData;
7144     try
7145       SourceData := Data;
7146       for y := 0 to Height-1 do begin
7147         DestData := LineBuf;
7148         for x := 0 to Width-1 do begin
7149           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7150           Converter.Map(Pixel, DestData, DestMD);
7151         end;
7152         aStream.Write(LineBuf^, LineSize);
7153       end;
7154     finally
7155       FreeMem(LineBuf);
7156       FormatDesc.FreeMappingData(SourceMD);
7157       FormatDesc.FreeMappingData(DestMD);
7158     end;
7159   end else
7160     aStream.Write(Data^, Size);
7161 end;
7162
7163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7164 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7166 const
7167   DDS_MAGIC: Cardinal         = $20534444;
7168
7169   // DDS_header.dwFlags
7170   DDSD_CAPS                   = $00000001;
7171   DDSD_HEIGHT                 = $00000002;
7172   DDSD_WIDTH                  = $00000004;
7173   DDSD_PIXELFORMAT            = $00001000;
7174
7175   // DDS_header.sPixelFormat.dwFlags
7176   DDPF_ALPHAPIXELS            = $00000001;
7177   DDPF_ALPHA                  = $00000002;
7178   DDPF_FOURCC                 = $00000004;
7179   DDPF_RGB                    = $00000040;
7180   DDPF_LUMINANCE              = $00020000;
7181
7182   // DDS_header.sCaps.dwCaps1
7183   DDSCAPS_TEXTURE             = $00001000;
7184
7185   // DDS_header.sCaps.dwCaps2
7186   DDSCAPS2_CUBEMAP            = $00000200;
7187
7188   D3DFMT_DXT1                 = $31545844;
7189   D3DFMT_DXT3                 = $33545844;
7190   D3DFMT_DXT5                 = $35545844;
7191
7192 type
7193   TDDSPixelFormat = packed record
7194     dwSize: Cardinal;
7195     dwFlags: Cardinal;
7196     dwFourCC: Cardinal;
7197     dwRGBBitCount: Cardinal;
7198     dwRBitMask: Cardinal;
7199     dwGBitMask: Cardinal;
7200     dwBBitMask: Cardinal;
7201     dwABitMask: Cardinal;
7202   end;
7203
7204   TDDSCaps = packed record
7205     dwCaps1: Cardinal;
7206     dwCaps2: Cardinal;
7207     dwDDSX: Cardinal;
7208     dwReserved: Cardinal;
7209   end;
7210
7211   TDDSHeader = packed record
7212     dwSize: Cardinal;
7213     dwFlags: Cardinal;
7214     dwHeight: Cardinal;
7215     dwWidth: Cardinal;
7216     dwPitchOrLinearSize: Cardinal;
7217     dwDepth: Cardinal;
7218     dwMipMapCount: Cardinal;
7219     dwReserved: array[0..10] of Cardinal;
7220     PixelFormat: TDDSPixelFormat;
7221     Caps: TDDSCaps;
7222     dwReserved2: Cardinal;
7223   end;
7224
7225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7226 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7227 var
7228   Header: TDDSHeader;
7229   Converter: TbmpBitfieldFormat;
7230
7231   function GetDDSFormat: TglBitmapFormat;
7232   var
7233     fd: TFormatDescriptor;
7234     i: Integer;
7235     Range: TglBitmapColorRec;
7236     match: Boolean;
7237   begin
7238     result := tfEmpty;
7239     with Header.PixelFormat do begin
7240       // Compresses
7241       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7242         case Header.PixelFormat.dwFourCC of
7243           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7244           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7245           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7246         end;
7247       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7248
7249         //find matching format
7250         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7251           fd := TFormatDescriptor.Get(result);
7252           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7253              (8 * fd.PixelSize = dwRGBBitCount) then
7254             exit;
7255         end;
7256
7257         //find format with same Range
7258         Range.r := dwRBitMask;
7259         Range.g := dwGBitMask;
7260         Range.b := dwBBitMask;
7261         Range.a := dwABitMask;
7262         for i := 0 to 3 do begin
7263           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7264             Range.arr[i] := Range.arr[i] shr 1;
7265         end;
7266         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7267           fd := TFormatDescriptor.Get(result);
7268           match := true;
7269           for i := 0 to 3 do
7270             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7271               match := false;
7272               break;
7273             end;
7274           if match then
7275             break;
7276         end;
7277
7278         //no format with same range found -> use default
7279         if (result = tfEmpty) then begin
7280           if (dwABitMask > 0) then
7281             result := tfBGRA8
7282           else
7283             result := tfBGR8;
7284         end;
7285
7286         Converter := TbmpBitfieldFormat.Create;
7287         Converter.RedMask   := dwRBitMask;
7288         Converter.GreenMask := dwGBitMask;
7289         Converter.BlueMask  := dwBBitMask;
7290         Converter.AlphaMask := dwABitMask;
7291         Converter.PixelSize := dwRGBBitCount / 8;
7292       end;
7293     end;
7294   end;
7295
7296 var
7297   StreamPos: Int64;
7298   x, y, LineSize, RowSize, Magic: Cardinal;
7299   NewImage, TmpData, RowData, SrcData: PByte;
7300   SourceMD, DestMD: Pointer;
7301   Pixel: TglBitmapPixelData;
7302   ddsFormat: TglBitmapFormat;
7303   FormatDesc: TFormatDescriptor;
7304
7305 begin
7306   result    := false;
7307   Converter := nil;
7308   StreamPos := aStream.Position;
7309
7310   // Magic
7311   aStream.Read(Magic{%H-}, sizeof(Magic));
7312   if (Magic <> DDS_MAGIC) then begin
7313     aStream.Position := StreamPos;
7314     exit;
7315   end;
7316
7317   //Header
7318   aStream.Read(Header{%H-}, sizeof(Header));
7319   if (Header.dwSize <> SizeOf(Header)) or
7320      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7321         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7322   begin
7323     aStream.Position := StreamPos;
7324     exit;
7325   end;
7326
7327   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7328     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7329
7330   ddsFormat := GetDDSFormat;
7331   try
7332     if (ddsFormat = tfEmpty) then
7333       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7334
7335     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7336     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7337     GetMem(NewImage, Header.dwHeight * LineSize);
7338     try
7339       TmpData := NewImage;
7340
7341       //Converter needed
7342       if Assigned(Converter) then begin
7343         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7344         GetMem(RowData, RowSize);
7345         SourceMD := Converter.CreateMappingData;
7346         DestMD   := FormatDesc.CreateMappingData;
7347         try
7348           for y := 0 to Header.dwHeight-1 do begin
7349             TmpData := NewImage + y * LineSize;
7350             SrcData := RowData;
7351             aStream.Read(SrcData^, RowSize);
7352             for x := 0 to Header.dwWidth-1 do begin
7353               Converter.Unmap(SrcData, Pixel, SourceMD);
7354               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7355               FormatDesc.Map(Pixel, TmpData, DestMD);
7356             end;
7357           end;
7358         finally
7359           Converter.FreeMappingData(SourceMD);
7360           FormatDesc.FreeMappingData(DestMD);
7361           FreeMem(RowData);
7362         end;
7363       end else
7364
7365       // Compressed
7366       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7367         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7368         for Y := 0 to Header.dwHeight-1 do begin
7369           aStream.Read(TmpData^, RowSize);
7370           Inc(TmpData, LineSize);
7371         end;
7372       end else
7373
7374       // Uncompressed
7375       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7376         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7377         for Y := 0 to Header.dwHeight-1 do begin
7378           aStream.Read(TmpData^, RowSize);
7379           Inc(TmpData, LineSize);
7380         end;
7381       end else
7382         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7383
7384       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7385       result := true;
7386     except
7387       FreeMem(NewImage);
7388       raise;
7389     end;
7390   finally
7391     FreeAndNil(Converter);
7392   end;
7393 end;
7394
7395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7396 procedure TglBitmap.SaveDDS(const aStream: TStream);
7397 var
7398   Header: TDDSHeader;
7399   FormatDesc: TFormatDescriptor;
7400 begin
7401   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7402     raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
7403
7404   FormatDesc := TFormatDescriptor.Get(Format);
7405
7406   // Generell
7407   FillChar(Header{%H-}, SizeOf(Header), 0);
7408   Header.dwSize  := SizeOf(Header);
7409   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7410
7411   Header.dwWidth  := Max(1, Width);
7412   Header.dwHeight := Max(1, Height);
7413
7414   // Caps
7415   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7416
7417   // Pixelformat
7418   Header.PixelFormat.dwSize := sizeof(Header);
7419   if (FormatDesc.IsCompressed) then begin
7420     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7421     case Format of
7422       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7423       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7424       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7425     end;
7426   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7427     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7428     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7429     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7430   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7431     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7432     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7433     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7434     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7435   end else begin
7436     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7437     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7438     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7439     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7440     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7441     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7442   end;
7443
7444   if (FormatDesc.HasAlpha) then
7445     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7446
7447   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7448   aStream.Write(Header, SizeOf(Header));
7449   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7450 end;
7451
7452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7453 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7455 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7456 begin
7457   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7458     result := fLines[aIndex]
7459   else
7460     result := nil;
7461 end;
7462
7463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7464 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7465   const aWidth: Integer; const aHeight: Integer);
7466 var
7467   Idx, LineWidth: Integer;
7468 begin
7469   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7470
7471   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7472     (* TODO PixelFuncs
7473     fGetPixelFunc := GetPixel2DUnmap;
7474     fSetPixelFunc := SetPixel2DUnmap;
7475     *)
7476     // Assigning Data
7477     if Assigned(Data) then begin
7478       SetLength(fLines, GetHeight);
7479       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7480
7481       for Idx := 0 to GetHeight -1 do begin
7482         fLines[Idx] := Data;
7483         Inc(fLines[Idx], Idx * LineWidth);
7484       end;
7485     end
7486       else SetLength(fLines, 0);
7487   end else begin
7488     SetLength(fLines, 0);
7489     (*
7490     fSetPixelFunc := nil;
7491
7492     case Format of
7493       ifDXT1:
7494         fGetPixelFunc := GetPixel2DDXT1;
7495       ifDXT3:
7496         fGetPixelFunc := GetPixel2DDXT3;
7497       ifDXT5:
7498         fGetPixelFunc := GetPixel2DDXT5;
7499       else
7500         fGetPixelFunc := nil;
7501     end;
7502     *)
7503   end;
7504 end;
7505
7506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7507 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7508 var
7509   FormatDesc: TFormatDescriptor;
7510 begin
7511   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7512
7513   FormatDesc := TFormatDescriptor.Get(Format);
7514   if FormatDesc.IsCompressed then begin
7515     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7516   end else if aBuildWithGlu then begin
7517     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7518       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7519   end else begin
7520     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7521       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7522   end;
7523
7524   // Freigeben
7525   if (FreeDataAfterGenTexture) then
7526     FreeData;
7527 end;
7528
7529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7530 procedure TglBitmap2D.AfterConstruction;
7531 begin
7532   inherited;
7533   Target := GL_TEXTURE_2D;
7534 end;
7535
7536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7537 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7538 var
7539   Temp: pByte;
7540   Size, w, h: Integer;
7541   FormatDesc: TFormatDescriptor;
7542 begin
7543   FormatDesc := TFormatDescriptor.Get(Format);
7544   if FormatDesc.IsCompressed then
7545     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
7546
7547   w    := aRight  - aLeft;
7548   h    := aBottom - aTop;
7549   Size := FormatDesc.GetSize(w, h);
7550   GetMem(Temp, Size);
7551   try
7552     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7553     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7554     SetDataPointer(Temp, Format, w, h);
7555     FlipVert;
7556   except
7557     FreeMem(Temp);
7558     raise;
7559   end;
7560 end;
7561
7562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7563 procedure TglBitmap2D.GetDataFromTexture;
7564 var
7565   Temp: PByte;
7566   TempWidth, TempHeight: Integer;
7567   TempIntFormat: Cardinal;
7568   IntFormat, f: TglBitmapFormat;
7569   FormatDesc: TFormatDescriptor;
7570 begin
7571   Bind;
7572
7573   // Request Data
7574   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7575   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7576   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7577
7578   IntFormat := tfEmpty;
7579   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7580     FormatDesc := TFormatDescriptor.Get(f);
7581     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7582       IntFormat := FormatDesc.Format;
7583       break;
7584     end;
7585   end;
7586
7587   // Getting data from OpenGL
7588   FormatDesc := TFormatDescriptor.Get(IntFormat);
7589   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7590   try
7591     if FormatDesc.IsCompressed then
7592       glGetCompressedTexImage(Target, 0, Temp)
7593     else
7594      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7595     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7596   except
7597     FreeMem(Temp);
7598     raise;
7599   end;
7600 end;
7601
7602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7603 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7604 var
7605   BuildWithGlu, PotTex, TexRec: Boolean;
7606   TexSize: Integer;
7607 begin
7608   if Assigned(Data) then begin
7609     // Check Texture Size
7610     if (aTestTextureSize) then begin
7611       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7612
7613       if ((Height > TexSize) or (Width > TexSize)) then
7614         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7615
7616       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7617       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7618
7619       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7620         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7621     end;
7622
7623     CreateId;
7624     SetupParameters(BuildWithGlu);
7625     UploadData(Target, BuildWithGlu);
7626     glAreTexturesResident(1, @fID, @fIsResident);
7627   end;
7628 end;
7629
7630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7631 function TglBitmap2D.FlipHorz: Boolean;
7632 var
7633   Col, Row: Integer;
7634   TempDestData, DestData, SourceData: PByte;
7635   ImgSize: Integer;
7636 begin
7637   result := inherited FlipHorz;
7638   if Assigned(Data) then begin
7639     SourceData := Data;
7640     ImgSize := Height * fRowSize;
7641     GetMem(DestData, ImgSize);
7642     try
7643       TempDestData := DestData;
7644       Dec(TempDestData, fRowSize + fPixelSize);
7645       for Row := 0 to Height -1 do begin
7646         Inc(TempDestData, fRowSize * 2);
7647         for Col := 0 to Width -1 do begin
7648           Move(SourceData^, TempDestData^, fPixelSize);
7649           Inc(SourceData, fPixelSize);
7650           Dec(TempDestData, fPixelSize);
7651         end;
7652       end;
7653       SetDataPointer(DestData, Format);
7654       result := true;
7655     except
7656       FreeMem(DestData);
7657       raise;
7658     end;
7659   end;
7660 end;
7661
7662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7663 function TglBitmap2D.FlipVert: Boolean;
7664 var
7665   Row: Integer;
7666   TempDestData, DestData, SourceData: PByte;
7667 begin
7668   result := inherited FlipVert;
7669   if Assigned(Data) then begin
7670     SourceData := Data;
7671     GetMem(DestData, Height * fRowSize);
7672     try
7673       TempDestData := DestData;
7674       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7675       for Row := 0 to Height -1 do begin
7676         Move(SourceData^, TempDestData^, fRowSize);
7677         Dec(TempDestData, fRowSize);
7678         Inc(SourceData, fRowSize);
7679       end;
7680       SetDataPointer(DestData, Format);
7681       result := true;
7682     except
7683       FreeMem(DestData);
7684       raise;
7685     end;
7686   end;
7687 end;
7688
7689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7690 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7692 type
7693   TMatrixItem = record
7694     X, Y: Integer;
7695     W: Single;
7696   end;
7697
7698   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7699   TglBitmapToNormalMapRec = Record
7700     Scale: Single;
7701     Heights: array of Single;
7702     MatrixU : array of TMatrixItem;
7703     MatrixV : array of TMatrixItem;
7704   end;
7705
7706 const
7707   ONE_OVER_255 = 1 / 255;
7708
7709   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7710 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7711 var
7712   Val: Single;
7713 begin
7714   with FuncRec do begin
7715     Val :=
7716       Source.Data.r * LUMINANCE_WEIGHT_R +
7717       Source.Data.g * LUMINANCE_WEIGHT_G +
7718       Source.Data.b * LUMINANCE_WEIGHT_B;
7719     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7720   end;
7721 end;
7722
7723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7724 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7725 begin
7726   with FuncRec do
7727     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7728 end;
7729
7730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7731 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7732 type
7733   TVec = Array[0..2] of Single;
7734 var
7735   Idx: Integer;
7736   du, dv: Double;
7737   Len: Single;
7738   Vec: TVec;
7739
7740   function GetHeight(X, Y: Integer): Single;
7741   begin
7742     with FuncRec do begin
7743       X := Max(0, Min(Size.X -1, X));
7744       Y := Max(0, Min(Size.Y -1, Y));
7745       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7746     end;
7747   end;
7748
7749 begin
7750   with FuncRec do begin
7751     with PglBitmapToNormalMapRec(Args)^ do begin
7752       du := 0;
7753       for Idx := Low(MatrixU) to High(MatrixU) do
7754         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7755
7756       dv := 0;
7757       for Idx := Low(MatrixU) to High(MatrixU) do
7758         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7759
7760       Vec[0] := -du * Scale;
7761       Vec[1] := -dv * Scale;
7762       Vec[2] := 1;
7763     end;
7764
7765     // Normalize
7766     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7767     if Len <> 0 then begin
7768       Vec[0] := Vec[0] * Len;
7769       Vec[1] := Vec[1] * Len;
7770       Vec[2] := Vec[2] * Len;
7771     end;
7772
7773     // Farbe zuweisem
7774     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7775     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7776     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7777   end;
7778 end;
7779
7780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7781 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7782 var
7783   Rec: TglBitmapToNormalMapRec;
7784
7785   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7786   begin
7787     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7788       Matrix[Index].X := X;
7789       Matrix[Index].Y := Y;
7790       Matrix[Index].W := W;
7791     end;
7792   end;
7793
7794 begin
7795   (* TODO Compression
7796   if not FormatIsUncompressed(InternalFormat) then
7797     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7798     *)
7799
7800   if aScale > 100 then
7801     Rec.Scale := 100
7802   else if aScale < -100 then
7803     Rec.Scale := -100
7804   else
7805     Rec.Scale := aScale;
7806
7807   SetLength(Rec.Heights, Width * Height);
7808   try
7809     case aFunc of
7810       nm4Samples: begin
7811         SetLength(Rec.MatrixU, 2);
7812         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7813         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7814
7815         SetLength(Rec.MatrixV, 2);
7816         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7817         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7818       end;
7819
7820       nmSobel: begin
7821         SetLength(Rec.MatrixU, 6);
7822         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7823         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7824         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7825         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7826         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7827         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7828
7829         SetLength(Rec.MatrixV, 6);
7830         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7831         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7832         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7833         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7834         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7835         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7836       end;
7837
7838       nm3x3: begin
7839         SetLength(Rec.MatrixU, 6);
7840         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7841         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7842         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7843         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7844         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7845         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7846
7847         SetLength(Rec.MatrixV, 6);
7848         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7849         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7850         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7851         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7852         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7853         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7854       end;
7855
7856       nm5x5: begin
7857         SetLength(Rec.MatrixU, 20);
7858         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7859         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7860         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7861         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7862         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7863         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7864         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7865         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7866         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7867         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7868         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7869         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7870         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7871         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7872         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7873         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7874         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7875         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7876         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7877         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7878
7879         SetLength(Rec.MatrixV, 20);
7880         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7881         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7882         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7883         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7884         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7885         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7886         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7887         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7888         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7889         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7890         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7891         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7892         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7893         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7894         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7895         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7896         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7897         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7898         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7899         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7900       end;
7901     end;
7902
7903     // Daten Sammeln
7904     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7905       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7906     else
7907       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7908     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7909   finally
7910     SetLength(Rec.Heights, 0);
7911   end;
7912 end;
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922 (*
7923 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7924 var
7925   pTemp: pByte;
7926   Size: Integer;
7927 begin
7928   if Height > 1 then begin
7929     // extract first line of the data
7930     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7931     GetMem(pTemp, Size);
7932
7933     Move(Data^, pTemp^, Size);
7934
7935     FreeMem(Data);
7936   end else
7937     pTemp := Data;
7938
7939   // set data pointer
7940   inherited SetDataPointer(pTemp, Format, Width);
7941
7942   if FormatIsUncompressed(Format) then begin
7943     fUnmapFunc := FormatGetUnMapFunc(Format);
7944     fGetPixelFunc := GetPixel1DUnmap;
7945   end;
7946 end;
7947
7948
7949 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7950 var
7951   pTemp: pByte;
7952 begin
7953   pTemp := Data;
7954   Inc(pTemp, Pos.X * fPixelSize);
7955
7956   fUnmapFunc(pTemp, Pixel);
7957 end;
7958
7959
7960 function TglBitmap1D.FlipHorz: Boolean;
7961 var
7962   Col: Integer;
7963   pTempDest, pDest, pSource: pByte;
7964 begin
7965   result := inherited FlipHorz;
7966
7967   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7968     pSource := Data;
7969
7970     GetMem(pDest, fRowSize);
7971     try
7972       pTempDest := pDest;
7973
7974       Inc(pTempDest, fRowSize);
7975       for Col := 0 to Width -1 do begin
7976         Move(pSource^, pTempDest^, fPixelSize);
7977
7978         Inc(pSource, fPixelSize);
7979         Dec(pTempDest, fPixelSize);
7980       end;
7981
7982       SetDataPointer(pDest, InternalFormat);
7983
7984       result := true;
7985     finally
7986       FreeMem(pDest);
7987     end;
7988   end;
7989 end;
7990
7991
7992 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7993 begin
7994   // Upload data
7995   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7996     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7997   else
7998
7999   // Upload data
8000   if BuildWithGlu then
8001     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
8002   else
8003     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
8004
8005   // Freigeben
8006   if (FreeDataAfterGenTexture) then
8007     FreeData;
8008 end;
8009
8010
8011 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
8012 var
8013   BuildWithGlu, TexRec: Boolean;
8014   glFormat, glInternalFormat, glType: Cardinal;
8015   TexSize: Integer;
8016 begin
8017   if Assigned(Data) then begin
8018     // Check Texture Size
8019     if (TestTextureSize) then begin
8020       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8021
8022       if (Width > TexSize) then
8023         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8024
8025       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8026                 (Target = GL_TEXTURE_RECTANGLE_ARB);
8027
8028       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8029         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8030     end;
8031
8032     CreateId;
8033
8034     SetupParameters(BuildWithGlu);
8035     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8036
8037     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8038
8039     // Infos sammeln
8040     glAreTexturesResident(1, @fID, @fIsResident);
8041   end;
8042 end;
8043
8044
8045 procedure TglBitmap1D.AfterConstruction;
8046 begin
8047   inherited;
8048
8049   Target := GL_TEXTURE_1D;
8050 end;
8051
8052
8053 { TglBitmapCubeMap }
8054
8055 procedure TglBitmapCubeMap.AfterConstruction;
8056 begin
8057   inherited;
8058
8059   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8060     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8061
8062   SetWrap; // set all to GL_CLAMP_TO_EDGE
8063   Target := GL_TEXTURE_CUBE_MAP;
8064   fGenMode := GL_REFLECTION_MAP;
8065 end;
8066
8067
8068 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8069 begin
8070   inherited Bind (EnableTextureUnit);
8071
8072   if EnableTexCoordsGen then begin
8073     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8074     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8075     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8076     glEnable(GL_TEXTURE_GEN_S);
8077     glEnable(GL_TEXTURE_GEN_T);
8078     glEnable(GL_TEXTURE_GEN_R);
8079   end;
8080 end;
8081
8082
8083 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8084 var
8085   glFormat, glInternalFormat, glType: Cardinal;
8086   BuildWithGlu: Boolean;
8087   TexSize: Integer;
8088 begin
8089   // Check Texture Size
8090   if (TestTextureSize) then begin
8091     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8092
8093     if ((Height > TexSize) or (Width > TexSize)) then
8094       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8095
8096     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8097       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8098   end;
8099
8100   // create Texture
8101   if ID = 0 then begin
8102     CreateID;
8103     SetupParameters(BuildWithGlu);
8104   end;
8105
8106   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8107
8108   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8109 end;
8110
8111
8112 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8113 begin
8114   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8115 end;
8116
8117
8118 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8119   DisableTextureUnit: Boolean);
8120 begin
8121   inherited Unbind (DisableTextureUnit);
8122
8123   if DisableTexCoordsGen then begin
8124     glDisable(GL_TEXTURE_GEN_S);
8125     glDisable(GL_TEXTURE_GEN_T);
8126     glDisable(GL_TEXTURE_GEN_R);
8127   end;
8128 end;
8129
8130
8131 { TglBitmapNormalMap }
8132
8133 type
8134   TVec = Array[0..2] of Single;
8135   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8136
8137   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8138   TglBitmapNormalMapRec = record
8139     HalfSize : Integer;
8140     Func: TglBitmapNormalMapGetVectorFunc;
8141   end;
8142
8143
8144 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8145 begin
8146   Vec[0] := HalfSize;
8147   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8148   Vec[2] := - (Position.X + 0.5 - HalfSize);
8149 end;
8150
8151
8152 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8153 begin
8154   Vec[0] := - HalfSize;
8155   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8156   Vec[2] := Position.X + 0.5 - HalfSize;
8157 end;
8158
8159
8160 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8161 begin
8162   Vec[0] := Position.X + 0.5 - HalfSize;
8163   Vec[1] := HalfSize;
8164   Vec[2] := Position.Y + 0.5 - HalfSize;
8165 end;
8166
8167
8168 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8169 begin
8170   Vec[0] := Position.X + 0.5 - HalfSize;
8171   Vec[1] := - HalfSize;
8172   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8173 end;
8174
8175
8176 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8177 begin
8178   Vec[0] := Position.X + 0.5 - HalfSize;
8179   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8180   Vec[2] := HalfSize;
8181 end;
8182
8183
8184 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8185 begin
8186   Vec[0] := - (Position.X + 0.5 - HalfSize);
8187   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8188   Vec[2] := - HalfSize;
8189 end;
8190
8191
8192 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8193 var
8194   Vec : TVec;
8195   Len: Single;
8196 begin
8197   with FuncRec do begin
8198     with PglBitmapNormalMapRec (CustomData)^ do begin
8199       Func(Vec, Position, HalfSize);
8200
8201       // Normalize
8202       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8203       if Len <> 0 then begin
8204         Vec[0] := Vec[0] * Len;
8205         Vec[1] := Vec[1] * Len;
8206         Vec[2] := Vec[2] * Len;
8207       end;
8208
8209       // Scale Vector and AddVectro
8210       Vec[0] := Vec[0] * 0.5 + 0.5;
8211       Vec[1] := Vec[1] * 0.5 + 0.5;
8212       Vec[2] := Vec[2] * 0.5 + 0.5;
8213     end;
8214
8215     // Set Color
8216     Dest.Red   := Round(Vec[0] * 255);
8217     Dest.Green := Round(Vec[1] * 255);
8218     Dest.Blue  := Round(Vec[2] * 255);
8219   end;
8220 end;
8221
8222
8223 procedure TglBitmapNormalMap.AfterConstruction;
8224 begin
8225   inherited;
8226
8227   fGenMode := GL_NORMAL_MAP;
8228 end;
8229
8230
8231 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8232   TestTextureSize: Boolean);
8233 var
8234   Rec: TglBitmapNormalMapRec;
8235   SizeRec: TglBitmapPixelPosition;
8236 begin
8237   Rec.HalfSize := Size div 2;
8238
8239   FreeDataAfterGenTexture := false;
8240
8241   SizeRec.Fields := [ffX, ffY];
8242   SizeRec.X := Size;
8243   SizeRec.Y := Size;
8244
8245   // Positive X
8246   Rec.Func := glBitmapNormalMapPosX;
8247   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8248   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8249
8250   // Negative X
8251   Rec.Func := glBitmapNormalMapNegX;
8252   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8253   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8254
8255   // Positive Y
8256   Rec.Func := glBitmapNormalMapPosY;
8257   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8258   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8259
8260   // Negative Y
8261   Rec.Func := glBitmapNormalMapNegY;
8262   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8263   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8264
8265   // Positive Z
8266   Rec.Func := glBitmapNormalMapPosZ;
8267   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8268   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8269
8270   // Negative Z
8271   Rec.Func := glBitmapNormalMapNegZ;
8272   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8273   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8274 end;
8275 *)
8276
8277 initialization
8278   glBitmapSetDefaultFormat(tfEmpty);
8279   glBitmapSetDefaultMipmap(mmMipmap);
8280   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8281   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8282
8283   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8284   glBitmapSetDefaultDeleteTextureOnFree    (true);
8285
8286   TFormatDescriptor.Init;
8287
8288 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8289   OpenGLInitialized := false;
8290   InitOpenGLCS := TCriticalSection.Create;
8291 {$ENDIF}
8292
8293 finalization
8294   TFormatDescriptor.Finalize;
8295
8296 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8297   FreeAndNil(InitOpenGLCS);
8298 {$ENDIF}
8299
8300 end.
8301