glBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 // Please uncomment the defines below to configure the glBitmap to your preferences.
  28 // If you have configured the unit you can uncomment the warning above.
  29 {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  30
  31 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  32 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  33 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  34 // enable support for OpenGL ES 1.1
  35 {.$DEFINE OPENGL_ES_1_1}
  36
  37 // enable support for OpenGL ES 2.0
  38 {.$DEFINE OPENGL_ES_2_0}
  39
  40 // enable support for OpenGL ES 3.0
  41 {.$DEFINE OPENGL_ES_3_0}
  42
  43 // enable support for all OpenGL ES extensions
  44 {.$DEFINE OPENGL_ES_EXT}
  45
  46
  47 // activate to enable build-in OpenGL support with statically linked methods
  48 // use dglOpenGL.pas if not enabled
  49 {.$DEFINE GLB_NATIVE_OGL_STATIC}
  50
  51 // activate to enable build-in OpenGL support with dynamically linked methods
  52 // use dglOpenGL.pas if not enabled
  53 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  54
  55
  56 // activate to enable the support for SDL_surfaces
  57 {.$DEFINE GLB_SDL}
  58
  59 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  60 {.$DEFINE GLB_DELPHI}
  61
  62 // activate to enable the support for TLazIntfImage from Lazarus
  63 {.$DEFINE GLB_LAZARUS}
  64
  65
  66
  67 // activate to enable the support of SDL_image to load files. (READ ONLY)
  68 // If you enable SDL_image all other libraries will be ignored!
  69 {.$DEFINE GLB_SDL_IMAGE}
  70
  71
  72
  73 // activate to enable Lazarus TPortableNetworkGraphic support
  74 // if you enable this pngImage and libPNG will be ignored
  75 {.$DEFINE GLB_LAZ_PNG}
  76
  77 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  78 // if you enable pngimage the libPNG will be ignored
  79 {.$DEFINE GLB_PNGIMAGE}
  80
  81 // activate to use the libPNG -> http://www.libpng.org/
  82 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  83 {.$DEFINE GLB_LIB_PNG}
  84
  85
  86
  87 // activate to enable Lazarus TJPEGImage support
  88 // if you enable this delphi jpegs and libJPEG will be ignored
  89 {.$DEFINE GLB_LAZ_JPEG}
  90
  91 // if you enable delphi jpegs the libJPEG will be ignored
  92 {.$DEFINE GLB_DELPHI_JPEG}
  93
  94 // activate to use the libJPEG -> http://www.ijg.org/
  95 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  96 {.$DEFINE GLB_LIB_JPEG}
  97
  98
  99 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 100 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 102 // Delphi Versions
 103 {$IFDEF fpc}
 104   {$MODE Delphi}
 105
 106   {$IFDEF CPUI386}
 107     {$DEFINE CPU386}
 108     {$ASMMODE INTEL}
 109   {$ENDIF}
 110
 111   {$IFNDEF WINDOWS}
 112     {$linklib c}
 113   {$ENDIF}
 114 {$ENDIF}
 115
 116 // Operation System
 117 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 118   {$DEFINE GLB_WIN}
 119 {$ELSEIF DEFINED(LINUX)}
 120   {$DEFINE GLB_LINUX}
 121 {$IFEND}
 122
 123 // OpenGL ES
 124 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 125 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
 126 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 127 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
 128
 129 // native OpenGL Support
 130 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 131   {$IFDEF OPENGL_ES}
 132     {$ERROR 'native OpenGL is not supported yet for OpenGL ES, please use dglOpenGLES.pas instead'}
 133   {$ELSE}
 134     {$DEFINE GLB_NATIVE_OGL}
 135   {$ENDIF}
 136 {$IFEND}
 137
 138 // checking define combinations
 139 //SDL Image
 140 {$IFDEF GLB_SDL_IMAGE}
 141   {$IFNDEF GLB_SDL}
 142     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 143     {$DEFINE GLB_SDL}
 144   {$ENDIF}
 145
 146   {$IFDEF GLB_LAZ_PNG}
 147     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 148     {$undef GLB_LAZ_PNG}
 149   {$ENDIF}
 150
 151   {$IFDEF GLB_PNGIMAGE}
 152     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 153     {$undef GLB_PNGIMAGE}
 154   {$ENDIF}
 155
 156   {$IFDEF GLB_LAZ_JPEG}
 157     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 158     {$undef GLB_LAZ_JPEG}
 159   {$ENDIF}
 160
 161   {$IFDEF GLB_DELPHI_JPEG}
 162     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 163     {$undef GLB_DELPHI_JPEG}
 164   {$ENDIF}
 165
 166   {$IFDEF GLB_LIB_PNG}
 167     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 168     {$undef GLB_LIB_PNG}
 169   {$ENDIF}
 170
 171   {$IFDEF GLB_LIB_JPEG}
 172     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 173     {$undef GLB_LIB_JPEG}
 174   {$ENDIF}
 175
 176   {$DEFINE GLB_SUPPORT_PNG_READ}
 177   {$DEFINE GLB_SUPPORT_JPEG_READ}
 178 {$ENDIF}
 179
 180 // Lazarus TPortableNetworkGraphic
 181 {$IFDEF GLB_LAZ_PNG}
 182   {$IFNDEF GLB_LAZARUS}
 183     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 184     {$DEFINE GLB_LAZARUS}
 185   {$ENDIF}
 186
 187   {$IFDEF GLB_PNGIMAGE}
 188     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 189     {$undef GLB_PNGIMAGE}
 190   {$ENDIF}
 191
 192   {$IFDEF GLB_LIB_PNG}
 193     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 194     {$undef GLB_LIB_PNG}
 195   {$ENDIF}
 196
 197   {$DEFINE GLB_SUPPORT_PNG_READ}
 198   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 199 {$ENDIF}
 200
 201 // PNG Image
 202 {$IFDEF GLB_PNGIMAGE}
 203   {$IFDEF GLB_LIB_PNG}
 204     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 205     {$undef GLB_LIB_PNG}
 206   {$ENDIF}
 207
 208   {$DEFINE GLB_SUPPORT_PNG_READ}
 209   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 210 {$ENDIF}
 211
 212 // libPNG
 213 {$IFDEF GLB_LIB_PNG}
 214   {$DEFINE GLB_SUPPORT_PNG_READ}
 215   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 216 {$ENDIF}
 217
 218 // Lazarus TJPEGImage
 219 {$IFDEF GLB_LAZ_JPEG}
 220   {$IFNDEF GLB_LAZARUS}
 221     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 222     {$DEFINE GLB_LAZARUS}
 223   {$ENDIF}
 224
 225   {$IFDEF GLB_DELPHI_JPEG}
 226     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 227     {$undef GLB_DELPHI_JPEG}
 228   {$ENDIF}
 229
 230   {$IFDEF GLB_LIB_JPEG}
 231     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 232     {$undef GLB_LIB_JPEG}
 233   {$ENDIF}
 234
 235   {$DEFINE GLB_SUPPORT_JPEG_READ}
 236   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 237 {$ENDIF}
 238
 239 // JPEG Image
 240 {$IFDEF GLB_DELPHI_JPEG}
 241   {$IFDEF GLB_LIB_JPEG}
 242     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 243     {$undef GLB_LIB_JPEG}
 244   {$ENDIF}
 245
 246   {$DEFINE GLB_SUPPORT_JPEG_READ}
 247   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 248 {$ENDIF}
 249
 250 // libJPEG
 251 {$IFDEF GLB_LIB_JPEG}
 252   {$DEFINE GLB_SUPPORT_JPEG_READ}
 253   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 254 {$ENDIF}
 255
 256 // native OpenGL
 257 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 258   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
 259 {$IFEND}
 260
 261 // general options
 262 {$EXTENDEDSYNTAX ON}
 263 {$LONGSTRINGS ON}
 264 {$ALIGN ON}
 265 {$IFNDEF FPC}
 266   {$OPTIMIZATION ON}
 267 {$ENDIF}
 268
 269 interface
 270
 271 uses
 272   {$IFNDEF GLB_NATIVE_OGL}
 273     {$IFDEF OPENGL_ES}          dglOpenGLES,
 274     {$ELSE}                     dglOpenGL,                          {$ENDIF}
 275                                                                     {$ENDIF}
 276   {$IF DEFINED(GLB_WIN) AND
 277        (DEFINED(GLB_NATIVE_OGL) OR
 278         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
 279
 280   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 281   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 282   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 283
 284   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 285   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 286   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 287   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 288   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 289
 290   Classes, SysUtils;
 291
 292 {$IFDEF GLB_NATIVE_OGL}
 293 const
 294   GL_TRUE   = 1;
 295   GL_FALSE  = 0;
 296
 297   GL_ZERO = 0;
 298   GL_ONE  = 1;
 299
 300   GL_VERSION    = $1F02;
 301   GL_EXTENSIONS = $1F03;
 302
 303   GL_TEXTURE_1D         = $0DE0;
 304   GL_TEXTURE_2D         = $0DE1;
 305   GL_TEXTURE_RECTANGLE  = $84F5;
 306
 307   GL_NORMAL_MAP                   = $8511;
 308   GL_TEXTURE_CUBE_MAP             = $8513;
 309   GL_REFLECTION_MAP               = $8512;
 310   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
 311   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
 312   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
 313   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
 314   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
 315   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
 316
 317   GL_TEXTURE_WIDTH            = $1000;
 318   GL_TEXTURE_HEIGHT           = $1001;
 319   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
 320   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
 321
 322   GL_S = $2000;
 323   GL_T = $2001;
 324   GL_R = $2002;
 325   GL_Q = $2003;
 326
 327   GL_TEXTURE_GEN_S = $0C60;
 328   GL_TEXTURE_GEN_T = $0C61;
 329   GL_TEXTURE_GEN_R = $0C62;
 330   GL_TEXTURE_GEN_Q = $0C63;
 331
 332   GL_RED    = $1903;
 333   GL_GREEN  = $1904;
 334   GL_BLUE   = $1905;
 335
 336   GL_ALPHA    = $1906;
 337   GL_ALPHA4   = $803B;
 338   GL_ALPHA8   = $803C;
 339   GL_ALPHA12  = $803D;
 340   GL_ALPHA16  = $803E;
 341
 342   GL_LUMINANCE    = $1909;
 343   GL_LUMINANCE4   = $803F;
 344   GL_LUMINANCE8   = $8040;
 345   GL_LUMINANCE12  = $8041;
 346   GL_LUMINANCE16  = $8042;
 347
 348   GL_LUMINANCE_ALPHA      = $190A;
 349   GL_LUMINANCE4_ALPHA4    = $8043;
 350   GL_LUMINANCE6_ALPHA2    = $8044;
 351   GL_LUMINANCE8_ALPHA8    = $8045;
 352   GL_LUMINANCE12_ALPHA4   = $8046;
 353   GL_LUMINANCE12_ALPHA12  = $8047;
 354   GL_LUMINANCE16_ALPHA16  = $8048;
 355
 356   GL_RGB      = $1907;
 357   GL_BGR      = $80E0;
 358   GL_R3_G3_B2 = $2A10;
 359   GL_RGB4     = $804F;
 360   GL_RGB5     = $8050;
 361   GL_RGB565   = $8D62;
 362   GL_RGB8     = $8051;
 363   GL_RGB10    = $8052;
 364   GL_RGB12    = $8053;
 365   GL_RGB16    = $8054;
 366
 367   GL_RGBA     = $1908;
 368   GL_BGRA     = $80E1;
 369   GL_RGBA2    = $8055;
 370   GL_RGBA4    = $8056;
 371   GL_RGB5_A1  = $8057;
 372   GL_RGBA8    = $8058;
 373   GL_RGB10_A2 = $8059;
 374   GL_RGBA12   = $805A;
 375   GL_RGBA16   = $805B;
 376
 377   GL_DEPTH_COMPONENT    = $1902;
 378   GL_DEPTH_COMPONENT16  = $81A5;
 379   GL_DEPTH_COMPONENT24  = $81A6;
 380   GL_DEPTH_COMPONENT32  = $81A7;
 381
 382   GL_COMPRESSED_RGB                 = $84ED;
 383   GL_COMPRESSED_RGBA                = $84EE;
 384   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
 385   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
 386   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
 387   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
 388
 389   GL_UNSIGNED_BYTE            = $1401;
 390   GL_UNSIGNED_BYTE_3_3_2      = $8032;
 391   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
 392
 393   GL_UNSIGNED_SHORT             = $1403;
 394   GL_UNSIGNED_SHORT_5_6_5       = $8363;
 395   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
 396   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
 397   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
 398   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 399   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 400
 401   GL_UNSIGNED_INT                 = $1405;
 402   GL_UNSIGNED_INT_8_8_8_8         = $8035;
 403   GL_UNSIGNED_INT_10_10_10_2      = $8036;
 404   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
 405   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
 406
 407   { Texture Filter }
 408   GL_TEXTURE_MAG_FILTER     = $2800;
 409   GL_TEXTURE_MIN_FILTER     = $2801;
 410   GL_NEAREST                = $2600;
 411   GL_NEAREST_MIPMAP_NEAREST = $2700;
 412   GL_NEAREST_MIPMAP_LINEAR  = $2702;
 413   GL_LINEAR                 = $2601;
 414   GL_LINEAR_MIPMAP_NEAREST  = $2701;
 415   GL_LINEAR_MIPMAP_LINEAR   = $2703;
 416
 417   { Texture Wrap }
 418   GL_TEXTURE_WRAP_S   = $2802;
 419   GL_TEXTURE_WRAP_T   = $2803;
 420   GL_TEXTURE_WRAP_R   = $8072;
 421   GL_CLAMP            = $2900;
 422   GL_REPEAT           = $2901;
 423   GL_CLAMP_TO_EDGE    = $812F;
 424   GL_CLAMP_TO_BORDER  = $812D;
 425   GL_MIRRORED_REPEAT  = $8370;
 426
 427   { Other }
 428   GL_GENERATE_MIPMAP      = $8191;
 429   GL_TEXTURE_BORDER_COLOR = $1004;
 430   GL_MAX_TEXTURE_SIZE     = $0D33;
 431   GL_PACK_ALIGNMENT       = $0D05;
 432   GL_UNPACK_ALIGNMENT     = $0CF5;
 433
 434   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
 435   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 436   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
 437   GL_TEXTURE_GEN_MODE               = $2500;
 438
 439 {$IF DEFINED(GLB_WIN)}
 440   libglu    = 'glu32.dll';
 441   libopengl = 'opengl32.dll';
 442 {$ELSEIF DEFINED(GLB_LINUX)}
 443   libglu    = 'libGLU.so.1';
 444   libopengl = 'libGL.so.1';
 445 {$IFEND}
 446
 447 type
 448   GLboolean = BYTEBOOL;
 449   GLint     = Integer;
 450   GLsizei   = Integer;
 451   GLuint    = Cardinal;
 452   GLfloat   = Single;
 453   GLenum    = Cardinal;
 454
 455   PGLvoid    = Pointer;
 456   PGLboolean = ^GLboolean;
 457   PGLint     = ^GLint;
 458   PGLuint    = ^GLuint;
 459   PGLfloat   = ^GLfloat;
 460
 461   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 462   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}
 463   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 464
 465 {$IF DEFINED(GLB_WIN)}
 466   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
 467 {$ELSEIF DEFINED(GLB_LINUX)}
 468   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
 469   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
 470 {$IFEND}
 471
 472 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
 473   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 474   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 475
 476   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 477   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 478
 479   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 480   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 481   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 482   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 483   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 484   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 485   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 486
 487   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 488   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 489   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 490   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 491
 492   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 493   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 494   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 495
 496   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}
 497   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}
 498   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 499
 500   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 501   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
 502
 503 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
 504   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 505   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 506
 507   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 508   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 509
 510   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 511   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 512   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 513   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 514   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 515   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 516   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 517
 518   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 519   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 520   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 521   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 522
 523   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 524   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;
 525   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 526
 527   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;
 528   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;
 529   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
 530
 531   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 532   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
 533 {$IFEND}
 534
 535 var
 536   GL_VERSION_1_2,
 537   GL_VERSION_1_3,
 538   GL_VERSION_1_4,
 539   GL_VERSION_2_0,
 540   GL_VERSION_3_3,
 541
 542   GL_SGIS_generate_mipmap,
 543
 544   GL_ARB_texture_border_clamp,
 545   GL_ARB_texture_mirrored_repeat,
 546   GL_ARB_texture_rectangle,
 547   GL_ARB_texture_non_power_of_two,
 548   GL_ARB_texture_swizzle,
 549   GL_ARB_texture_cube_map,
 550
 551   GL_IBM_texture_mirrored_repeat,
 552
 553   GL_NV_texture_rectangle,
 554
 555   GL_EXT_texture_edge_clamp,
 556   GL_EXT_texture_rectangle,
 557   GL_EXT_texture_swizzle,
 558   GL_EXT_texture_cube_map,
 559   GL_EXT_texture_filter_anisotropic: Boolean;
 560
 561   glCompressedTexImage1D: TglCompressedTexImage1D;
 562   glCompressedTexImage2D: TglCompressedTexImage2D;
 563   glGetCompressedTexImage: TglGetCompressedTexImage;
 564
 565 {$IF DEFINED(GLB_WIN)}
 566   wglGetProcAddress: TwglGetProcAddress;
 567 {$ELSEIF DEFINED(GLB_LINUX)}
 568   glXGetProcAddress: TglXGetProcAddress;
 569   glXGetProcAddressARB: TglXGetProcAddress;
 570 {$IFEND}
 571
 572 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
 573   glEnable: TglEnable;
 574   glDisable: TglDisable;
 575
 576   glGetString: TglGetString;
 577   glGetIntegerv: TglGetIntegerv;
 578
 579   glTexParameteri: TglTexParameteri;
 580   glTexParameteriv: TglTexParameteriv;
 581   glTexParameterfv: TglTexParameterfv;
 582   glGetTexParameteriv: TglGetTexParameteriv;
 583   glGetTexParameterfv: TglGetTexParameterfv;
 584   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
 585   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
 586
 587   glTexGeni: TglTexGeni;
 588   glGenTextures: TglGenTextures;
 589   glBindTexture: TglBindTexture;
 590   glDeleteTextures: TglDeleteTextures;
 591
 592   glAreTexturesResident: TglAreTexturesResident;
 593   glReadPixels: TglReadPixels;
 594   glPixelStorei: TglPixelStorei;
 595
 596   glTexImage1D: TglTexImage1D;
 597   glTexImage2D: TglTexImage2D;
 598   glGetTexImage: TglGetTexImage;
 599
 600   gluBuild1DMipmaps: TgluBuild1DMipmaps;
 601   gluBuild2DMipmaps: TgluBuild2DMipmaps;
 602 {$ENDIF}
 603 {$ENDIF}
 604
 605 type
 606 {$IFNDEF fpc}
 607   QWord   = System.UInt64;
 608   PQWord  = ^QWord;
 609
 610   PtrInt  = Longint;
 611   PtrUInt = DWord;
 612 {$ENDIF}
 613
 614
 615   { type that describes the format of the data stored in a texture.
 616     the name of formats is composed of the following constituents:
 617     - multiple channels:
 618        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 619        - width of the chanel in bit       (4, 8, 16, ...)
 620     - data type                           (e.g. ub, us, ui)
 621     - number of elements of data types }
 622   TglBitmapFormat = (
 623     tfEmpty = 0,
 624
 625     tfAlpha4ub1,                //< 1 x unsigned byte
 626     tfAlpha8ub1,                //< 1 x unsigned byte
 627     tfAlpha16us1,               //< 1 x unsigned short
 628
 629     tfLuminance4ub1,            //< 1 x unsigned byte
 630     tfLuminance8ub1,            //< 1 x unsigned byte
 631     tfLuminance16us1,           //< 1 x unsigned short
 632
 633     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 634     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 635     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 636     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 637     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 638
 639     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 640     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 641     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 642     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 643     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 644     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 645     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 646     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 647     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 648     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 649     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 650     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 651
 652     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 653     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 654     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 655     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 656     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 657     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 658     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 659     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 660     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 661     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 662
 663     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 664     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 665     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 666     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 667     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 668     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 669     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 670     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 671     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 672     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 673     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 674
 675     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 676     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 677     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 678     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 679     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 680     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 681     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 682     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 683     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 684     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 685
 686     tfDepth16us1,               //< 1 x unsigned short (depth)
 687     tfDepth24ui1,               //< 1 x unsigned int (depth)
 688     tfDepth32ui1,               //< 1 x unsigned int (depth)
 689
 690     tfS3tcDtx1RGBA,
 691     tfS3tcDtx3RGBA,
 692     tfS3tcDtx5RGBA
 693   );
 694
 695   { type to define suitable file formats }
 696   TglBitmapFileType = (
 697      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 698      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 699      ftDDS,                                             //< Direct Draw Surface file (DDS)
 700      ftTGA,                                             //< Targa Image File (TGA)
 701      ftBMP,                                             //< Windows Bitmap File (BMP)
 702      ftRAW);                                            //< glBitmap RAW file format
 703    TglBitmapFileTypes = set of TglBitmapFileType;
 704
 705   { possible mipmap types }
 706   TglBitmapMipMap = (
 707      mmNone,                //< no mipmaps
 708      mmMipmap,              //< normal mipmaps
 709      mmMipmapGlu);          //< mipmaps generated with glu functions
 710
 711   { possible normal map functions }
 712    TglBitmapNormalMapFunc = (
 713      nm4Samples,
 714      nmSobel,
 715      nm3x3,
 716      nm5x5);
 717
 718  ////////////////////////////////////////////////////////////////////////////////////////////////////
 719    EglBitmap                  = class(Exception);   //< glBitmap exception
 720    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 721    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 722    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 723    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 724    public
 725      constructor Create(const aFormat: TglBitmapFormat); overload;
 726      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 727    end;
 728
 729 ////////////////////////////////////////////////////////////////////////////////////////////////////
 730   { record that stores 4 unsigned integer values }
 731   TglBitmapRec4ui = packed record
 732   case Integer of
 733     0: (r, g, b, a: Cardinal);
 734     1: (arr: array[0..3] of Cardinal);
 735   end;
 736
 737   { record that stores 4 unsigned byte values }
 738   TglBitmapRec4ub = packed record
 739   case Integer of
 740     0: (r, g, b, a: Byte);
 741     1: (arr: array[0..3] of Byte);
 742   end;
 743
 744   { record that stores 4 unsigned long integer values }
 745   TglBitmapRec4ul = packed record
 746   case Integer of
 747     0: (r, g, b, a: QWord);
 748     1: (arr: array[0..3] of QWord);
 749   end;
 750
 751   { describes the properties of a given texture data format }
 752   TglBitmapFormatDescriptor = class(TObject)
 753   private
 754     // cached properties
 755     fBytesPerPixel: Single;   //< number of bytes for each pixel
 756     fChannelCount: Integer;   //< number of color channels
 757     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 758     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 759
 760     { @return @true if the format has a red color channel, @false otherwise }
 761     function GetHasRed: Boolean;
 762
 763     { @return @true if the format has a green color channel, @false otherwise }
 764     function GetHasGreen: Boolean;
 765
 766     { @return @true if the format has a blue color channel, @false otherwise }
 767     function GetHasBlue: Boolean;
 768
 769     { @return @true if the format has a alpha color channel, @false otherwise }
 770     function GetHasAlpha: Boolean;
 771
 772     { @return @true if the format has any color color channel, @false otherwise }
 773     function GetHasColor: Boolean;
 774
 775     { @return @true if the format is a grayscale format, @false otherwise }
 776     function GetIsGrayscale: Boolean;
 777   protected
 778     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 779     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 780     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 781     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 782     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 783     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 784
 785     fBitsPerPixel: Integer;           //< number of bits per pixel
 786     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 787
 788     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 789     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 790
 791     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 792     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 793     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 794
 795     { set values for this format descriptor }
 796     procedure SetValues; virtual;
 797
 798     { calculate cached values }
 799     procedure CalcValues;
 800   public
 801     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 802     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 803     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 804     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 805     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 806
 807     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 808     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 809     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 810     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 811
 812     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 813     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 814     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 815     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 816     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 817
 818     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 819     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 820     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 821
 822     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 823     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 824     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 825     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 826     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 827     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 828
 829     { constructor }
 830     constructor Create;
 831   public
 832     { get the format descriptor by a given OpenGL internal format
 833         @param aInternalFormat  OpenGL internal format to get format descriptor for
 834         @returns                suitable format descriptor or tfEmpty-Descriptor }
 835     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 836   end;
 837
 838 ////////////////////////////////////////////////////////////////////////////////////////////////////
 839   { structure to store pixel data in }
 840   TglBitmapPixelData = packed record
 841     Data:   TglBitmapRec4ui;  //< color data for each color channel
 842     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 843     Format: TglBitmapFormat;  //< format of the pixel
 844   end;
 845   PglBitmapPixelData = ^TglBitmapPixelData;
 846
 847   TglBitmapSizeFields = set of (ffX, ffY);
 848   TglBitmapSize = packed record
 849     Fields: TglBitmapSizeFields;
 850     X: Word;
 851     Y: Word;
 852   end;
 853   TglBitmapPixelPosition = TglBitmapSize;
 854
 855 ////////////////////////////////////////////////////////////////////////////////////////////////////
 856   TglBitmap = class;
 857
 858   { structure to store data for converting in }
 859   TglBitmapFunctionRec = record
 860     Sender:   TglBitmap;              //< texture object that stores the data to convert
 861     Size:     TglBitmapSize;          //< size of the texture
 862     Position: TglBitmapPixelPosition; //< position of the currently pixel
 863     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 864     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 865     Args:     Pointer;                //< user defined args that was passed to the convert function
 866   end;
 867
 868   { callback to use for converting texture data }
 869   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 870
 871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 872   { base class for all glBitmap classes. used to manage OpenGL texture objects
 873     and to load, save and manipulate texture data }
 874   TglBitmap = class
 875   private
 876     { @returns format descriptor that describes the format of the stored data }
 877     function GetFormatDesc: TglBitmapFormatDescriptor;
 878   protected
 879     fID: GLuint;                          //< name of the OpenGL texture object
 880     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 881     fAnisotropic: Integer;                //< anisotropic level
 882     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 883     fFreeDataOnDestroy: Boolean;          //< free stored data when this object is destroyed
 884     fFreeDataAfterGenTexture: Boolean;    //< free stored data after data was uploaded to video card
 885     fData: PByte;                         //< data of this texture
 886 {$IFNDEF OPENGL_ES}
 887     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 888 {$ENDIF}
 889     fBorderColor: array[0..3] of Single;  //< color of the texture border
 890
 891     fDimension: TglBitmapSize;            //< size of this texture
 892     fMipMap: TglBitmapMipMap;             //< mipmap type
 893     fFormat: TglBitmapFormat;             //< format the texture data is stored in
 894
 895     // Mapping
 896     fPixelSize: Integer;                  //< size of one pixel (in byte)
 897     fRowSize: Integer;                    //< size of one pixel row (in byte)
 898
 899     // Filtering
 900     fFilterMin: GLenum;                   //< min filter to apply to the texture
 901     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 902
 903     // TexturWarp
 904     fWrapS: GLenum;                       //< texture wrapping for x axis
 905     fWrapT: GLenum;                       //< texture wrapping for y axis
 906     fWrapR: GLenum;                       //< texture wrapping for z axis
 907
 908 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 909     //Swizzle
 910     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 911 {$IFEND}
 912
 913     // CustomData
 914     fFilename: String;                    //< filename the texture was load from
 915     fCustomName: String;                  //< user defined name
 916     fCustomNameW: WideString;             //< user defined name
 917     fCustomData: Pointer;                 //< user defined data
 918
 919   protected
 920     { @returns the actual width of the texture }
 921     function GetWidth:  Integer; virtual;
 922
 923     { @returns the actual height of the texture }
 924     function GetHeight: Integer; virtual;
 925
 926     { @returns the width of the texture or 1 if the width is zero }
 927     function GetFileWidth:  Integer; virtual;
 928
 929     { @returns the height of the texture or 1 if the height is zero }
 930     function GetFileHeight: Integer; virtual;
 931
 932   protected
 933     { set a new value for fCustomData }
 934     procedure SetCustomData(const aValue: Pointer);
 935
 936     { set a new value for fCustomName }
 937     procedure SetCustomName(const aValue: String);
 938
 939     { set a new value for fCustomNameW }
 940     procedure SetCustomNameW(const aValue: WideString);
 941
 942     { set new value for fFreeDataOnDestroy }
 943     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 944
 945     { set new value for fDeleteTextureOnFree }
 946     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 947
 948     { set new value for the data format. only possible if new format has the same pixel size.
 949       if you want to convert the texture data, see ConvertTo function }
 950     procedure SetFormat(const aValue: TglBitmapFormat);
 951
 952     { set new value for fFreeDataAfterGenTexture }
 953     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 954
 955     { set name of OpenGL texture object }
 956     procedure SetID(const aValue: Cardinal);
 957
 958     { set new value for fMipMap }
 959     procedure SetMipMap(const aValue: TglBitmapMipMap);
 960
 961     { set new value for target }
 962     procedure SetTarget(const aValue: Cardinal);
 963
 964     { set new value for fAnisotrophic }
 965     procedure SetAnisotropic(const aValue: Integer);
 966
 967   protected
 968     { create OpenGL texture object (delete exisiting object if exists) }
 969     procedure CreateID;
 970
 971     { setup texture parameters }
 972     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
 973
 974     { set data pointer of texture data
 975         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
 976         @param aFormat  format of the data stored at aData
 977         @param aWidth   width of the texture data
 978         @param aHeight  height of the texture data }
 979     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 980       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 981
 982     { generate texture (upload texture data to video card)
 983         @param aTestTextureSize   test texture size before uploading and raise exception if something is wrong }
 984     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 985
 986     { flip texture horizontal
 987         @returns @true in success, @false otherwise }
 988     function FlipHorz: Boolean; virtual;
 989
 990     { flip texture vertical
 991         @returns @true in success, @false otherwise }
 992     function FlipVert: Boolean; virtual;
 993
 994   protected
 995     property Width:  Integer read GetWidth;             //< the actual width of the texture
 996     property Height: Integer read GetHeight;            //< the actual height of the texture
 997
 998     property FileWidth:  Integer read GetFileWidth;     //< the width of the texture or 1 if the width is zero
 999     property FileHeight: Integer read GetFileHeight;    //< the height of the texture or 1 if the height is zero
1000   public
1001     property ID:           Cardinal        read fID          write SetID;           //< name of the OpenGL texture object
1002     property Target:       Cardinal        read fTarget      write SetTarget;       //< texture target (e.g. GL_TEXTURE_2D)
1003     property Format:       TglBitmapFormat read fFormat      write SetFormat;       //< format the texture data is stored in
1004     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1005     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1006
1007     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;      //< format descriptor that describes the format of the stored data
1008
1009     property Filename:    String     read fFilename;                          //< filename the texture was load from
1010     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1011     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1012     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1013
1014     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;     //< delete texture object when this object is destroyed
1015     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;       //< free stored data when this object is destroyed
1016     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card
1017
1018     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1019     property Data:       PByte         read fData;          //< texture data (or @nil if unset)
1020 {$IFNDEF OPENGL_ES}
1021     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1022 {$ENDIF}
1023
1024     { this method is called after the constructor and sets the default values of this object }
1025     procedure AfterConstruction; override;
1026
1027     { this method is called before the destructor and does some cleanup }
1028     procedure BeforeDestruction; override;
1029
1030     { splits a resource identifier into the resource and it's type
1031         @param aResource  resource identifier to split and store name in
1032         @param aResType   type of the resource }
1033     procedure PrepareResType(var aResource: String; var aResType: PChar);
1034
1035   public
1036     { load a texture from a file
1037         @param aFilename file to load texuture from }
1038     procedure LoadFromFile(const aFilename: String);
1039
1040     { load a texture from a stream
1041         @param aStream  stream to load texture from }
1042     procedure LoadFromStream(const aStream: TStream); virtual;
1043
1044     { use a function to generate texture data
1045         @param aSize    size of the texture
1046         @param aFunc    callback to use for generation
1047         @param aFormat  format of the texture data
1048         @param aArgs    user defined paramaters (use at will) }
1049     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
1050       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1051
1052     { load a texture from a resource
1053         @param aInstance  resource handle
1054         @param aResource  resource indentifier
1055         @param aResType   resource type (if known) }
1056     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1057
1058     { load a texture from a resource id
1059         @param aInstance  resource handle
1060         @param aResource  resource ID
1061         @param aResType   resource type }
1062     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1063
1064   public
1065     { save texture data to a file
1066         @param aFilename  filename to store texture in
1067         @param aFileType  file type to store data into }
1068     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
1069
1070     { save texture data to a stream
1071         @param aFilename  filename to store texture in
1072         @param aFileType  file type to store data into }
1073     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1074
1075   public
1076     { convert texture data using a user defined callback
1077         @param aFunc        callback to use for converting
1078         @param aCreateTemp  create a temporary buffer to use for converting
1079         @param aArgs        user defined paramters (use at will)
1080         @returns            @true if converting was successful, @false otherwise }
1081     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1082
1083     { convert texture data using a user defined callback
1084         @param aSource      glBitmap to read data from
1085         @param aFunc        callback to use for converting
1086         @param aCreateTemp  create a temporary buffer to use for converting
1087         @param aFormat      format of the new data
1088         @param aArgs        user defined paramters (use at will)
1089         @returns            @true if converting was successful, @false otherwise }
1090     function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1091       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1092
1093     { convert texture data using a specific format
1094         @param aFormat  new format of texture data
1095         @returns        @true if converting was successful, @false otherwise }
1096     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1097
1098 {$IFDEF GLB_SDL}
1099   public
1100     { assign texture data to SDL surface
1101         @param aSurface SDL surface to write data to
1102         @returns        @true on success, @false otherwise }
1103     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1104
1105     { assign texture data from SDL surface
1106         @param aSurface SDL surface to read data from
1107         @returns        @true on success, @false otherwise }
1108     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1109
1110     { assign alpha channel data to SDL surface
1111         @param aSurface SDL surface to write alpha channel data to
1112         @returns        @true on success, @false otherwise }
1113     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1114
1115     { assign alpha channel data from SDL surface
1116         @param aSurface SDL surface to read data from
1117         @param aFunc    callback to use for converting
1118         @param aArgs    user defined parameters (use at will)
1119         @returns        @true on success, @false otherwise }
1120     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1121 {$ENDIF}
1122
1123 {$IFDEF GLB_DELPHI}
1124   public
1125     { assign texture data to TBitmap object
1126         @param aBitmap  TBitmap to write data to
1127         @returns        @true on success, @false otherwise }
1128     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1129
1130     { assign texture data from TBitmap object
1131         @param aBitmap  TBitmap to read data from
1132         @returns        @true on success, @false otherwise }
1133     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1134
1135     { assign alpha channel data to TBitmap object
1136         @param aBitmap  TBitmap to write data to
1137         @returns        @true on success, @false otherwise }
1138     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1139
1140     { assign alpha channel data from TBitmap object
1141         @param aBitmap  TBitmap to read data from
1142         @param aFunc    callback to use for converting
1143         @param aArgs    user defined parameters (use at will)
1144         @returns        @true on success, @false otherwise }
1145     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1146 {$ENDIF}
1147
1148 {$IFDEF GLB_LAZARUS}
1149   public
1150     { assign texture data to TLazIntfImage object
1151         @param aImage   TLazIntfImage to write data to
1152         @returns        @true on success, @false otherwise }
1153     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1154
1155     { assign texture data from TLazIntfImage object
1156         @param aImage   TLazIntfImage to read data from
1157         @returns        @true on success, @false otherwise }
1158     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1159
1160     { assign alpha channel data to TLazIntfImage object
1161         @param aImage   TLazIntfImage to write data to
1162         @returns        @true on success, @false otherwise }
1163     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1164
1165     { assign alpha channel data from TLazIntfImage object
1166         @param aImage   TLazIntfImage to read data from
1167         @param aFunc    callback to use for converting
1168         @param aArgs    user defined parameters (use at will)
1169         @returns        @true on success, @false otherwise }
1170     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1171 {$ENDIF}
1172
1173   public
1174     { load alpha channel data from resource
1175         @param aInstance  resource handle
1176         @param aResource  resource ID
1177         @param aResType   resource type
1178         @param aFunc      callback to use for converting
1179         @param aArgs      user defined parameters (use at will)
1180         @returns          @true on success, @false otherwise }
1181     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1182
1183     { load alpha channel data from resource ID
1184         @param aInstance    resource handle
1185         @param aResourceID  resource ID
1186         @param aResType     resource type
1187         @param aFunc        callback to use for converting
1188         @param aArgs        user defined parameters (use at will)
1189         @returns            @true on success, @false otherwise }
1190     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1191
1192     { add alpha channel data from function
1193         @param aFunc  callback to get data from
1194         @param aArgs  user defined parameters (use at will)
1195         @returns      @true on success, @false otherwise }
1196     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1197
1198     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
1199         @param aFilename  file to load alpha channel data from
1200         @param aFunc      callback to use for converting
1201         @param aArgs      user defined parameters (use at will)
1202         @returns          @true on success, @false otherwise }
1203     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1204
1205     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
1206         @param aStream  stream to load alpha channel data from
1207         @param aFunc    callback to use for converting
1208         @param aArgs    user defined parameters (use at will)
1209         @returns        @true on success, @false otherwise }
1210     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1211
1212     { add alpha channel data from existing glBitmap object
1213         @param aBitmap  TglBitmap to copy alpha channel data from
1214         @param aFunc    callback to use for converting
1215         @param aArgs    user defined parameters (use at will)
1216         @returns        @true on success, @false otherwise }
1217     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1218
1219     { add alpha to pixel if the pixels color is greter than the given color value
1220         @param aRed         red threshold (0-255)
1221         @param aGreen       green threshold (0-255)
1222         @param aBlue        blue threshold (0-255)
1223         @param aDeviatation accepted deviatation (0-255)
1224         @returns            @true on success, @false otherwise }
1225     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1226
1227     { add alpha to pixel if the pixels color is greter than the given color value
1228         @param aRed         red threshold (0-Range.r)
1229         @param aGreen       green threshold (0-Range.g)
1230         @param aBlue        blue threshold (0-Range.b)
1231         @param aDeviatation accepted deviatation (0-max(Range.rgb))
1232         @returns            @true on success, @false otherwise }
1233     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1234
1235     { add alpha to pixel if the pixels color is greter than the given color value
1236         @param aRed         red threshold (0.0-1.0)
1237         @param aGreen       green threshold (0.0-1.0)
1238         @param aBlue        blue threshold (0.0-1.0)
1239         @param aDeviatation accepted deviatation (0.0-1.0)
1240         @returns            @true on success, @false otherwise }
1241     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1242
1243     { add a constand alpha value to all pixels
1244         @param aAlpha alpha value to add (0-255)
1245         @returns      @true on success, @false otherwise }
1246     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1247
1248     { add a constand alpha value to all pixels
1249         @param aAlpha alpha value to add (0-max(Range.rgb))
1250         @returns      @true on success, @false otherwise }
1251     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1252
1253     { add a constand alpha value to all pixels
1254         @param aAlpha alpha value to add (0.0-1.0)
1255         @returns      @true on success, @false otherwise }
1256     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1257
1258     { remove alpha channel
1259         @returns  @true on success, @false otherwise }
1260     function RemoveAlpha: Boolean; virtual;
1261
1262   public
1263     { create a clone of the current object
1264         @returns clone of this object}
1265     function Clone: TglBitmap;
1266
1267     { invert color data (xor)
1268         @param aUseRGB   xor each color channel
1269         @param aUseAlpha xor alpha channel }
1270     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1271
1272     { free texture stored data }
1273     procedure FreeData;
1274
1275 {$IFNDEF OPENGL_ES}
1276     { set the new value for texture border color
1277         @param aRed   red color for border (0.0-1.0)
1278         @param aGreen green color for border (0.0-1.0)
1279         @param aBlue  blue color for border (0.0-1.0)
1280         @param aAlpha alpha color for border (0.0-1.0) }
1281     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1282 {$ENDIF}
1283
1284   public
1285     { fill complete texture with one color
1286         @param aRed   red color for border (0-255)
1287         @param aGreen green color for border (0-255)
1288         @param aBlue  blue color for border (0-255)
1289         @param aAlpha alpha color for border (0-255) }
1290     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1291
1292     { fill complete texture with one color
1293         @param aRed   red color for border (0-Range.r)
1294         @param aGreen green color for border (0-Range.g)
1295         @param aBlue  blue color for border (0-Range.b)
1296         @param aAlpha alpha color for border (0-Range.a) }
1297     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1298
1299     { fill complete texture with one color
1300         @param aRed   red color for border (0.0-1.0)
1301         @param aGreen green color for border (0.0-1.0)
1302         @param aBlue  blue color for border (0.0-1.0)
1303         @param aAlpha alpha color for border (0.0-1.0) }
1304     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
1305
1306   public
1307     { set new texture filer
1308         @param aMin   min filter
1309         @param aMag   mag filter }
1310     procedure SetFilter(const aMin, aMag: GLenum);
1311
1312     { set new texture wrapping
1313         @param S  texture wrapping for x axis
1314         @param T  texture wrapping for y axis
1315         @param R  texture wrapping for z axis }
1316     procedure SetWrap(
1317       const S: GLenum = GL_CLAMP_TO_EDGE;
1318       const T: GLenum = GL_CLAMP_TO_EDGE;
1319       const R: GLenum = GL_CLAMP_TO_EDGE);
1320
1321 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1322     { set new swizzle
1323         @param r  swizzle for red channel
1324         @param g  swizzle for green channel
1325         @param b  swizzle for blue channel
1326         @param a  swizzle for alpha channel }
1327     procedure SetSwizzle(const r, g, b, a: GLenum);
1328 {$IFEND}
1329
1330   public
1331     { bind texture
1332         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1333     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1334
1335     { bind texture
1336         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1337     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1338
1339   public
1340     { constructor - created an empty texture }
1341     constructor Create; overload;
1342
1343     { constructor - creates a texture and load it from a file
1344         @param aFilename file to load texture from }
1345     constructor Create(const aFileName: String); overload;
1346
1347     { constructor - creates a texture and load it from a stream
1348         @param aStream stream to load texture from }
1349     constructor Create(const aStream: TStream); overload;
1350
1351     { constructor - creates a texture with the given size, format and data
1352         @param aSize    size of the texture
1353         @param aFormat  format of the given data
1354         @param aData    texture data - be carefull: the data will now be managed by the glBitmap object,
1355                         you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }
1356     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1357
1358     { constructor - creates a texture with the given size and format and uses the given callback to create the data
1359         @param aSize    size of the texture
1360         @param aFormat  format of the given data
1361         @param aFunc    callback to use for generating the data
1362         @param aArgs    user defined parameters (use at will) }
1363     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1364
1365     { constructor - creates a texture and loads it from a resource
1366         @param aInstance  resource handle
1367         @param aResource  resource indentifier
1368         @param aResType   resource type (if known) }
1369     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1370
1371     { constructor - creates a texture and loads it from a resource
1372         @param aInstance    resource handle
1373         @param aResourceID  resource ID
1374         @param aResType     resource type (if known) }
1375     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1376
1377   private
1378 {$IFDEF GLB_SUPPORT_PNG_READ}
1379     { try to load a PNG from a stream
1380         @param aStream  stream to load PNG from
1381         @returns        @true on success, @false otherwise }
1382     function  LoadPNG(const aStream: TStream): Boolean; virtual;
1383 {$ENDIF}
1384
1385 {$ifdef GLB_SUPPORT_PNG_WRITE}
1386     { save texture data as PNG to stream
1387         @param aStream stream to save data to}
1388     procedure SavePNG(const aStream: TStream); virtual;
1389 {$ENDIF}
1390
1391 {$IFDEF GLB_SUPPORT_JPEG_READ}
1392     { try to load a JPEG from a stream
1393         @param aStream  stream to load JPEG from
1394         @returns        @true on success, @false otherwise }
1395     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
1396 {$ENDIF}
1397
1398 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1399     { save texture data as JPEG to stream
1400         @param aStream stream to save data to}
1401     procedure SaveJPEG(const aStream: TStream); virtual;
1402 {$ENDIF}
1403
1404     { try to load a RAW image from a stream
1405         @param aStream  stream to load RAW image from
1406         @returns        @true on success, @false otherwise }
1407     function LoadRAW(const aStream: TStream): Boolean;
1408
1409     { save texture data as RAW image to stream
1410         @param aStream stream to save data to}
1411     procedure SaveRAW(const aStream: TStream);
1412
1413     { try to load a BMP from a stream
1414         @param aStream  stream to load BMP from
1415         @returns        @true on success, @false otherwise }
1416     function LoadBMP(const aStream: TStream): Boolean;
1417
1418     { save texture data as BMP to stream
1419         @param aStream stream to save data to}
1420     procedure SaveBMP(const aStream: TStream);
1421
1422     { try to load a TGA from a stream
1423         @param aStream  stream to load TGA from
1424         @returns        @true on success, @false otherwise }
1425     function LoadTGA(const aStream: TStream): Boolean;
1426
1427     { save texture data as TGA to stream
1428         @param aStream stream to save data to}
1429     procedure SaveTGA(const aStream: TStream);
1430
1431     { try to load a DDS from a stream
1432         @param aStream  stream to load DDS from
1433         @returns        @true on success, @false otherwise }
1434     function LoadDDS(const aStream: TStream): Boolean;
1435
1436     { save texture data as DDS to stream
1437         @param aStream stream to save data to}
1438     procedure SaveDDS(const aStream: TStream);
1439   end;
1440
1441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1442 {$IF NOT DEFINED(OPENGL_ES)}
1443   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }
1444   TglBitmap1D = class(TglBitmap)
1445   protected
1446     { set data pointer of texture data
1447         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1448         @param aFormat  format of the data stored at aData
1449         @param aWidth   width of the texture data
1450         @param aHeight  height of the texture data }
1451     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1452
1453     { upload the texture data to video card
1454         @param aBuildWithGlu  use glu functions to build mipmaps }
1455     procedure UploadData(const aBuildWithGlu: Boolean);
1456   public
1457     property Width; //< actual with of the texture
1458
1459     { this method is called after constructor and initializes the object }
1460     procedure AfterConstruction; override;
1461
1462     { flip texture horizontally
1463         @returns @true on success, @fals otherwise }
1464     function FlipHorz: Boolean; override;
1465
1466     { generate texture (create texture object if not exist, set texture parameters and upload data
1467         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1468     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1469   end;
1470 {$IFEND}
1471
1472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1473   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }
1474   TglBitmap2D = class(TglBitmap)
1475   protected
1476     fLines: array of PByte; //< array to store scanline entry points in
1477
1478     { get a specific scanline
1479         @param aIndex   index of the scanline to return
1480         @returns        scanline at position aIndex or @nil }
1481     function GetScanline(const aIndex: Integer): Pointer;
1482
1483     { set data pointer of texture data
1484         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1485         @param aFormat  format of the data stored at aData
1486         @param aWidth   width of the texture data
1487         @param aHeight  height of the texture data }
1488     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1489       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1490
1491     { upload the texture data to video card
1492         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1493         @param aBuildWithGlu  use glu functions to build mipmaps }
1494     procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1495   public
1496     property Width;                                                       //< actual width of the texture
1497     property Height;                                                      //< actual height of the texture
1498     property Scanline[const aIndex: Integer]: Pointer read GetScanline;   //< scanline to access texture data directly
1499
1500     { this method is called after constructor and initializes the object }
1501     procedure AfterConstruction; override;
1502
1503     { copy a part of the frame buffer top the texture
1504         @param aTop     topmost pixel to copy
1505         @param aLeft    leftmost pixel to copy
1506         @param aRight   rightmost pixel to copy
1507         @param aBottom  bottommost pixel to copy
1508         @param aFormat  format to store data in }
1509     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1510
1511 {$IFNDEF OPENGL_ES}
1512     { downlaod texture data from OpenGL texture object }
1513     procedure GetDataFromTexture;
1514 {$ENDIF}
1515
1516     { generate texture (create texture object if not exist, set texture parameters and upload data)
1517         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1518     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1519
1520     { flip texture horizontally
1521         @returns @true on success, @false otherwise }
1522     function FlipHorz: Boolean; override;
1523
1524     { flip texture vertically
1525         @returns @true on success, @false otherwise }
1526     function FlipVert: Boolean; override;
1527
1528     { create normal map from texture data
1529         @param aFunc      normal map function to generate normalmap with
1530         @param aScale     scale of the normale stored in the normal map
1531         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
1532     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1533       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1534   end;
1535
1536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1537 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1538   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }
1539   TglBitmapCubeMap = class(TglBitmap2D)
1540   protected
1541   {$IFNDEF OPENGL_ES}
1542     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1543   {$ENDIF}
1544
1545     { generate texture (create texture object if not exist, set texture parameters and upload data
1546       do not call directly for cubemaps, use GenerateCubeMap instead
1547         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1548     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1549   public
1550     { this method is called after constructor and initializes the object }
1551     procedure AfterConstruction; override;
1552
1553     { generate texture (create texture object if not exist, set texture parameters and upload data
1554         @param aCubeTarget        cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1555         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1556     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1557
1558     { bind texture
1559         @param aEnableTexCoordsGen  enable cube map generator
1560         @param aEnableTextureUnit   enable texture unit }
1561     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1562
1563     { unbind texture
1564         @param aDisableTexCoordsGen   disable cube map generator
1565         @param aDisableTextureUnit    disable texture unit }
1566     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1567   end;
1568 {$IFEND}
1569
1570 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1572   { wrapper class for cube normal maps }
1573   TglBitmapNormalMap = class(TglBitmapCubeMap)
1574   public
1575     { this method is called after constructor and initializes the object }
1576     procedure AfterConstruction; override;
1577
1578     { create cube normal map from texture data and upload it to video card
1579         @param aSize              size of each cube map texture
1580         @param aTestTextureSize   check texture size when uploading and throw exception if something is wrong  }
1581     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1582   end;
1583 {$IFEND}
1584
1585 const
1586   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1587
1588 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1589 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1590 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1591 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1592 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1593 procedure glBitmapSetDefaultWrap(
1594   const S: Cardinal = GL_CLAMP_TO_EDGE;
1595   const T: Cardinal = GL_CLAMP_TO_EDGE;
1596   const R: Cardinal = GL_CLAMP_TO_EDGE);
1597
1598 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1599 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1600 {$IFEND}
1601
1602 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1603 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1604 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1605 function glBitmapGetDefaultFormat: TglBitmapFormat;
1606 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1607 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1608 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1609 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1610 {$IFEND}
1611
1612 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1613 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1614 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1615 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1616 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1617 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1618 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1619
1620 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1621
1622 {$IFDEF GLB_DELPHI}
1623 function CreateGrayPalette: HPALETTE;
1624 {$ENDIF}
1625
1626 implementation
1627
1628 uses
1629   Math, syncobjs, typinfo
1630   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1631
1632
1633 var
1634   glBitmapDefaultDeleteTextureOnFree: Boolean;
1635   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1636   glBitmapDefaultFormat: TglBitmapFormat;
1637   glBitmapDefaultMipmap: TglBitmapMipMap;
1638   glBitmapDefaultFilterMin: Cardinal;
1639   glBitmapDefaultFilterMag: Cardinal;
1640   glBitmapDefaultWrapS: Cardinal;
1641   glBitmapDefaultWrapT: Cardinal;
1642   glBitmapDefaultWrapR: Cardinal;
1643   glDefaultSwizzle: array[0..3] of GLenum;
1644
1645 ////////////////////////////////////////////////////////////////////////////////////////////////////
1646 type
1647   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1648   public
1649     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1650     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1651
1652     function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
1653     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1654
1655     function CreateMappingData: Pointer; virtual;
1656     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1657
1658     function IsEmpty: Boolean; virtual;
1659     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1660
1661     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1662
1663     constructor Create; virtual;
1664   public
1665     class procedure Init;
1666     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1667     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1668     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1669     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1670     class procedure Clear;
1671     class procedure Finalize;
1672   end;
1673   TFormatDescriptorClass = class of TFormatDescriptor;
1674
1675   TfdEmpty = class(TFormatDescriptor);
1676
1677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1678   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1679     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1680     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1681   end;
1682
1683   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1684     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1685     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1686   end;
1687
1688   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1689     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1690     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1691   end;
1692
1693   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1694     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1695     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1696   end;
1697
1698   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1699     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1700     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1701   end;
1702
1703   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1704     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1705     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1706   end;
1707
1708   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1709     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1710     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1711   end;
1712
1713   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1714     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1715     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1716   end;
1717
1718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1719   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1720     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1721     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1722   end;
1723
1724   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1725     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1726     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1727   end;
1728
1729   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1730     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1731     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1732   end;
1733
1734   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1735     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1736     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1737   end;
1738
1739   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1740     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1741     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1742   end;
1743
1744   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1745     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1746     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1747   end;
1748
1749   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1750     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1751     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1752   end;
1753
1754   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1755     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1756     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1757   end;
1758
1759   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1760     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1761     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1762   end;
1763
1764   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1765     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1766     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1767   end;
1768
1769   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1770     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1771     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1772   end;
1773
1774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1775   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1776     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1777     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1778   end;
1779
1780   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1781     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1782     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1783   end;
1784
1785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1786   TfdAlpha4ub1 = class(TfdAlphaUB1)
1787     procedure SetValues; override;
1788   end;
1789
1790   TfdAlpha8ub1 = class(TfdAlphaUB1)
1791     procedure SetValues; override;
1792   end;
1793
1794   TfdAlpha16us1 = class(TfdAlphaUS1)
1795     procedure SetValues; override;
1796   end;
1797
1798   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1799     procedure SetValues; override;
1800   end;
1801
1802   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1803     procedure SetValues; override;
1804   end;
1805
1806   TfdLuminance16us1 = class(TfdLuminanceUS1)
1807     procedure SetValues; override;
1808   end;
1809
1810   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1811     procedure SetValues; override;
1812   end;
1813
1814   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1815     procedure SetValues; override;
1816   end;
1817
1818   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1819     procedure SetValues; override;
1820   end;
1821
1822   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1823     procedure SetValues; override;
1824   end;
1825
1826   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1827     procedure SetValues; override;
1828   end;
1829
1830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1831   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1832     procedure SetValues; override;
1833   end;
1834
1835   TfdRGBX4us1 = class(TfdUniversalUS1)
1836     procedure SetValues; override;
1837   end;
1838
1839   TfdXRGB4us1 = class(TfdUniversalUS1)
1840     procedure SetValues; override;
1841   end;
1842
1843   TfdR5G6B5us1 = class(TfdUniversalUS1)
1844     procedure SetValues; override;
1845   end;
1846
1847   TfdRGB5X1us1 = class(TfdUniversalUS1)
1848     procedure SetValues; override;
1849   end;
1850
1851   TfdX1RGB5us1 = class(TfdUniversalUS1)
1852     procedure SetValues; override;
1853   end;
1854
1855   TfdRGB8ub3 = class(TfdRGBub3)
1856     procedure SetValues; override;
1857   end;
1858
1859   TfdRGBX8ui1 = class(TfdUniversalUI1)
1860     procedure SetValues; override;
1861   end;
1862
1863   TfdXRGB8ui1 = class(TfdUniversalUI1)
1864     procedure SetValues; override;
1865   end;
1866
1867   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1868     procedure SetValues; override;
1869   end;
1870
1871   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1872     procedure SetValues; override;
1873   end;
1874
1875   TfdRGB16us3 = class(TfdRGBus3)
1876     procedure SetValues; override;
1877   end;
1878
1879   TfdRGBA4us1 = class(TfdUniversalUS1)
1880     procedure SetValues; override;
1881   end;
1882
1883   TfdARGB4us1 = class(TfdUniversalUS1)
1884     procedure SetValues; override;
1885   end;
1886
1887   TfdRGB5A1us1 = class(TfdUniversalUS1)
1888     procedure SetValues; override;
1889   end;
1890
1891   TfdA1RGB5us1 = class(TfdUniversalUS1)
1892     procedure SetValues; override;
1893   end;
1894
1895   TfdRGBA8ui1 = class(TfdUniversalUI1)
1896     procedure SetValues; override;
1897   end;
1898
1899   TfdARGB8ui1 = class(TfdUniversalUI1)
1900     procedure SetValues; override;
1901   end;
1902
1903   TfdRGBA8ub4 = class(TfdRGBAub4)
1904     procedure SetValues; override;
1905   end;
1906
1907   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1908     procedure SetValues; override;
1909   end;
1910
1911   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1912     procedure SetValues; override;
1913   end;
1914
1915   TfdRGBA16us4 = class(TfdRGBAus4)
1916     procedure SetValues; override;
1917   end;
1918
1919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1920   TfdBGRX4us1 = class(TfdUniversalUS1)
1921     procedure SetValues; override;
1922   end;
1923
1924   TfdXBGR4us1 = class(TfdUniversalUS1)
1925     procedure SetValues; override;
1926   end;
1927
1928   TfdB5G6R5us1 = class(TfdUniversalUS1)
1929     procedure SetValues; override;
1930   end;
1931
1932   TfdBGR5X1us1 = class(TfdUniversalUS1)
1933     procedure SetValues; override;
1934   end;
1935
1936   TfdX1BGR5us1 = class(TfdUniversalUS1)
1937     procedure SetValues; override;
1938   end;
1939
1940   TfdBGR8ub3 = class(TfdBGRub3)
1941     procedure SetValues; override;
1942   end;
1943
1944   TfdBGRX8ui1 = class(TfdUniversalUI1)
1945     procedure SetValues; override;
1946   end;
1947
1948   TfdXBGR8ui1 = class(TfdUniversalUI1)
1949     procedure SetValues; override;
1950   end;
1951
1952   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1953     procedure SetValues; override;
1954   end;
1955
1956   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1957     procedure SetValues; override;
1958   end;
1959
1960   TfdBGR16us3 = class(TfdBGRus3)
1961     procedure SetValues; override;
1962   end;
1963
1964   TfdBGRA4us1 = class(TfdUniversalUS1)
1965     procedure SetValues; override;
1966   end;
1967
1968   TfdABGR4us1 = class(TfdUniversalUS1)
1969     procedure SetValues; override;
1970   end;
1971
1972   TfdBGR5A1us1 = class(TfdUniversalUS1)
1973     procedure SetValues; override;
1974   end;
1975
1976   TfdA1BGR5us1 = class(TfdUniversalUS1)
1977     procedure SetValues; override;
1978   end;
1979
1980   TfdBGRA8ui1 = class(TfdUniversalUI1)
1981     procedure SetValues; override;
1982   end;
1983
1984   TfdABGR8ui1 = class(TfdUniversalUI1)
1985     procedure SetValues; override;
1986   end;
1987
1988   TfdBGRA8ub4 = class(TfdBGRAub4)
1989     procedure SetValues; override;
1990   end;
1991
1992   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1993     procedure SetValues; override;
1994   end;
1995
1996   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1997     procedure SetValues; override;
1998   end;
1999
2000   TfdBGRA16us4 = class(TfdBGRAus4)
2001     procedure SetValues; override;
2002   end;
2003
2004   TfdDepth16us1 = class(TfdDepthUS1)
2005     procedure SetValues; override;
2006   end;
2007
2008   TfdDepth24ui1 = class(TfdDepthUI1)
2009     procedure SetValues; override;
2010   end;
2011
2012   TfdDepth32ui1 = class(TfdDepthUI1)
2013     procedure SetValues; override;
2014   end;
2015
2016   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
2017     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
2018     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
2019     procedure SetValues; override;
2020   end;
2021
2022   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
2023     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
2024     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
2025     procedure SetValues; override;
2026   end;
2027
2028   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
2029     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
2030     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
2031     procedure SetValues; override;
2032   end;
2033
2034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2035   TbmpBitfieldFormat = class(TFormatDescriptor)
2036   public
2037     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
2038     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
2039     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
2040     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
2041   end;
2042
2043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2044   TbmpColorTableEnty = packed record
2045     b, g, r, a: Byte;
2046   end;
2047   TbmpColorTable = array of TbmpColorTableEnty;
2048   TbmpColorTableFormat = class(TFormatDescriptor)
2049   private
2050     fBitsPerPixel: Integer;
2051     fColorTable: TbmpColorTable;
2052   protected
2053     procedure SetValues; override;
2054   public
2055     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
2056     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
2057
2058     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
2059     procedure CalcValues;
2060     procedure CreateColorTable;
2061
2062     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
2063     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
2064     destructor Destroy; override;
2065   end;
2066
2067 const
2068   LUMINANCE_WEIGHT_R = 0.30;
2069   LUMINANCE_WEIGHT_G = 0.59;
2070   LUMINANCE_WEIGHT_B = 0.11;
2071
2072   ALPHA_WEIGHT_R = 0.30;
2073   ALPHA_WEIGHT_G = 0.59;
2074   ALPHA_WEIGHT_B = 0.11;
2075
2076   DEPTH_WEIGHT_R = 0.333333333;
2077   DEPTH_WEIGHT_G = 0.333333333;
2078   DEPTH_WEIGHT_B = 0.333333333;
2079
2080   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
2081     TfdEmpty,
2082
2083     TfdAlpha4ub1,
2084     TfdAlpha8ub1,
2085     TfdAlpha16us1,
2086
2087     TfdLuminance4ub1,
2088     TfdLuminance8ub1,
2089     TfdLuminance16us1,
2090
2091     TfdLuminance4Alpha4ub2,
2092     TfdLuminance6Alpha2ub2,
2093     TfdLuminance8Alpha8ub2,
2094     TfdLuminance12Alpha4us2,
2095     TfdLuminance16Alpha16us2,
2096
2097     TfdR3G3B2ub1,
2098     TfdRGBX4us1,
2099     TfdXRGB4us1,
2100     TfdR5G6B5us1,
2101     TfdRGB5X1us1,
2102     TfdX1RGB5us1,
2103     TfdRGB8ub3,
2104     TfdRGBX8ui1,
2105     TfdXRGB8ui1,
2106     TfdRGB10X2ui1,
2107     TfdX2RGB10ui1,
2108     TfdRGB16us3,
2109
2110     TfdRGBA4us1,
2111     TfdARGB4us1,
2112     TfdRGB5A1us1,
2113     TfdA1RGB5us1,
2114     TfdRGBA8ui1,
2115     TfdARGB8ui1,
2116     TfdRGBA8ub4,
2117     TfdRGB10A2ui1,
2118     TfdA2RGB10ui1,
2119     TfdRGBA16us4,
2120
2121     TfdBGRX4us1,
2122     TfdXBGR4us1,
2123     TfdB5G6R5us1,
2124     TfdBGR5X1us1,
2125     TfdX1BGR5us1,
2126     TfdBGR8ub3,
2127     TfdBGRX8ui1,
2128     TfdXBGR8ui1,
2129     TfdBGR10X2ui1,
2130     TfdX2BGR10ui1,
2131     TfdBGR16us3,
2132
2133     TfdBGRA4us1,
2134     TfdABGR4us1,
2135     TfdBGR5A1us1,
2136     TfdA1BGR5us1,
2137     TfdBGRA8ui1,
2138     TfdABGR8ui1,
2139     TfdBGRA8ub4,
2140     TfdBGR10A2ui1,
2141     TfdA2BGR10ui1,
2142     TfdBGRA16us4,
2143
2144     TfdDepth16us1,
2145     TfdDepth24ui1,
2146     TfdDepth32ui1,
2147
2148     TfdS3tcDtx1RGBA,
2149     TfdS3tcDtx3RGBA,
2150     TfdS3tcDtx5RGBA
2151   );
2152
2153 var
2154   FormatDescriptorCS: TCriticalSection;
2155   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
2156
2157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2158 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
2159 begin
2160   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
2161 end;
2162
2163 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2164 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
2165 begin
2166   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
2167 end;
2168
2169 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
2171 begin
2172   result.Fields := [];
2173   if (X >= 0) then
2174     result.Fields := result.Fields + [ffX];
2175   if (Y >= 0) then
2176     result.Fields := result.Fields + [ffY];
2177   result.X := Max(0, X);
2178   result.Y := Max(0, Y);
2179 end;
2180
2181 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2182 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
2183 begin
2184   result := glBitmapSize(X, Y);
2185 end;
2186
2187 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
2189 begin
2190   result.r := r;
2191   result.g := g;
2192   result.b := b;
2193   result.a := a;
2194 end;
2195
2196 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
2198 begin
2199   result.r := r;
2200   result.g := g;
2201   result.b := b;
2202   result.a := a;
2203 end;
2204
2205 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2206 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
2207 begin
2208   result.r := r;
2209   result.g := g;
2210   result.b := b;
2211   result.a := a;
2212 end;
2213
2214 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2215 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
2216 var
2217   i: Integer;
2218 begin
2219   result := false;
2220   for i := 0 to high(r1.arr) do
2221     if (r1.arr[i] <> r2.arr[i]) then
2222       exit;
2223   result := true;
2224 end;
2225
2226 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2227 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
2228 var
2229   i: Integer;
2230 begin
2231   result := false;
2232   for i := 0 to high(r1.arr) do
2233     if (r1.arr[i] <> r2.arr[i]) then
2234       exit;
2235   result := true;
2236 end;
2237
2238 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
2240 var
2241   desc: TFormatDescriptor;
2242   p, tmp: PByte;
2243   x, y, i: Integer;
2244   md: Pointer;
2245   px: TglBitmapPixelData;
2246 begin
2247   result := nil;
2248   desc := TFormatDescriptor.Get(aFormat);
2249   if (desc.IsCompressed) or (desc.glFormat = 0) then
2250     exit;
2251
2252   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
2253   md := desc.CreateMappingData;
2254   try
2255     tmp := p;
2256     desc.PreparePixel(px);
2257     for y := 0 to 4 do
2258       for x := 0 to 4 do begin
2259         px.Data := glBitmapRec4ui(0, 0, 0, 0);
2260         for i := 0 to 3 do begin
2261           if ((y < 3) and (y = i)) or
2262              ((y = 3) and (i < 3)) or
2263              ((y = 4) and (i = 3))
2264           then
2265             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
2266           else if ((y < 4) and (i = 3)) or
2267                   ((y = 4) and (i < 3))
2268           then
2269             px.Data.arr[i] := px.Range.arr[i]
2270           else
2271             px.Data.arr[i] := 0; //px.Range.arr[i];
2272         end;
2273         desc.Map(px, tmp, md);
2274       end;
2275   finally
2276     desc.FreeMappingData(md);
2277   end;
2278
2279   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
2280   result.FreeDataOnDestroy       := true;
2281   result.FreeDataAfterGenTexture := false;
2282   result.SetFilter(GL_NEAREST, GL_NEAREST);
2283 end;
2284
2285 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2286 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
2287 begin
2288   result.r := r;
2289   result.g := g;
2290   result.b := b;
2291   result.a := a;
2292 end;
2293
2294 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
2296 begin
2297   result := [];
2298
2299   if (aFormat in [
2300         //8bpp
2301         tfAlpha4ub1, tfAlpha8ub1,
2302         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
2303
2304         //16bpp
2305         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2306         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
2307         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
2308
2309         //24bpp
2310         tfBGR8ub3, tfRGB8ub3,
2311
2312         //32bpp
2313         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
2314         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2315   then
2316     result := result + [ ftBMP ];
2317
2318   if (aFormat in [
2319         //8bbp
2320         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2321
2322         //16bbp
2323         tfAlpha16us1, tfLuminance16us1,
2324         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2325         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2326
2327         //24bbp
2328         tfBGR8ub3,
2329
2330         //32bbp
2331         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2332         tfDepth24ui1, tfDepth32ui1])
2333   then
2334     result := result + [ftTGA];
2335
2336   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2337     result := result + [ftDDS];
2338
2339 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2340   if aFormat in [
2341       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2342       tfRGB8ub3, tfRGBA8ui1,
2343       tfBGR8ub3, tfBGRA8ui1] then
2344     result := result + [ftPNG];
2345 {$ENDIF}
2346
2347 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2348   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2349     result := result + [ftJPEG];
2350 {$ENDIF}
2351 end;
2352
2353 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 function IsPowerOfTwo(aNumber: Integer): Boolean;
2355 begin
2356   while (aNumber and 1) = 0 do
2357     aNumber := aNumber shr 1;
2358   result := aNumber = 1;
2359 end;
2360
2361 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 function GetTopMostBit(aBitSet: QWord): Integer;
2363 begin
2364   result := 0;
2365   while aBitSet > 0 do begin
2366     inc(result);
2367     aBitSet := aBitSet shr 1;
2368   end;
2369 end;
2370
2371 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 function CountSetBits(aBitSet: QWord): Integer;
2373 begin
2374   result := 0;
2375   while aBitSet > 0 do begin
2376     if (aBitSet and 1) = 1 then
2377       inc(result);
2378     aBitSet := aBitSet shr 1;
2379   end;
2380 end;
2381
2382 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2384 begin
2385   result := Trunc(
2386     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2387     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2388     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2389 end;
2390
2391 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2393 begin
2394   result := Trunc(
2395     DEPTH_WEIGHT_R * aPixel.Data.r +
2396     DEPTH_WEIGHT_G * aPixel.Data.g +
2397     DEPTH_WEIGHT_B * aPixel.Data.b);
2398 end;
2399
2400 {$IFDEF GLB_NATIVE_OGL}
2401 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 var
2405   GL_LibHandle: Pointer = nil;
2406
2407 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2408 begin
2409   if not Assigned(aLibHandle) then
2410     aLibHandle := GL_LibHandle;
2411
2412 {$IF DEFINED(GLB_WIN)}
2413   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2414   if Assigned(result) then
2415     exit;
2416
2417   if Assigned(wglGetProcAddress) then
2418     result := wglGetProcAddress(aProcName);
2419 {$ELSEIF DEFINED(GLB_LINUX)}
2420   if Assigned(glXGetProcAddress) then begin
2421     result := glXGetProcAddress(aProcName);
2422     if Assigned(result) then
2423       exit;
2424   end;
2425
2426   if Assigned(glXGetProcAddressARB) then begin
2427     result := glXGetProcAddressARB(aProcName);
2428     if Assigned(result) then
2429       exit;
2430   end;
2431
2432   result := dlsym(aLibHandle, aProcName);
2433 {$IFEND}
2434   if not Assigned(result) and aRaiseOnErr then
2435     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2436 end;
2437
2438 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2439 var
2440   GLU_LibHandle: Pointer = nil;
2441   OpenGLInitialized: Boolean;
2442   InitOpenGLCS: TCriticalSection;
2443
2444 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2445 procedure glbInitOpenGL;
2446
2447   ////////////////////////////////////////////////////////////////////////////////
2448   function glbLoadLibrary(const aName: PChar): Pointer;
2449   begin
2450     {$IF DEFINED(GLB_WIN)}
2451     result := {%H-}Pointer(LoadLibrary(aName));
2452     {$ELSEIF DEFINED(GLB_LINUX)}
2453     result := dlopen(Name, RTLD_LAZY);
2454     {$ELSE}
2455     result := nil;
2456     {$IFEND}
2457   end;
2458
2459   ////////////////////////////////////////////////////////////////////////////////
2460   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2461   begin
2462     result := false;
2463     if not Assigned(aLibHandle) then
2464       exit;
2465
2466     {$IF DEFINED(GLB_WIN)}
2467     Result := FreeLibrary({%H-}HINST(aLibHandle));
2468     {$ELSEIF DEFINED(GLB_LINUX)}
2469     Result := dlclose(aLibHandle) = 0;
2470     {$IFEND}
2471   end;
2472
2473 begin
2474   if Assigned(GL_LibHandle) then
2475     glbFreeLibrary(GL_LibHandle);
2476
2477   if Assigned(GLU_LibHandle) then
2478     glbFreeLibrary(GLU_LibHandle);
2479
2480   GL_LibHandle := glbLoadLibrary(libopengl);
2481   if not Assigned(GL_LibHandle) then
2482     raise EglBitmap.Create('unable to load library: ' + libopengl);
2483
2484   GLU_LibHandle := glbLoadLibrary(libglu);
2485   if not Assigned(GLU_LibHandle) then
2486     raise EglBitmap.Create('unable to load library: ' + libglu);
2487
2488 {$IF DEFINED(GLB_WIN)}
2489   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2490 {$ELSEIF DEFINED(GLB_LINUX)}
2491   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2492   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2493 {$IFEND}
2494
2495   glEnable := glbGetProcAddress('glEnable');
2496   glDisable := glbGetProcAddress('glDisable');
2497   glGetString := glbGetProcAddress('glGetString');
2498   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2499   glTexParameteri := glbGetProcAddress('glTexParameteri');
2500   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2501   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2502   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2503   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2504   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2505   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2506   glTexGeni := glbGetProcAddress('glTexGeni');
2507   glGenTextures := glbGetProcAddress('glGenTextures');
2508   glBindTexture := glbGetProcAddress('glBindTexture');
2509   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2510   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2511   glReadPixels := glbGetProcAddress('glReadPixels');
2512   glPixelStorei := glbGetProcAddress('glPixelStorei');
2513   glTexImage1D := glbGetProcAddress('glTexImage1D');
2514   glTexImage2D := glbGetProcAddress('glTexImage2D');
2515   glGetTexImage := glbGetProcAddress('glGetTexImage');
2516
2517   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2518   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2519 end;
2520 {$ENDIF}
2521
2522 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2523 procedure glbReadOpenGLExtensions;
2524 var
2525   Buffer: AnsiString;
2526   MajorVersion, MinorVersion: Integer;
2527
2528   ///////////////////////////////////////////////////////////////////////////////////////////
2529   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2530   var
2531     Separator: Integer;
2532   begin
2533     aMinor := 0;
2534     aMajor := 0;
2535
2536     Separator := Pos(AnsiString('.'), aBuffer);
2537     if (Separator > 1) and (Separator < Length(aBuffer)) and
2538        (aBuffer[Separator - 1] in ['0'..'9']) and
2539        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2540
2541       Dec(Separator);
2542       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2543         Dec(Separator);
2544
2545       Delete(aBuffer, 1, Separator);
2546       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2547
2548       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2549         Inc(Separator);
2550
2551       Delete(aBuffer, Separator, 255);
2552       Separator := Pos(AnsiString('.'), aBuffer);
2553
2554       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2555       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2556     end;
2557   end;
2558
2559   ///////////////////////////////////////////////////////////////////////////////////////////
2560   function CheckExtension(const Extension: AnsiString): Boolean;
2561   var
2562     ExtPos: Integer;
2563   begin
2564     ExtPos := Pos(Extension, Buffer);
2565     result := ExtPos > 0;
2566     if result then
2567       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2568   end;
2569
2570   ///////////////////////////////////////////////////////////////////////////////////////////
2571   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2572   begin
2573     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2574   end;
2575
2576 begin
2577 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2578   InitOpenGLCS.Enter;
2579   try
2580     if not OpenGLInitialized then begin
2581       glbInitOpenGL;
2582       OpenGLInitialized := true;
2583     end;
2584   finally
2585     InitOpenGLCS.Leave;
2586   end;
2587 {$ENDIF}
2588
2589   // Version
2590   Buffer := glGetString(GL_VERSION);
2591   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2592
2593   GL_VERSION_1_2 := CheckVersion(1, 2);
2594   GL_VERSION_1_3 := CheckVersion(1, 3);
2595   GL_VERSION_1_4 := CheckVersion(1, 4);
2596   GL_VERSION_2_0 := CheckVersion(2, 0);
2597   GL_VERSION_3_3 := CheckVersion(3, 3);
2598
2599   // Extensions
2600   Buffer := glGetString(GL_EXTENSIONS);
2601   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2602   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2603   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2604   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2605   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2606   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2607   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2608   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2609   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2610   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2611   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2612   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2613   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2614   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2615
2616   if GL_VERSION_1_3 then begin
2617     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2618     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2619     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2620   end else begin
2621     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2622     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2623     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2624   end;
2625 end;
2626 {$ENDIF}
2627
2628 {$IFDEF GLB_SDL_IMAGE}
2629 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2630 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2631 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2632 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2633 begin
2634   result := TStream(context^.unknown.data1).Seek(offset, whence);
2635 end;
2636
2637 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2638 begin
2639   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2640 end;
2641
2642 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2643 begin
2644   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2645 end;
2646
2647 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2648 begin
2649   result := 0;
2650 end;
2651
2652 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2653 begin
2654   result := SDL_AllocRW;
2655
2656   if result = nil then
2657     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2658
2659   result^.seek := glBitmapRWseek;
2660   result^.read := glBitmapRWread;
2661   result^.write := glBitmapRWwrite;
2662   result^.close := glBitmapRWclose;
2663   result^.unknown.data1 := Stream;
2664 end;
2665 {$ENDIF}
2666
2667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2669 begin
2670   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2671 end;
2672
2673 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2674 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2675 begin
2676   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2677 end;
2678
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2681 begin
2682   glBitmapDefaultMipmap := aValue;
2683 end;
2684
2685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2687 begin
2688   glBitmapDefaultFormat := aFormat;
2689 end;
2690
2691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2692 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2693 begin
2694   glBitmapDefaultFilterMin := aMin;
2695   glBitmapDefaultFilterMag := aMag;
2696 end;
2697
2698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2700 begin
2701   glBitmapDefaultWrapS := S;
2702   glBitmapDefaultWrapT := T;
2703   glBitmapDefaultWrapR := R;
2704 end;
2705
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2708 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2709 begin
2710   glDefaultSwizzle[0] := r;
2711   glDefaultSwizzle[1] := g;
2712   glDefaultSwizzle[2] := b;
2713   glDefaultSwizzle[3] := a;
2714 end;
2715 {$IFEND}
2716
2717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2719 begin
2720   result := glBitmapDefaultDeleteTextureOnFree;
2721 end;
2722
2723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2724 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2725 begin
2726   result := glBitmapDefaultFreeDataAfterGenTextures;
2727 end;
2728
2729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2731 begin
2732   result := glBitmapDefaultMipmap;
2733 end;
2734
2735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 function glBitmapGetDefaultFormat: TglBitmapFormat;
2737 begin
2738   result := glBitmapDefaultFormat;
2739 end;
2740
2741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2743 begin
2744   aMin := glBitmapDefaultFilterMin;
2745   aMag := glBitmapDefaultFilterMag;
2746 end;
2747
2748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2749 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2750 begin
2751   S := glBitmapDefaultWrapS;
2752   T := glBitmapDefaultWrapT;
2753   R := glBitmapDefaultWrapR;
2754 end;
2755
2756 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2759 begin
2760   r := glDefaultSwizzle[0];
2761   g := glDefaultSwizzle[1];
2762   b := glDefaultSwizzle[2];
2763   a := glDefaultSwizzle[3];
2764 end;
2765 {$ENDIF}
2766
2767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2770 function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
2771 var
2772   w, h: Integer;
2773 begin
2774   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2775     w := Max(1, aSize.X);
2776     h := Max(1, aSize.Y);
2777     result := GetSize(w, h);
2778   end else
2779     result := 0;
2780 end;
2781
2782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2783 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2784 begin
2785   result := 0;
2786   if (aWidth <= 0) or (aHeight <= 0) then
2787     exit;
2788   result := Ceil(aWidth * aHeight * BytesPerPixel);
2789 end;
2790
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 function TFormatDescriptor.CreateMappingData: Pointer;
2793 begin
2794   result := nil;
2795 end;
2796
2797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2799 begin
2800   //DUMMY
2801 end;
2802
2803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2804 function TFormatDescriptor.IsEmpty: Boolean;
2805 begin
2806   result := (fFormat = tfEmpty);
2807 end;
2808
2809 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2810 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2811 var
2812   i: Integer;
2813   m: TglBitmapRec4ul;
2814 begin
2815   result := false;
2816   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2817     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2818   m := Mask;
2819   for i := 0 to 3 do
2820     if (aMask.arr[i] <> m.arr[i]) then
2821       exit;
2822   result := true;
2823 end;
2824
2825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2827 begin
2828   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2829   aPixel.Data   := Range;
2830   aPixel.Format := fFormat;
2831   aPixel.Range  := Range;
2832 end;
2833
2834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2835 constructor TFormatDescriptor.Create;
2836 begin
2837   inherited Create;
2838 end;
2839
2840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2843 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2844 begin
2845   aData^ := aPixel.Data.a;
2846   inc(aData);
2847 end;
2848
2849 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2850 begin
2851   aPixel.Data.r := 0;
2852   aPixel.Data.g := 0;
2853   aPixel.Data.b := 0;
2854   aPixel.Data.a := aData^;
2855   inc(aData);
2856 end;
2857
2858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2859 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2860 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2861 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2862 begin
2863   aData^ := LuminanceWeight(aPixel);
2864   inc(aData);
2865 end;
2866
2867 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2868 begin
2869   aPixel.Data.r := aData^;
2870   aPixel.Data.g := aData^;
2871   aPixel.Data.b := aData^;
2872   aPixel.Data.a := 0;
2873   inc(aData);
2874 end;
2875
2876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2877 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2879 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2880 var
2881   i: Integer;
2882 begin
2883   aData^ := 0;
2884   for i := 0 to 3 do
2885     if (Range.arr[i] > 0) then
2886       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2887   inc(aData);
2888 end;
2889
2890 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2891 var
2892   i: Integer;
2893 begin
2894   for i := 0 to 3 do
2895     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2896   inc(aData);
2897 end;
2898
2899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2900 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2902 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2903 begin
2904   inherited Map(aPixel, aData, aMapData);
2905   aData^ := aPixel.Data.a;
2906   inc(aData);
2907 end;
2908
2909 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2910 begin
2911   inherited Unmap(aData, aPixel, aMapData);
2912   aPixel.Data.a := aData^;
2913   inc(aData);
2914 end;
2915
2916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2917 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2920 begin
2921   aData^ := aPixel.Data.r;
2922   inc(aData);
2923   aData^ := aPixel.Data.g;
2924   inc(aData);
2925   aData^ := aPixel.Data.b;
2926   inc(aData);
2927 end;
2928
2929 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2930 begin
2931   aPixel.Data.r := aData^;
2932   inc(aData);
2933   aPixel.Data.g := aData^;
2934   inc(aData);
2935   aPixel.Data.b := aData^;
2936   inc(aData);
2937   aPixel.Data.a := 0;
2938 end;
2939
2940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2941 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2943 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2944 begin
2945   aData^ := aPixel.Data.b;
2946   inc(aData);
2947   aData^ := aPixel.Data.g;
2948   inc(aData);
2949   aData^ := aPixel.Data.r;
2950   inc(aData);
2951 end;
2952
2953 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2954 begin
2955   aPixel.Data.b := aData^;
2956   inc(aData);
2957   aPixel.Data.g := aData^;
2958   inc(aData);
2959   aPixel.Data.r := aData^;
2960   inc(aData);
2961   aPixel.Data.a := 0;
2962 end;
2963
2964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2965 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2967 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2968 begin
2969   inherited Map(aPixel, aData, aMapData);
2970   aData^ := aPixel.Data.a;
2971   inc(aData);
2972 end;
2973
2974 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2975 begin
2976   inherited Unmap(aData, aPixel, aMapData);
2977   aPixel.Data.a := aData^;
2978   inc(aData);
2979 end;
2980
2981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2982 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2983 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2984 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2985 begin
2986   inherited Map(aPixel, aData, aMapData);
2987   aData^ := aPixel.Data.a;
2988   inc(aData);
2989 end;
2990
2991 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2992 begin
2993   inherited Unmap(aData, aPixel, aMapData);
2994   aPixel.Data.a := aData^;
2995   inc(aData);
2996 end;
2997
2998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2999 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3002 begin
3003   PWord(aData)^ := aPixel.Data.a;
3004   inc(aData, 2);
3005 end;
3006
3007 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3008 begin
3009   aPixel.Data.r := 0;
3010   aPixel.Data.g := 0;
3011   aPixel.Data.b := 0;
3012   aPixel.Data.a := PWord(aData)^;
3013   inc(aData, 2);
3014 end;
3015
3016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3017 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3019 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3020 begin
3021   PWord(aData)^ := LuminanceWeight(aPixel);
3022   inc(aData, 2);
3023 end;
3024
3025 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3026 begin
3027   aPixel.Data.r := PWord(aData)^;
3028   aPixel.Data.g := PWord(aData)^;
3029   aPixel.Data.b := PWord(aData)^;
3030   aPixel.Data.a := 0;
3031   inc(aData, 2);
3032 end;
3033
3034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3037 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3038 var
3039   i: Integer;
3040 begin
3041   PWord(aData)^ := 0;
3042   for i := 0 to 3 do
3043     if (Range.arr[i] > 0) then
3044       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
3045   inc(aData, 2);
3046 end;
3047
3048 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3049 var
3050   i: Integer;
3051 begin
3052   for i := 0 to 3 do
3053     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
3054   inc(aData, 2);
3055 end;
3056
3057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3058 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3060 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3061 begin
3062   PWord(aData)^ := DepthWeight(aPixel);
3063   inc(aData, 2);
3064 end;
3065
3066 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3067 begin
3068   aPixel.Data.r := PWord(aData)^;
3069   aPixel.Data.g := PWord(aData)^;
3070   aPixel.Data.b := PWord(aData)^;
3071   aPixel.Data.a := PWord(aData)^;;
3072   inc(aData, 2);
3073 end;
3074
3075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3076 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3078 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3079 begin
3080   inherited Map(aPixel, aData, aMapData);
3081   PWord(aData)^ := aPixel.Data.a;
3082   inc(aData, 2);
3083 end;
3084
3085 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3086 begin
3087   inherited Unmap(aData, aPixel, aMapData);
3088   aPixel.Data.a := PWord(aData)^;
3089   inc(aData, 2);
3090 end;
3091
3092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3093 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3095 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3096 begin
3097   PWord(aData)^ := aPixel.Data.r;
3098   inc(aData, 2);
3099   PWord(aData)^ := aPixel.Data.g;
3100   inc(aData, 2);
3101   PWord(aData)^ := aPixel.Data.b;
3102   inc(aData, 2);
3103 end;
3104
3105 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3106 begin
3107   aPixel.Data.r := PWord(aData)^;
3108   inc(aData, 2);
3109   aPixel.Data.g := PWord(aData)^;
3110   inc(aData, 2);
3111   aPixel.Data.b := PWord(aData)^;
3112   inc(aData, 2);
3113   aPixel.Data.a := 0;
3114 end;
3115
3116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3117 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3119 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3120 begin
3121   PWord(aData)^ := aPixel.Data.b;
3122   inc(aData, 2);
3123   PWord(aData)^ := aPixel.Data.g;
3124   inc(aData, 2);
3125   PWord(aData)^ := aPixel.Data.r;
3126   inc(aData, 2);
3127 end;
3128
3129 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3130 begin
3131   aPixel.Data.b := PWord(aData)^;
3132   inc(aData, 2);
3133   aPixel.Data.g := PWord(aData)^;
3134   inc(aData, 2);
3135   aPixel.Data.r := PWord(aData)^;
3136   inc(aData, 2);
3137   aPixel.Data.a := 0;
3138 end;
3139
3140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3141 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3142 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3143 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3144 begin
3145   inherited Map(aPixel, aData, aMapData);
3146   PWord(aData)^ := aPixel.Data.a;
3147   inc(aData, 2);
3148 end;
3149
3150 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3151 begin
3152   inherited Unmap(aData, aPixel, aMapData);
3153   aPixel.Data.a := PWord(aData)^;
3154   inc(aData, 2);
3155 end;
3156
3157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3158 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3160 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3161 begin
3162   PWord(aData)^ := aPixel.Data.a;
3163   inc(aData, 2);
3164   inherited Map(aPixel, aData, aMapData);
3165 end;
3166
3167 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3168 begin
3169   aPixel.Data.a := PWord(aData)^;
3170   inc(aData, 2);
3171   inherited Unmap(aData, aPixel, aMapData);
3172 end;
3173
3174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3175 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3177 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3178 begin
3179   inherited Map(aPixel, aData, aMapData);
3180   PWord(aData)^ := aPixel.Data.a;
3181   inc(aData, 2);
3182 end;
3183
3184 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3185 begin
3186   inherited Unmap(aData, aPixel, aMapData);
3187   aPixel.Data.a := PWord(aData)^;
3188   inc(aData, 2);
3189 end;
3190
3191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3192 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3194 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3195 begin
3196   PWord(aData)^ := aPixel.Data.a;
3197   inc(aData, 2);
3198   inherited Map(aPixel, aData, aMapData);
3199 end;
3200
3201 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3202 begin
3203   aPixel.Data.a := PWord(aData)^;
3204   inc(aData, 2);
3205   inherited Unmap(aData, aPixel, aMapData);
3206 end;
3207
3208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3209 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3211 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3212 var
3213   i: Integer;
3214 begin
3215   PCardinal(aData)^ := 0;
3216   for i := 0 to 3 do
3217     if (Range.arr[i] > 0) then
3218       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
3219   inc(aData, 4);
3220 end;
3221
3222 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3223 var
3224   i: Integer;
3225 begin
3226   for i := 0 to 3 do
3227     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
3228   inc(aData, 2);
3229 end;
3230
3231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3232 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3233 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3234 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3235 begin
3236   PCardinal(aData)^ := DepthWeight(aPixel);
3237   inc(aData, 4);
3238 end;
3239
3240 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3241 begin
3242   aPixel.Data.r := PCardinal(aData)^;
3243   aPixel.Data.g := PCardinal(aData)^;
3244   aPixel.Data.b := PCardinal(aData)^;
3245   aPixel.Data.a := PCardinal(aData)^;
3246   inc(aData, 4);
3247 end;
3248
3249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3252 procedure TfdAlpha4ub1.SetValues;
3253 begin
3254   inherited SetValues;
3255   fBitsPerPixel     := 8;
3256   fFormat           := tfAlpha4ub1;
3257   fWithAlpha        := tfAlpha4ub1;
3258   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
3259   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3260 {$IFNDEF OPENGL_ES}
3261   fOpenGLFormat     := tfAlpha4ub1;
3262   fglFormat         := GL_ALPHA;
3263   fglInternalFormat := GL_ALPHA4;
3264   fglDataFormat     := GL_UNSIGNED_BYTE;
3265 {$ELSE}
3266   fOpenGLFormat     := tfAlpha8ub1;
3267 {$ENDIF}
3268 end;
3269
3270 procedure TfdAlpha8ub1.SetValues;
3271 begin
3272   inherited SetValues;
3273   fBitsPerPixel     := 8;
3274   fFormat           := tfAlpha8ub1;
3275   fWithAlpha        := tfAlpha8ub1;
3276   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
3277   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3278   fOpenGLFormat     := tfAlpha8ub1;
3279   fglFormat         := GL_ALPHA;
3280   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
3281   fglDataFormat     := GL_UNSIGNED_BYTE;
3282 end;
3283
3284 procedure TfdAlpha16us1.SetValues;
3285 begin
3286   inherited SetValues;
3287   fBitsPerPixel     := 16;
3288   fFormat           := tfAlpha16us1;
3289   fWithAlpha        := tfAlpha16us1;
3290   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
3291   fShift            := glBitmapRec4ub(0, 0, 0,  0);
3292 {$IFNDEF OPENGL_ES}
3293   fOpenGLFormat     := tfAlpha16us1;
3294   fglFormat         := GL_ALPHA;
3295   fglInternalFormat := GL_ALPHA16;
3296   fglDataFormat     := GL_UNSIGNED_SHORT;
3297 {$ELSE}
3298   fOpenGLFormat     := tfAlpha8ub1;
3299 {$ENDIF}
3300 end;
3301
3302 procedure TfdLuminance4ub1.SetValues;
3303 begin
3304   inherited SetValues;
3305   fBitsPerPixel     := 8;
3306   fFormat           := tfLuminance4ub1;
3307   fWithAlpha        := tfLuminance4Alpha4ub2;
3308   fWithoutAlpha     := tfLuminance4ub1;
3309   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3310   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3311 {$IFNDEF OPENGL_ES}
3312   fOpenGLFormat     := tfLuminance4ub1;
3313   fglFormat         := GL_LUMINANCE;
3314   fglInternalFormat := GL_LUMINANCE4;
3315   fglDataFormat     := GL_UNSIGNED_BYTE;
3316 {$ELSE}
3317   fOpenGLFormat     := tfLuminance8ub1;
3318 {$ENDIF}
3319 end;
3320
3321 procedure TfdLuminance8ub1.SetValues;
3322 begin
3323   inherited SetValues;
3324   fBitsPerPixel     := 8;
3325   fFormat           := tfLuminance8ub1;
3326   fWithAlpha        := tfLuminance8Alpha8ub2;
3327   fWithoutAlpha     := tfLuminance8ub1;
3328   fOpenGLFormat     := tfLuminance8ub1;
3329   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
3330   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3331   fglFormat         := GL_LUMINANCE;
3332   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
3333   fglDataFormat     := GL_UNSIGNED_BYTE;
3334 end;
3335
3336 procedure TfdLuminance16us1.SetValues;
3337 begin
3338   inherited SetValues;
3339   fBitsPerPixel     := 16;
3340   fFormat           := tfLuminance16us1;
3341   fWithAlpha        := tfLuminance16Alpha16us2;
3342   fWithoutAlpha     := tfLuminance16us1;
3343   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3344   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3345 {$IFNDEF OPENGL_ES}
3346   fOpenGLFormat     := tfLuminance16us1;
3347   fglFormat         := GL_LUMINANCE;
3348   fglInternalFormat := GL_LUMINANCE16;
3349   fglDataFormat     := GL_UNSIGNED_SHORT;
3350 {$ELSE}
3351   fOpenGLFormat     := tfLuminance8ub1;
3352 {$ENDIF}
3353 end;
3354
3355 procedure TfdLuminance4Alpha4ub2.SetValues;
3356 begin
3357   inherited SetValues;
3358   fBitsPerPixel     := 16;
3359   fFormat           := tfLuminance4Alpha4ub2;
3360   fWithAlpha        := tfLuminance4Alpha4ub2;
3361   fWithoutAlpha     := tfLuminance4ub1;
3362   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3363   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3364 {$IFNDEF OPENGL_ES}
3365   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3366   fglFormat         := GL_LUMINANCE_ALPHA;
3367   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3368   fglDataFormat     := GL_UNSIGNED_BYTE;
3369 {$ELSE}
3370   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3371 {$ENDIF}
3372 end;
3373
3374 procedure TfdLuminance6Alpha2ub2.SetValues;
3375 begin
3376   inherited SetValues;
3377   fBitsPerPixel     := 16;
3378   fFormat           := tfLuminance6Alpha2ub2;
3379   fWithAlpha        := tfLuminance6Alpha2ub2;
3380   fWithoutAlpha     := tfLuminance8ub1;
3381   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3382   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3383 {$IFNDEF OPENGL_ES}
3384   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3385   fglFormat         := GL_LUMINANCE_ALPHA;
3386   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3387   fglDataFormat     := GL_UNSIGNED_BYTE;
3388 {$ELSE}
3389   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3390 {$ENDIF}
3391 end;
3392
3393 procedure TfdLuminance8Alpha8ub2.SetValues;
3394 begin
3395   inherited SetValues;
3396   fBitsPerPixel     := 16;
3397   fFormat           := tfLuminance8Alpha8ub2;
3398   fWithAlpha        := tfLuminance8Alpha8ub2;
3399   fWithoutAlpha     := tfLuminance8ub1;
3400   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3401   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3402   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3403   fglFormat         := GL_LUMINANCE_ALPHA;
3404   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
3405   fglDataFormat     := GL_UNSIGNED_BYTE;
3406 end;
3407
3408 procedure TfdLuminance12Alpha4us2.SetValues;
3409 begin
3410   inherited SetValues;
3411   fBitsPerPixel     := 32;
3412   fFormat           := tfLuminance12Alpha4us2;
3413   fWithAlpha        := tfLuminance12Alpha4us2;
3414   fWithoutAlpha     := tfLuminance16us1;
3415   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3416   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3417 {$IFNDEF OPENGL_ES}
3418   fOpenGLFormat     := tfLuminance12Alpha4us2;
3419   fglFormat         := GL_LUMINANCE_ALPHA;
3420   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3421   fglDataFormat     := GL_UNSIGNED_SHORT;
3422 {$ELSE}
3423   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3424 {$ENDIF}
3425 end;
3426
3427 procedure TfdLuminance16Alpha16us2.SetValues;
3428 begin
3429   inherited SetValues;
3430   fBitsPerPixel     := 32;
3431   fFormat           := tfLuminance16Alpha16us2;
3432   fWithAlpha        := tfLuminance16Alpha16us2;
3433   fWithoutAlpha     := tfLuminance16us1;
3434   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3435   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3436 {$IFNDEF OPENGL_ES}
3437   fOpenGLFormat     := tfLuminance16Alpha16us2;
3438   fglFormat         := GL_LUMINANCE_ALPHA;
3439   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3440   fglDataFormat     := GL_UNSIGNED_SHORT;
3441 {$ELSE}
3442   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3443 {$ENDIF}
3444 end;
3445
3446 procedure TfdR3G3B2ub1.SetValues;
3447 begin
3448   inherited SetValues;
3449   fBitsPerPixel     := 8;
3450   fFormat           := tfR3G3B2ub1;
3451   fWithAlpha        := tfRGBA4us1;
3452   fWithoutAlpha     := tfR3G3B2ub1;
3453   fRGBInverted      := tfEmpty;
3454   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3455   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3456 {$IFNDEF OPENGL_ES}
3457   fOpenGLFormat     := tfR3G3B2ub1;
3458   fglFormat         := GL_RGB;
3459   fglInternalFormat := GL_R3_G3_B2;
3460   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3461 {$ELSE}
3462   fOpenGLFormat     := tfR5G6B5us1;
3463 {$ENDIF}
3464 end;
3465
3466 procedure TfdRGBX4us1.SetValues;
3467 begin
3468   inherited SetValues;
3469   fBitsPerPixel     := 16;
3470   fFormat           := tfRGBX4us1;
3471   fWithAlpha        := tfRGBA4us1;
3472   fWithoutAlpha     := tfRGBX4us1;
3473   fRGBInverted      := tfBGRX4us1;
3474   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3475   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3476 {$IFNDEF OPENGL_ES}
3477   fOpenGLFormat     := tfRGBX4us1;
3478   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3479   fglInternalFormat := GL_RGB4;
3480   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3481 {$ELSE}
3482   fOpenGLFormat     := tfR5G6B5us1;
3483 {$ENDIF}
3484 end;
3485
3486 procedure TfdXRGB4us1.SetValues;
3487 begin
3488   inherited SetValues;
3489   fBitsPerPixel     := 16;
3490   fFormat           := tfXRGB4us1;
3491   fWithAlpha        := tfARGB4us1;
3492   fWithoutAlpha     := tfXRGB4us1;
3493   fRGBInverted      := tfXBGR4us1;
3494   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3495   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3496 {$IFNDEF OPENGL_ES}
3497   fOpenGLFormat     := tfXRGB4us1;
3498   fglFormat         := GL_BGRA;
3499   fglInternalFormat := GL_RGB4;
3500   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3501 {$ELSE}
3502   fOpenGLFormat     := tfR5G6B5us1;
3503 {$ENDIF}
3504 end;
3505
3506 procedure TfdR5G6B5us1.SetValues;
3507 begin
3508   inherited SetValues;
3509   fBitsPerPixel     := 16;
3510   fFormat           := tfR5G6B5us1;
3511   fWithAlpha        := tfRGB5A1us1;
3512   fWithoutAlpha     := tfR5G6B5us1;
3513   fRGBInverted      := tfB5G6R5us1;
3514   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3515   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3516 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3517   fOpenGLFormat     := tfR5G6B5us1;
3518   fglFormat         := GL_RGB;
3519   fglInternalFormat := GL_RGB565;
3520   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3521 {$ELSE}
3522   fOpenGLFormat     := tfRGB8ub3;
3523 {$IFEND}
3524 end;
3525
3526 procedure TfdRGB5X1us1.SetValues;
3527 begin
3528   inherited SetValues;
3529   fBitsPerPixel     := 16;
3530   fFormat           := tfRGB5X1us1;
3531   fWithAlpha        := tfRGB5A1us1;
3532   fWithoutAlpha     := tfRGB5X1us1;
3533   fRGBInverted      := tfBGR5X1us1;
3534   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3535   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3536 {$IFNDEF OPENGL_ES}
3537   fOpenGLFormat     := tfRGB5X1us1;
3538   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3539   fglInternalFormat := GL_RGB5;
3540   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3541 {$ELSE}
3542   fOpenGLFormat     := tfR5G6B5us1;
3543 {$ENDIF}
3544 end;
3545
3546 procedure TfdX1RGB5us1.SetValues;
3547 begin
3548   inherited SetValues;
3549   fBitsPerPixel     := 16;
3550   fFormat           := tfX1RGB5us1;
3551   fWithAlpha        := tfA1RGB5us1;
3552   fWithoutAlpha     := tfX1RGB5us1;
3553   fRGBInverted      := tfX1BGR5us1;
3554   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3555   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3556 {$IFNDEF OPENGL_ES}
3557   fOpenGLFormat     := tfX1RGB5us1;
3558   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3559   fglInternalFormat := GL_RGB5;
3560   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3561 {$ELSE}
3562   fOpenGLFormat     := tfR5G6B5us1;
3563 {$ENDIF}
3564 end;
3565
3566 procedure TfdRGB8ub3.SetValues;
3567 begin
3568   inherited SetValues;
3569   fBitsPerPixel     := 24;
3570   fFormat           := tfRGB8ub3;
3571   fWithAlpha        := tfRGBA8ub4;
3572   fWithoutAlpha     := tfRGB8ub3;
3573   fRGBInverted      := tfBGR8ub3;
3574   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3575   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3576   fOpenGLFormat     := tfRGB8ub3;
3577   fglFormat         := GL_RGB;
3578   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
3579   fglDataFormat     := GL_UNSIGNED_BYTE;
3580 end;
3581
3582 procedure TfdRGBX8ui1.SetValues;
3583 begin
3584   inherited SetValues;
3585   fBitsPerPixel     := 32;
3586   fFormat           := tfRGBX8ui1;
3587   fWithAlpha        := tfRGBA8ui1;
3588   fWithoutAlpha     := tfRGBX8ui1;
3589   fRGBInverted      := tfBGRX8ui1;
3590   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3591   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3592 {$IFNDEF OPENGL_ES}
3593   fOpenGLFormat     := tfRGBX8ui1;
3594   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3595   fglInternalFormat := GL_RGB8;
3596   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3597 {$ELSE}
3598   fOpenGLFormat     := tfRGB8ub3;
3599 {$ENDIF}
3600 end;
3601
3602 procedure TfdXRGB8ui1.SetValues;
3603 begin
3604   inherited SetValues;
3605   fBitsPerPixel     := 32;
3606   fFormat           := tfXRGB8ui1;
3607   fWithAlpha        := tfXRGB8ui1;
3608   fWithoutAlpha     := tfXRGB8ui1;
3609   fOpenGLFormat     := tfXRGB8ui1;
3610   fRGBInverted      := tfXBGR8ui1;
3611   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3612   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3613 {$IFNDEF OPENGL_ES}
3614   fOpenGLFormat     := tfXRGB8ui1;
3615   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3616   fglInternalFormat := GL_RGB8;
3617   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3618 {$ELSE}
3619   fOpenGLFormat     := tfRGB8ub3;
3620 {$ENDIF}
3621 end;
3622
3623 procedure TfdRGB10X2ui1.SetValues;
3624 begin
3625   inherited SetValues;
3626   fBitsPerPixel     := 32;
3627   fFormat           := tfRGB10X2ui1;
3628   fWithAlpha        := tfRGB10A2ui1;
3629   fWithoutAlpha     := tfRGB10X2ui1;
3630   fRGBInverted      := tfBGR10X2ui1;
3631   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3632   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3633 {$IFNDEF OPENGL_ES}
3634   fOpenGLFormat     := tfRGB10X2ui1;
3635   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3636   fglInternalFormat := GL_RGB10;
3637   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3638 {$ELSE}
3639   fOpenGLFormat     := tfRGB16us3;
3640 {$ENDIF}
3641 end;
3642
3643 procedure TfdX2RGB10ui1.SetValues;
3644 begin
3645   inherited SetValues;
3646   fBitsPerPixel     := 32;
3647   fFormat           := tfX2RGB10ui1;
3648   fWithAlpha        := tfA2RGB10ui1;
3649   fWithoutAlpha     := tfX2RGB10ui1;
3650   fRGBInverted      := tfX2BGR10ui1;
3651   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3652   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3653 {$IFNDEF OPENGL_ES}
3654   fOpenGLFormat     := tfX2RGB10ui1;
3655   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3656   fglInternalFormat := GL_RGB10;
3657   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3658 {$ELSE}
3659   fOpenGLFormat     := tfRGB16us3;
3660 {$ENDIF}
3661 end;
3662
3663 procedure TfdRGB16us3.SetValues;
3664 begin
3665   inherited SetValues;
3666   fBitsPerPixel     := 48;
3667   fFormat           := tfRGB16us3;
3668   fWithAlpha        := tfRGBA16us4;
3669   fWithoutAlpha     := tfRGB16us3;
3670   fRGBInverted      := tfBGR16us3;
3671   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3672   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3673 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3674   fOpenGLFormat     := tfRGB16us3;
3675   fglFormat         := GL_RGB;
3676   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3677   fglDataFormat     := GL_UNSIGNED_SHORT;
3678 {$ELSE}
3679   fOpenGLFormat     := tfRGB8ub3;
3680 {$IFEND}
3681 end;
3682
3683 procedure TfdRGBA4us1.SetValues;
3684 begin
3685   inherited SetValues;
3686   fBitsPerPixel     := 16;
3687   fFormat           := tfRGBA4us1;
3688   fWithAlpha        := tfRGBA4us1;
3689   fWithoutAlpha     := tfRGBX4us1;
3690   fOpenGLFormat     := tfRGBA4us1;
3691   fRGBInverted      := tfBGRA4us1;
3692   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3693   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3694   fglFormat         := GL_RGBA;
3695   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3696   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3697 end;
3698
3699 procedure TfdARGB4us1.SetValues;
3700 begin
3701   inherited SetValues;
3702   fBitsPerPixel     := 16;
3703   fFormat           := tfARGB4us1;
3704   fWithAlpha        := tfARGB4us1;
3705   fWithoutAlpha     := tfXRGB4us1;
3706   fRGBInverted      := tfABGR4us1;
3707   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3708   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3709 {$IFNDEF OPENGL_ES}
3710   fOpenGLFormat     := tfARGB4us1;
3711   fglFormat         := GL_BGRA;
3712   fglInternalFormat := GL_RGBA4;
3713   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3714 {$ELSE}
3715   fOpenGLFormat     := tfRGBA4us1;
3716 {$ENDIF}
3717 end;
3718
3719 procedure TfdRGB5A1us1.SetValues;
3720 begin
3721   inherited SetValues;
3722   fBitsPerPixel     := 16;
3723   fFormat           := tfRGB5A1us1;
3724   fWithAlpha        := tfRGB5A1us1;
3725   fWithoutAlpha     := tfRGB5X1us1;
3726   fOpenGLFormat     := tfRGB5A1us1;
3727   fRGBInverted      := tfBGR5A1us1;
3728   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3729   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3730   fglFormat         := GL_RGBA;
3731   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3732   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3733 end;
3734
3735 procedure TfdA1RGB5us1.SetValues;
3736 begin
3737   inherited SetValues;
3738   fBitsPerPixel     := 16;
3739   fFormat           := tfA1RGB5us1;
3740   fWithAlpha        := tfA1RGB5us1;
3741   fWithoutAlpha     := tfX1RGB5us1;
3742   fRGBInverted      := tfA1BGR5us1;
3743   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3744   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3745 {$IFNDEF OPENGL_ES}
3746   fOpenGLFormat     := tfA1RGB5us1;
3747   fglFormat         := GL_BGRA;
3748   fglInternalFormat := GL_RGB5_A1;
3749   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3750 {$ELSE}
3751   fOpenGLFormat     := tfRGB5A1us1;
3752 {$ENDIF}
3753 end;
3754
3755 procedure TfdRGBA8ui1.SetValues;
3756 begin
3757   inherited SetValues;
3758   fBitsPerPixel     := 32;
3759   fFormat           := tfRGBA8ui1;
3760   fWithAlpha        := tfRGBA8ui1;
3761   fWithoutAlpha     := tfRGBX8ui1;
3762   fRGBInverted      := tfBGRA8ui1;
3763   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3764   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3765 {$IFNDEF OPENGL_ES}
3766   fOpenGLFormat     := tfRGBA8ui1;
3767   fglFormat         := GL_RGBA;
3768   fglInternalFormat := GL_RGBA8;
3769   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3770 {$ELSE}
3771   fOpenGLFormat     := tfRGBA8ub4;
3772 {$ENDIF}
3773 end;
3774
3775 procedure TfdARGB8ui1.SetValues;
3776 begin
3777   inherited SetValues;
3778   fBitsPerPixel     := 32;
3779   fFormat           := tfARGB8ui1;
3780   fWithAlpha        := tfARGB8ui1;
3781   fWithoutAlpha     := tfXRGB8ui1;
3782   fRGBInverted      := tfABGR8ui1;
3783   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3784   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3785 {$IFNDEF OPENGL_ES}
3786   fOpenGLFormat     := tfARGB8ui1;
3787   fglFormat         := GL_BGRA;
3788   fglInternalFormat := GL_RGBA8;
3789   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3790 {$ELSE}
3791   fOpenGLFormat     := tfRGBA8ub4;
3792 {$ENDIF}
3793 end;
3794
3795 procedure TfdRGBA8ub4.SetValues;
3796 begin
3797   inherited SetValues;
3798   fBitsPerPixel     := 32;
3799   fFormat           := tfRGBA8ub4;
3800   fWithAlpha        := tfRGBA8ub4;
3801   fWithoutAlpha     := tfRGB8ub3;
3802   fOpenGLFormat     := tfRGBA8ub4;
3803   fRGBInverted      := tfBGRA8ub4;
3804   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3805   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3806   fglFormat         := GL_RGBA;
3807   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3808   fglDataFormat     := GL_UNSIGNED_BYTE;
3809 end;
3810
3811 procedure TfdRGB10A2ui1.SetValues;
3812 begin
3813   inherited SetValues;
3814   fBitsPerPixel     := 32;
3815   fFormat           := tfRGB10A2ui1;
3816   fWithAlpha        := tfRGB10A2ui1;
3817   fWithoutAlpha     := tfRGB10X2ui1;
3818   fRGBInverted      := tfBGR10A2ui1;
3819   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3820   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3821 {$IFNDEF OPENGL_ES}
3822   fOpenGLFormat     := tfRGB10A2ui1;
3823   fglFormat         := GL_RGBA;
3824   fglInternalFormat := GL_RGB10_A2;
3825   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3826 {$ELSE}
3827   fOpenGLFormat     := tfA2RGB10ui1;
3828 {$ENDIF}
3829 end;
3830
3831 procedure TfdA2RGB10ui1.SetValues;
3832 begin
3833   inherited SetValues;
3834   fBitsPerPixel     := 32;
3835   fFormat           := tfA2RGB10ui1;
3836   fWithAlpha        := tfA2RGB10ui1;
3837   fWithoutAlpha     := tfX2RGB10ui1;
3838   fRGBInverted      := tfA2BGR10ui1;
3839   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3840   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3841 {$IF NOT DEFINED(OPENGL_ES)}
3842   fOpenGLFormat     := tfA2RGB10ui1;
3843   fglFormat         := GL_BGRA;
3844   fglInternalFormat := GL_RGB10_A2;
3845   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3846 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3847   fOpenGLFormat     := tfA2RGB10ui1;
3848   fglFormat         := GL_RGBA;
3849   fglInternalFormat := GL_RGB10_A2;
3850   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3851 {$ELSE}
3852   fOpenGLFormat     := tfRGBA8ui1;
3853 {$IFEND}
3854 end;
3855
3856 procedure TfdRGBA16us4.SetValues;
3857 begin
3858   inherited SetValues;
3859   fBitsPerPixel     := 64;
3860   fFormat           := tfRGBA16us4;
3861   fWithAlpha        := tfRGBA16us4;
3862   fWithoutAlpha     := tfRGB16us3;
3863   fRGBInverted      := tfBGRA16us4;
3864   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3865   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3866 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3867   fOpenGLFormat     := tfRGBA16us4;
3868   fglFormat         := GL_RGBA;
3869   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3870   fglDataFormat     := GL_UNSIGNED_SHORT;
3871 {$ELSE}
3872   fOpenGLFormat     := tfRGBA8ub4;
3873 {$IFEND}
3874 end;
3875
3876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3879 procedure TfdBGRX4us1.SetValues;
3880 begin
3881   inherited SetValues;
3882   fBitsPerPixel     := 16;
3883   fFormat           := tfBGRX4us1;
3884   fWithAlpha        := tfBGRA4us1;
3885   fWithoutAlpha     := tfBGRX4us1;
3886   fRGBInverted      := tfRGBX4us1;
3887   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3888   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3889 {$IFNDEF OPENGL_ES}
3890   fOpenGLFormat     := tfBGRX4us1;
3891   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3892   fglInternalFormat := GL_RGB4;
3893   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3894 {$ELSE}
3895   fOpenGLFormat     := tfR5G6B5us1;
3896 {$ENDIF}
3897 end;
3898
3899 procedure TfdXBGR4us1.SetValues;
3900 begin
3901   inherited SetValues;
3902   fBitsPerPixel     := 16;
3903   fFormat           := tfXBGR4us1;
3904   fWithAlpha        := tfABGR4us1;
3905   fWithoutAlpha     := tfXBGR4us1;
3906   fRGBInverted      := tfXRGB4us1;
3907   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3908   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3909 {$IFNDEF OPENGL_ES}
3910   fOpenGLFormat     := tfXBGR4us1;
3911   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3912   fglInternalFormat := GL_RGB4;
3913   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3914 {$ELSE}
3915   fOpenGLFormat     := tfR5G6B5us1;
3916 {$ENDIF}
3917 end;
3918
3919 procedure TfdB5G6R5us1.SetValues;
3920 begin
3921   inherited SetValues;
3922   fBitsPerPixel     := 16;
3923   fFormat           := tfB5G6R5us1;
3924   fWithAlpha        := tfBGR5A1us1;
3925   fWithoutAlpha     := tfB5G6R5us1;
3926   fRGBInverted      := tfR5G6B5us1;
3927   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3928   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3929 {$IFNDEF OPENGL_ES}
3930   fOpenGLFormat     := tfB5G6R5us1;
3931   fglFormat         := GL_RGB;
3932   fglInternalFormat := GL_RGB565;
3933   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3934 {$ELSE}
3935   fOpenGLFormat     := tfR5G6B5us1;
3936 {$ENDIF}
3937 end;
3938
3939 procedure TfdBGR5X1us1.SetValues;
3940 begin
3941   inherited SetValues;
3942   fBitsPerPixel     := 16;
3943   fFormat           := tfBGR5X1us1;
3944   fWithAlpha        := tfBGR5A1us1;
3945   fWithoutAlpha     := tfBGR5X1us1;
3946   fRGBInverted      := tfRGB5X1us1;
3947   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3948   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3949 {$IFNDEF OPENGL_ES}
3950   fOpenGLFormat     := tfBGR5X1us1;
3951   fglFormat         := GL_BGRA;
3952   fglInternalFormat := GL_RGB5;
3953   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3954 {$ELSE}
3955   fOpenGLFormat     := tfR5G6B5us1;
3956 {$ENDIF}
3957 end;
3958
3959 procedure TfdX1BGR5us1.SetValues;
3960 begin
3961   inherited SetValues;
3962   fBitsPerPixel     := 16;
3963   fFormat           := tfX1BGR5us1;
3964   fWithAlpha        := tfA1BGR5us1;
3965   fWithoutAlpha     := tfX1BGR5us1;
3966   fRGBInverted      := tfX1RGB5us1;
3967   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3968   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3969 {$IFNDEF OPENGL_ES}
3970   fOpenGLFormat     := tfX1BGR5us1;
3971   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3972   fglInternalFormat := GL_RGB5;
3973   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3974 {$ELSE}
3975   fOpenGLFormat     := tfR5G6B5us1;
3976 {$ENDIF}
3977 end;
3978
3979 procedure TfdBGR8ub3.SetValues;
3980 begin
3981   inherited SetValues;
3982   fBitsPerPixel     := 24;
3983   fFormat           := tfBGR8ub3;
3984   fWithAlpha        := tfBGRA8ub4;
3985   fWithoutAlpha     := tfBGR8ub3;
3986   fRGBInverted      := tfRGB8ub3;
3987   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3988   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3989 {$IFNDEF OPENGL_ES}
3990   fOpenGLFormat     := tfBGR8ub3;
3991   fglFormat         := GL_BGR;
3992   fglInternalFormat := GL_RGB8;
3993   fglDataFormat     := GL_UNSIGNED_BYTE;
3994 {$ELSE}
3995   fOpenGLFormat     := tfRGB8ub3;
3996 {$ENDIF}
3997 end;
3998
3999 procedure TfdBGRX8ui1.SetValues;
4000 begin
4001   inherited SetValues;
4002   fBitsPerPixel     := 32;
4003   fFormat           := tfBGRX8ui1;
4004   fWithAlpha        := tfBGRA8ui1;
4005   fWithoutAlpha     := tfBGRX8ui1;
4006   fRGBInverted      := tfRGBX8ui1;
4007   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
4008   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
4009 {$IFNDEF OPENGL_ES}
4010   fOpenGLFormat     := tfBGRX8ui1;
4011   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
4012   fglInternalFormat := GL_RGB8;
4013   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
4014 {$ELSE}
4015   fOpenGLFormat     := tfRGB8ub3;
4016 {$ENDIF}
4017 end;
4018
4019 procedure TfdXBGR8ui1.SetValues;
4020 begin
4021   inherited SetValues;
4022   fBitsPerPixel     := 32;
4023   fFormat           := tfXBGR8ui1;
4024   fWithAlpha        := tfABGR8ui1;
4025   fWithoutAlpha     := tfXBGR8ui1;
4026   fRGBInverted      := tfXRGB8ui1;
4027   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
4028   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
4029 {$IFNDEF OPENGL_ES}
4030   fOpenGLFormat     := tfXBGR8ui1;
4031   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
4032   fglInternalFormat := GL_RGB8;
4033   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
4034 {$ELSE}
4035   fOpenGLFormat     := tfRGB8ub3;
4036 {$ENDIF}
4037 end;
4038
4039 procedure TfdBGR10X2ui1.SetValues;
4040 begin
4041   inherited SetValues;
4042   fBitsPerPixel     := 32;
4043   fFormat           := tfBGR10X2ui1;
4044   fWithAlpha        := tfBGR10A2ui1;
4045   fWithoutAlpha     := tfBGR10X2ui1;
4046   fRGBInverted      := tfRGB10X2ui1;
4047   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
4048   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
4049 {$IFNDEF OPENGL_ES}
4050   fOpenGLFormat     := tfBGR10X2ui1;
4051   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
4052   fglInternalFormat := GL_RGB10;
4053   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
4054 {$ELSE}
4055   fOpenGLFormat     := tfRGB16us3;
4056 {$ENDIF}
4057 end;
4058
4059 procedure TfdX2BGR10ui1.SetValues;
4060 begin
4061   inherited SetValues;
4062   fBitsPerPixel     := 32;
4063   fFormat           := tfX2BGR10ui1;
4064   fWithAlpha        := tfA2BGR10ui1;
4065   fWithoutAlpha     := tfX2BGR10ui1;
4066   fRGBInverted      := tfX2RGB10ui1;
4067   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
4068   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
4069 {$IFNDEF OPENGL_ES}
4070   fOpenGLFormat     := tfX2BGR10ui1;
4071   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
4072   fglInternalFormat := GL_RGB10;
4073   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
4074 {$ELSE}
4075   fOpenGLFormat     := tfRGB16us3;
4076 {$ENDIF}
4077 end;
4078
4079 procedure TfdBGR16us3.SetValues;
4080 begin
4081   inherited SetValues;
4082   fBitsPerPixel     := 48;
4083   fFormat           := tfBGR16us3;
4084   fWithAlpha        := tfBGRA16us4;
4085   fWithoutAlpha     := tfBGR16us3;
4086   fRGBInverted      := tfRGB16us3;
4087   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
4088   fShift            := glBitmapRec4ub(32, 16,  0,  0);
4089 {$IFNDEF OPENGL_ES}
4090   fOpenGLFormat     := tfBGR16us3;
4091   fglFormat         := GL_BGR;
4092   fglInternalFormat := GL_RGB16;
4093   fglDataFormat     := GL_UNSIGNED_SHORT;
4094 {$ELSE}
4095   fOpenGLFormat     := tfRGB16us3;
4096 {$ENDIF}
4097 end;
4098
4099 procedure TfdBGRA4us1.SetValues;
4100 begin
4101   inherited SetValues;
4102   fBitsPerPixel     := 16;
4103   fFormat           := tfBGRA4us1;
4104   fWithAlpha        := tfBGRA4us1;
4105   fWithoutAlpha     := tfBGRX4us1;
4106   fRGBInverted      := tfRGBA4us1;
4107   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
4108   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
4109 {$IFNDEF OPENGL_ES}
4110   fOpenGLFormat     := tfBGRA4us1;
4111   fglFormat         := GL_BGRA;
4112   fglInternalFormat := GL_RGBA4;
4113   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
4114 {$ELSE}
4115   fOpenGLFormat     := tfRGBA4us1;
4116 {$ENDIF}
4117 end;
4118
4119 procedure TfdABGR4us1.SetValues;
4120 begin
4121   inherited SetValues;
4122   fBitsPerPixel     := 16;
4123   fFormat           := tfABGR4us1;
4124   fWithAlpha        := tfABGR4us1;
4125   fWithoutAlpha     := tfXBGR4us1;
4126   fRGBInverted      := tfARGB4us1;
4127   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
4128   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
4129 {$IFNDEF OPENGL_ES}
4130   fOpenGLFormat     := tfABGR4us1;
4131   fglFormat         := GL_RGBA;
4132   fglInternalFormat := GL_RGBA4;
4133   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
4134 {$ELSE}
4135   fOpenGLFormat     := tfRGBA4us1;
4136 {$ENDIF}
4137 end;
4138
4139 procedure TfdBGR5A1us1.SetValues;
4140 begin
4141   inherited SetValues;
4142   fBitsPerPixel     := 16;
4143   fFormat           := tfBGR5A1us1;
4144   fWithAlpha        := tfBGR5A1us1;
4145   fWithoutAlpha     := tfBGR5X1us1;
4146   fRGBInverted      := tfRGB5A1us1;
4147   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
4148   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
4149 {$IFNDEF OPENGL_ES}
4150   fOpenGLFormat     := tfBGR5A1us1;
4151   fglFormat         := GL_BGRA;
4152   fglInternalFormat := GL_RGB5_A1;
4153   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
4154 {$ELSE}
4155   fOpenGLFormat     := tfRGB5A1us1;
4156 {$ENDIF}
4157 end;
4158
4159 procedure TfdA1BGR5us1.SetValues;
4160 begin
4161   inherited SetValues;
4162   fBitsPerPixel     := 16;
4163   fFormat           := tfA1BGR5us1;
4164   fWithAlpha        := tfA1BGR5us1;
4165   fWithoutAlpha     := tfX1BGR5us1;
4166   fRGBInverted      := tfA1RGB5us1;
4167   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
4168   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
4169 {$IFNDEF OPENGL_ES}
4170   fOpenGLFormat     := tfA1BGR5us1;
4171   fglFormat         := GL_RGBA;
4172   fglInternalFormat := GL_RGB5_A1;
4173   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
4174 {$ELSE}
4175   fOpenGLFormat     := tfRGB5A1us1;
4176 {$ENDIF}
4177 end;
4178
4179 procedure TfdBGRA8ui1.SetValues;
4180 begin
4181   inherited SetValues;
4182   fBitsPerPixel     := 32;
4183   fFormat           := tfBGRA8ui1;
4184   fWithAlpha        := tfBGRA8ui1;
4185   fWithoutAlpha     := tfBGRX8ui1;
4186   fRGBInverted      := tfRGBA8ui1;
4187   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
4188   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
4189 {$IFNDEF OPENGL_ES}
4190   fOpenGLFormat     := tfBGRA8ui1;
4191   fglFormat         := GL_BGRA;
4192   fglInternalFormat := GL_RGBA8;
4193   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
4194 {$ELSE}
4195   fOpenGLFormat     := tfRGBA8ub4;
4196 {$ENDIF}
4197 end;
4198
4199 procedure TfdABGR8ui1.SetValues;
4200 begin
4201   inherited SetValues;
4202   fBitsPerPixel     := 32;
4203   fFormat           := tfABGR8ui1;
4204   fWithAlpha        := tfABGR8ui1;
4205   fWithoutAlpha     := tfXBGR8ui1;
4206   fRGBInverted      := tfARGB8ui1;
4207   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
4208   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
4209 {$IFNDEF OPENGL_ES}
4210   fOpenGLFormat     := tfABGR8ui1;
4211   fglFormat         := GL_RGBA;
4212   fglInternalFormat := GL_RGBA8;
4213   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
4214 {$ELSE}
4215   fOpenGLFormat     := tfRGBA8ub4
4216 {$ENDIF}
4217 end;
4218
4219 procedure TfdBGRA8ub4.SetValues;
4220 begin
4221   inherited SetValues;
4222   fBitsPerPixel     := 32;
4223   fFormat           := tfBGRA8ub4;
4224   fWithAlpha        := tfBGRA8ub4;
4225   fWithoutAlpha     := tfBGR8ub3;
4226   fRGBInverted      := tfRGBA8ub4;
4227   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
4228   fShift            := glBitmapRec4ub(16,  8,  0, 24);
4229 {$IFNDEF OPENGL_ES}
4230   fOpenGLFormat     := tfBGRA8ub4;
4231   fglFormat         := GL_BGRA;
4232   fglInternalFormat := GL_RGBA8;
4233   fglDataFormat     := GL_UNSIGNED_BYTE;
4234 {$ELSE}
4235   fOpenGLFormat     := tfRGBA8ub4;
4236 {$ENDIF}
4237 end;
4238
4239 procedure TfdBGR10A2ui1.SetValues;
4240 begin
4241   inherited SetValues;
4242   fBitsPerPixel     := 32;
4243   fFormat           := tfBGR10A2ui1;
4244   fWithAlpha        := tfBGR10A2ui1;
4245   fWithoutAlpha     := tfBGR10X2ui1;
4246   fRGBInverted      := tfRGB10A2ui1;
4247   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
4248   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
4249 {$IFNDEF OPENGL_ES}
4250   fOpenGLFormat     := tfBGR10A2ui1;
4251   fglFormat         := GL_BGRA;
4252   fglInternalFormat := GL_RGB10_A2;
4253   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
4254 {$ELSE}
4255   fOpenGLFormat     := tfA2RGB10ui1;
4256 {$ENDIF}
4257 end;
4258
4259 procedure TfdA2BGR10ui1.SetValues;
4260 begin
4261   inherited SetValues;
4262   fBitsPerPixel     := 32;
4263   fFormat           := tfA2BGR10ui1;
4264   fWithAlpha        := tfA2BGR10ui1;
4265   fWithoutAlpha     := tfX2BGR10ui1;
4266   fRGBInverted      := tfA2RGB10ui1;
4267   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
4268   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
4269 {$IFNDEF OPENGL_ES}
4270   fOpenGLFormat     := tfA2BGR10ui1;
4271   fglFormat         := GL_RGBA;
4272   fglInternalFormat := GL_RGB10_A2;
4273   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
4274 {$ELSE}
4275   fOpenGLFormat     := tfA2RGB10ui1;
4276 {$ENDIF}
4277 end;
4278
4279 procedure TfdBGRA16us4.SetValues;
4280 begin
4281   inherited SetValues;
4282   fBitsPerPixel     := 64;
4283   fFormat           := tfBGRA16us4;
4284   fWithAlpha        := tfBGRA16us4;
4285   fWithoutAlpha     := tfBGR16us3;
4286   fRGBInverted      := tfRGBA16us4;
4287   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4288   fShift            := glBitmapRec4ub(32, 16,  0, 48);
4289 {$IFNDEF OPENGL_ES}
4290   fOpenGLFormat     := tfBGRA16us4;
4291   fglFormat         := GL_BGRA;
4292   fglInternalFormat := GL_RGBA16;
4293   fglDataFormat     := GL_UNSIGNED_SHORT;
4294 {$ELSE}
4295   fOpenGLFormat     := tfRGBA16us4;
4296 {$ENDIF}
4297 end;
4298
4299 procedure TfdDepth16us1.SetValues;
4300 begin
4301   inherited SetValues;
4302   fBitsPerPixel     := 16;
4303   fFormat           := tfDepth16us1;
4304   fWithoutAlpha     := tfDepth16us1;
4305   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
4306   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4307 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
4308   fOpenGLFormat     := tfDepth16us1;
4309   fglFormat         := GL_DEPTH_COMPONENT;
4310   fglInternalFormat := GL_DEPTH_COMPONENT16;
4311   fglDataFormat     := GL_UNSIGNED_SHORT;
4312 {$IFEND}
4313 end;
4314
4315 procedure TfdDepth24ui1.SetValues;
4316 begin
4317   inherited SetValues;
4318   fBitsPerPixel     := 32;
4319   fFormat           := tfDepth24ui1;
4320   fWithoutAlpha     := tfDepth24ui1;
4321   fOpenGLFormat     := tfDepth24ui1;
4322   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4323   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4324 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
4325   fOpenGLFormat     := tfDepth24ui1;
4326   fglFormat         := GL_DEPTH_COMPONENT;
4327   fglInternalFormat := GL_DEPTH_COMPONENT24;
4328   fglDataFormat     := GL_UNSIGNED_INT;
4329 {$IFEND}
4330 end;
4331
4332 procedure TfdDepth32ui1.SetValues;
4333 begin
4334   inherited SetValues;
4335   fBitsPerPixel     := 32;
4336   fFormat           := tfDepth32ui1;
4337   fWithoutAlpha     := tfDepth32ui1;
4338   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
4339   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
4340 {$IF NOT DEFINED(OPENGL_ES)}
4341   fOpenGLFormat     := tfDepth32ui1;
4342   fglFormat         := GL_DEPTH_COMPONENT;
4343   fglInternalFormat := GL_DEPTH_COMPONENT32;
4344   fglDataFormat     := GL_UNSIGNED_INT;
4345 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
4346   fOpenGLFormat     := tfDepth24ui1;
4347 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
4348   fOpenGLFormat     := tfDepth16us1;
4349 {$IFEND}
4350 end;
4351
4352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4353 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4355 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4356 begin
4357   raise EglBitmap.Create('mapping for compressed formats is not supported');
4358 end;
4359
4360 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4361 begin
4362   raise EglBitmap.Create('mapping for compressed formats is not supported');
4363 end;
4364
4365 procedure TfdS3tcDtx1RGBA.SetValues;
4366 begin
4367   inherited SetValues;
4368   fFormat           := tfS3tcDtx1RGBA;
4369   fWithAlpha        := tfS3tcDtx1RGBA;
4370   fUncompressed     := tfRGB5A1us1;
4371   fBitsPerPixel     := 4;
4372   fIsCompressed     := true;
4373 {$IFNDEF OPENGL_ES}
4374   fOpenGLFormat     := tfS3tcDtx1RGBA;
4375   fglFormat         := GL_COMPRESSED_RGBA;
4376   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
4377   fglDataFormat     := GL_UNSIGNED_BYTE;
4378 {$ELSE}
4379   fOpenGLFormat     := fUncompressed;
4380 {$ENDIF}
4381 end;
4382
4383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4384 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4387 begin
4388   raise EglBitmap.Create('mapping for compressed formats is not supported');
4389 end;
4390
4391 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4392 begin
4393   raise EglBitmap.Create('mapping for compressed formats is not supported');
4394 end;
4395
4396 procedure TfdS3tcDtx3RGBA.SetValues;
4397 begin
4398   inherited SetValues;
4399   fFormat           := tfS3tcDtx3RGBA;
4400   fWithAlpha        := tfS3tcDtx3RGBA;
4401   fUncompressed     := tfRGBA8ub4;
4402   fBitsPerPixel     := 8;
4403   fIsCompressed     := true;
4404 {$IFNDEF OPENGL_ES}
4405   fOpenGLFormat     := tfS3tcDtx3RGBA;
4406   fglFormat         := GL_COMPRESSED_RGBA;
4407   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
4408   fglDataFormat     := GL_UNSIGNED_BYTE;
4409 {$ELSE}
4410   fOpenGLFormat     := fUncompressed;
4411 {$ENDIF}
4412 end;
4413
4414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4415 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4418 begin
4419   raise EglBitmap.Create('mapping for compressed formats is not supported');
4420 end;
4421
4422 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4423 begin
4424   raise EglBitmap.Create('mapping for compressed formats is not supported');
4425 end;
4426
4427 procedure TfdS3tcDtx5RGBA.SetValues;
4428 begin
4429   inherited SetValues;
4430   fFormat           := tfS3tcDtx3RGBA;
4431   fWithAlpha        := tfS3tcDtx3RGBA;
4432   fUncompressed     := tfRGBA8ub4;
4433   fBitsPerPixel     := 8;
4434   fIsCompressed     := true;
4435 {$IFNDEF OPENGL_ES}
4436   fOpenGLFormat     := tfS3tcDtx3RGBA;
4437   fglFormat         := GL_COMPRESSED_RGBA;
4438   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
4439   fglDataFormat     := GL_UNSIGNED_BYTE;
4440 {$ELSE}
4441   fOpenGLFormat     := fUncompressed;
4442 {$ENDIF}
4443 end;
4444
4445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4446 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4448 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
4449 begin
4450   result := (fPrecision.r > 0);
4451 end;
4452
4453 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
4454 begin
4455   result := (fPrecision.g > 0);
4456 end;
4457
4458 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
4459 begin
4460   result := (fPrecision.b > 0);
4461 end;
4462
4463 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
4464 begin
4465   result := (fPrecision.a > 0);
4466 end;
4467
4468 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
4469 begin
4470   result := HasRed or HasGreen or HasBlue;
4471 end;
4472
4473 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
4474 begin
4475   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmapFormatDescriptor.SetValues;
4480 begin
4481   fFormat       := tfEmpty;
4482   fWithAlpha    := tfEmpty;
4483   fWithoutAlpha := tfEmpty;
4484   fOpenGLFormat := tfEmpty;
4485   fRGBInverted  := tfEmpty;
4486   fUncompressed := tfEmpty;
4487
4488   fBitsPerPixel := 0;
4489   fIsCompressed := false;
4490
4491   fglFormat         := 0;
4492   fglInternalFormat := 0;
4493   fglDataFormat     := 0;
4494
4495   FillChar(fPrecision, 0, SizeOf(fPrecision));
4496   FillChar(fShift,     0, SizeOf(fShift));
4497 end;
4498
4499 procedure TglBitmapFormatDescriptor.CalcValues;
4500 var
4501   i: Integer;
4502 begin
4503   fBytesPerPixel := fBitsPerPixel / 8;
4504   fChannelCount  := 0;
4505   for i := 0 to 3 do begin
4506     if (fPrecision.arr[i] > 0) then
4507       inc(fChannelCount);
4508     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
4509     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
4510   end;
4511 end;
4512
4513 constructor TglBitmapFormatDescriptor.Create;
4514 begin
4515   inherited Create;
4516   SetValues;
4517   CalcValues;
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
4522 var
4523   f: TglBitmapFormat;
4524 begin
4525   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
4526     result := TFormatDescriptor.Get(f);
4527     if (result.glInternalFormat = aInternalFormat) then
4528       exit;
4529   end;
4530   result := TFormatDescriptor.Get(tfEmpty);
4531 end;
4532
4533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4534 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4536 class procedure TFormatDescriptor.Init;
4537 begin
4538   if not Assigned(FormatDescriptorCS) then
4539     FormatDescriptorCS := TCriticalSection.Create;
4540 end;
4541
4542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4543 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4544 begin
4545   FormatDescriptorCS.Enter;
4546   try
4547     result := FormatDescriptors[aFormat];
4548     if not Assigned(result) then begin
4549       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4550       FormatDescriptors[aFormat] := result;
4551     end;
4552   finally
4553     FormatDescriptorCS.Leave;
4554   end;
4555 end;
4556
4557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4558 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4559 begin
4560   result := Get(Get(aFormat).WithAlpha);
4561 end;
4562
4563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4564 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4565 var
4566   ft: TglBitmapFormat;
4567 begin
4568   // find matching format with OpenGL support
4569   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4570     result := Get(ft);
4571     if (result.MaskMatch(aMask))      and
4572        (result.glFormat <> 0)         and
4573        (result.glInternalFormat <> 0) and
4574        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4575     then
4576       exit;
4577   end;
4578
4579   // find matching format without OpenGL Support
4580   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4581     result := Get(ft);
4582     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4583       exit;
4584   end;
4585
4586   result := TFormatDescriptor.Get(tfEmpty);
4587 end;
4588
4589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4590 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4591 var
4592   ft: TglBitmapFormat;
4593 begin
4594   // find matching format with OpenGL support
4595   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4596     result := Get(ft);
4597     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4598        glBitmapRec4ubCompare(result.Precision, aPrec) and
4599        (result.glFormat <> 0)         and
4600        (result.glInternalFormat <> 0) and
4601        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4602     then
4603       exit;
4604   end;
4605
4606   // find matching format without OpenGL Support
4607   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4608     result := Get(ft);
4609     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4610        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4611        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4612       exit;
4613   end;
4614
4615   result := TFormatDescriptor.Get(tfEmpty);
4616 end;
4617
4618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4619 class procedure TFormatDescriptor.Clear;
4620 var
4621   f: TglBitmapFormat;
4622 begin
4623   FormatDescriptorCS.Enter;
4624   try
4625     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4626       FreeAndNil(FormatDescriptors[f]);
4627   finally
4628     FormatDescriptorCS.Leave;
4629   end;
4630 end;
4631
4632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4633 class procedure TFormatDescriptor.Finalize;
4634 begin
4635   Clear;
4636   FreeAndNil(FormatDescriptorCS);
4637 end;
4638
4639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4640 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4642 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4643 var
4644   i: Integer;
4645 begin
4646   for i := 0 to 3 do begin
4647     fShift.arr[i] := 0;
4648     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4649       aMask.arr[i] := aMask.arr[i] shr 1;
4650       inc(fShift.arr[i]);
4651     end;
4652     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4653   end;
4654   CalcValues;
4655 end;
4656
4657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4658 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4659 begin
4660   fBitsPerPixel := aBBP;
4661   fPrecision    := aPrec;
4662   fShift        := aShift;
4663   CalcValues;
4664 end;
4665
4666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4667 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4668 var
4669   data: QWord;
4670 begin
4671   data :=
4672     ((aPixel.Data.r and Range.r) shl Shift.r) or
4673     ((aPixel.Data.g and Range.g) shl Shift.g) or
4674     ((aPixel.Data.b and Range.b) shl Shift.b) or
4675     ((aPixel.Data.a and Range.a) shl Shift.a);
4676   case BitsPerPixel of
4677     8:           aData^  := data;
4678    16:     PWord(aData)^ := data;
4679    32: PCardinal(aData)^ := data;
4680    64:    PQWord(aData)^ := data;
4681   else
4682     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4683   end;
4684   inc(aData, Round(BytesPerPixel));
4685 end;
4686
4687 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4688 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4689 var
4690   data: QWord;
4691   i: Integer;
4692 begin
4693   case BitsPerPixel of
4694      8: data :=           aData^;
4695     16: data :=     PWord(aData)^;
4696     32: data := PCardinal(aData)^;
4697     64: data :=    PQWord(aData)^;
4698   else
4699     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4700   end;
4701   for i := 0 to 3 do
4702     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4703   inc(aData, Round(BytesPerPixel));
4704 end;
4705
4706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4707 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4709 procedure TbmpColorTableFormat.SetValues;
4710 begin
4711   inherited SetValues;
4712   fShift := glBitmapRec4ub(8, 8, 8, 0);
4713 end;
4714
4715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4716 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4717 begin
4718   fFormat       := aFormat;
4719   fBitsPerPixel := aBPP;
4720   fPrecision    := aPrec;
4721   fShift        := aShift;
4722   CalcValues;
4723 end;
4724
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 procedure TbmpColorTableFormat.CalcValues;
4727 begin
4728   inherited CalcValues;
4729 end;
4730
4731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4732 procedure TbmpColorTableFormat.CreateColorTable;
4733 var
4734   i: Integer;
4735 begin
4736   SetLength(fColorTable, 256);
4737   if not HasColor then begin
4738     // alpha
4739     for i := 0 to High(fColorTable) do begin
4740       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4741       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4742       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4743       fColorTable[i].a := 0;
4744     end;
4745   end else begin
4746     // normal
4747     for i := 0 to High(fColorTable) do begin
4748       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4749       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4750       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4751       fColorTable[i].a := 0;
4752     end;
4753   end;
4754 end;
4755
4756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4757 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4758 begin
4759   if (BitsPerPixel <> 8) then
4760     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4761   if not HasColor then
4762     // alpha
4763     aData^ := aPixel.Data.a
4764   else
4765     // normal
4766     aData^ := Round(
4767       ((aPixel.Data.r and Range.r) shl Shift.r) or
4768       ((aPixel.Data.g and Range.g) shl Shift.g) or
4769       ((aPixel.Data.b and Range.b) shl Shift.b));
4770   inc(aData);
4771 end;
4772
4773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4774 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4775 begin
4776   if (BitsPerPixel <> 8) then
4777     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4778   with fColorTable[aData^] do begin
4779     aPixel.Data.r := r;
4780     aPixel.Data.g := g;
4781     aPixel.Data.b := b;
4782     aPixel.Data.a := a;
4783   end;
4784   inc(aData, 1);
4785 end;
4786
4787 destructor TbmpColorTableFormat.Destroy;
4788 begin
4789   SetLength(fColorTable, 0);
4790   inherited Destroy;
4791 end;
4792
4793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4794 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4796 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4797 var
4798   i: Integer;
4799 begin
4800   for i := 0 to 3 do begin
4801     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4802       if (aSourceFD.Range.arr[i] > 0) then
4803         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4804       else
4805         aPixel.Data.arr[i] := 0;
4806     end;
4807   end;
4808 end;
4809
4810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4811 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4812 begin
4813   with aFuncRec do begin
4814     if (Source.Range.r   > 0) then
4815       Dest.Data.r := Source.Data.r;
4816     if (Source.Range.g > 0) then
4817       Dest.Data.g := Source.Data.g;
4818     if (Source.Range.b  > 0) then
4819       Dest.Data.b := Source.Data.b;
4820     if (Source.Range.a > 0) then
4821       Dest.Data.a := Source.Data.a;
4822   end;
4823 end;
4824
4825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4826 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4827 var
4828   i: Integer;
4829 begin
4830   with aFuncRec do begin
4831     for i := 0 to 3 do
4832       if (Source.Range.arr[i] > 0) then
4833         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4834   end;
4835 end;
4836
4837 type
4838   TShiftData = packed record
4839     case Integer of
4840       0: (r, g, b, a: SmallInt);
4841       1: (arr: array[0..3] of SmallInt);
4842   end;
4843   PShiftData = ^TShiftData;
4844
4845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4846 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4847 var
4848   i: Integer;
4849 begin
4850   with aFuncRec do
4851     for i := 0 to 3 do
4852       if (Source.Range.arr[i] > 0) then
4853         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4854 end;
4855
4856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4857 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4858 begin
4859   with aFuncRec do begin
4860     Dest.Data := Source.Data;
4861     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4862       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4863       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4864       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4865     end;
4866     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4867       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4868     end;
4869   end;
4870 end;
4871
4872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4873 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4874 var
4875   i: Integer;
4876 begin
4877   with aFuncRec do begin
4878     for i := 0 to 3 do
4879       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4880   end;
4881 end;
4882
4883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4884 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4885 var
4886   Temp: Single;
4887 begin
4888   with FuncRec do begin
4889     if (FuncRec.Args = nil) then begin //source has no alpha
4890       Temp :=
4891         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4892         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4893         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4894       Dest.Data.a := Round(Dest.Range.a * Temp);
4895     end else
4896       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4897   end;
4898 end;
4899
4900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4901 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4902 type
4903   PglBitmapPixelData = ^TglBitmapPixelData;
4904 begin
4905   with FuncRec do begin
4906     Dest.Data.r := Source.Data.r;
4907     Dest.Data.g := Source.Data.g;
4908     Dest.Data.b := Source.Data.b;
4909
4910     with PglBitmapPixelData(Args)^ do
4911       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4912           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4913           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4914         Dest.Data.a := 0
4915       else
4916         Dest.Data.a := Dest.Range.a;
4917   end;
4918 end;
4919
4920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4921 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4922 begin
4923   with FuncRec do begin
4924     Dest.Data.r := Source.Data.r;
4925     Dest.Data.g := Source.Data.g;
4926     Dest.Data.b := Source.Data.b;
4927     Dest.Data.a := PCardinal(Args)^;
4928   end;
4929 end;
4930
4931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4932 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4933 type
4934   PRGBPix = ^TRGBPix;
4935   TRGBPix = array [0..2] of byte;
4936 var
4937   Temp: Byte;
4938 begin
4939   while aWidth > 0 do begin
4940     Temp := PRGBPix(aData)^[0];
4941     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4942     PRGBPix(aData)^[2] := Temp;
4943
4944     if aHasAlpha then
4945       Inc(aData, 4)
4946     else
4947       Inc(aData, 3);
4948     dec(aWidth);
4949   end;
4950 end;
4951
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4955 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4956 begin
4957   result := TFormatDescriptor.Get(Format);
4958 end;
4959
4960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4961 function TglBitmap.GetWidth: Integer;
4962 begin
4963   if (ffX in fDimension.Fields) then
4964     result := fDimension.X
4965   else
4966     result := -1;
4967 end;
4968
4969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4970 function TglBitmap.GetHeight: Integer;
4971 begin
4972   if (ffY in fDimension.Fields) then
4973     result := fDimension.Y
4974   else
4975     result := -1;
4976 end;
4977
4978 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4979 function TglBitmap.GetFileWidth: Integer;
4980 begin
4981   result := Max(1, Width);
4982 end;
4983
4984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4985 function TglBitmap.GetFileHeight: Integer;
4986 begin
4987   result := Max(1, Height);
4988 end;
4989
4990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4991 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4992 begin
4993   if fCustomData = aValue then
4994     exit;
4995   fCustomData := aValue;
4996 end;
4997
4998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4999 procedure TglBitmap.SetCustomName(const aValue: String);
5000 begin
5001   if fCustomName = aValue then
5002     exit;
5003   fCustomName := aValue;
5004 end;
5005
5006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5007 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
5008 begin
5009   if fCustomNameW = aValue then
5010     exit;
5011   fCustomNameW := aValue;
5012 end;
5013
5014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5015 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
5016 begin
5017   if fFreeDataOnDestroy = aValue then
5018     exit;
5019   fFreeDataOnDestroy := aValue;
5020 end;
5021
5022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5023 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
5024 begin
5025   if fDeleteTextureOnFree = aValue then
5026     exit;
5027   fDeleteTextureOnFree := aValue;
5028 end;
5029
5030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5031 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
5032 begin
5033   if fFormat = aValue then
5034     exit;
5035   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
5036     raise EglBitmapUnsupportedFormat.Create(Format);
5037   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
5038 end;
5039
5040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5041 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
5042 begin
5043   if fFreeDataAfterGenTexture = aValue then
5044     exit;
5045   fFreeDataAfterGenTexture := aValue;
5046 end;
5047
5048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5049 procedure TglBitmap.SetID(const aValue: Cardinal);
5050 begin
5051   if fID = aValue then
5052     exit;
5053   fID := aValue;
5054 end;
5055
5056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5057 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
5058 begin
5059   if fMipMap = aValue then
5060     exit;
5061   fMipMap := aValue;
5062 end;
5063
5064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5065 procedure TglBitmap.SetTarget(const aValue: Cardinal);
5066 begin
5067   if fTarget = aValue then
5068     exit;
5069   fTarget := aValue;
5070 end;
5071
5072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5073 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
5074 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
5075 var
5076   MaxAnisotropic: Integer;
5077 {$IFEND}
5078 begin
5079   fAnisotropic := aValue;
5080   if (ID > 0) then begin
5081 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
5082     if GL_EXT_texture_filter_anisotropic then begin
5083       if fAnisotropic > 0 then begin
5084         Bind(false);
5085         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
5086         if aValue > MaxAnisotropic then
5087           fAnisotropic := MaxAnisotropic;
5088         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
5089       end;
5090     end else begin
5091       fAnisotropic := 0;
5092     end;
5093 {$ELSE}
5094     fAnisotropic := 0;
5095 {$IFEND}
5096   end;
5097 end;
5098
5099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5100 procedure TglBitmap.CreateID;
5101 begin
5102   if (ID <> 0) then
5103     glDeleteTextures(1, @fID);
5104   glGenTextures(1, @fID);
5105   Bind(false);
5106 end;
5107
5108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5109 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
5110 begin
5111   // Set Up Parameters
5112   SetWrap(fWrapS, fWrapT, fWrapR);
5113   SetFilter(fFilterMin, fFilterMag);
5114   SetAnisotropic(fAnisotropic);
5115
5116 {$IFNDEF OPENGL_ES}
5117   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
5118   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5119     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
5120 {$ENDIF}
5121
5122 {$IFNDEF OPENGL_ES}
5123   // Mip Maps Generation Mode
5124   aBuildWithGlu := false;
5125   if (MipMap = mmMipmap) then begin
5126     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
5127       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
5128     else
5129       aBuildWithGlu := true;
5130   end else if (MipMap = mmMipmapGlu) then
5131     aBuildWithGlu := true;
5132 {$ELSE}
5133   if (MipMap = mmMipmap) then
5134     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
5135 {$ENDIF}
5136 end;
5137
5138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5139 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
5140   const aWidth: Integer; const aHeight: Integer);
5141 var
5142   s: Single;
5143 begin
5144   if (Data <> aData) then begin
5145     if (Assigned(Data)) then
5146       FreeMem(Data);
5147     fData := aData;
5148   end;
5149
5150   if not Assigned(fData) then begin
5151     fPixelSize := 0;
5152     fRowSize   := 0;
5153   end else begin
5154     FillChar(fDimension, SizeOf(fDimension), 0);
5155     if aWidth <> -1 then begin
5156       fDimension.Fields := fDimension.Fields + [ffX];
5157       fDimension.X := aWidth;
5158     end;
5159
5160     if aHeight <> -1 then begin
5161       fDimension.Fields := fDimension.Fields + [ffY];
5162       fDimension.Y := aHeight;
5163     end;
5164
5165     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
5166     fFormat    := aFormat;
5167     fPixelSize := Ceil(s);
5168     fRowSize   := Ceil(s * aWidth);
5169   end;
5170 end;
5171
5172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5173 function TglBitmap.FlipHorz: Boolean;
5174 begin
5175   result := false;
5176 end;
5177
5178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5179 function TglBitmap.FlipVert: Boolean;
5180 begin
5181   result := false;
5182 end;
5183
5184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5185 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5187 procedure TglBitmap.AfterConstruction;
5188 begin
5189   inherited AfterConstruction;
5190
5191   fID         := 0;
5192   fTarget     := 0;
5193 {$IFNDEF OPENGL_ES}
5194   fIsResident := false;
5195 {$ENDIF}
5196
5197   fMipMap                  := glBitmapDefaultMipmap;
5198   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
5199   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
5200
5201   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
5202   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
5203 {$IFNDEF OPENGL_ES}
5204   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
5205 {$ENDIF}
5206 end;
5207
5208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5209 procedure TglBitmap.BeforeDestruction;
5210 var
5211   NewData: PByte;
5212 begin
5213   if fFreeDataOnDestroy then begin
5214     NewData := nil;
5215     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
5216   end;
5217   if (fID > 0) and fDeleteTextureOnFree then
5218     glDeleteTextures(1, @fID);
5219   inherited BeforeDestruction;
5220 end;
5221
5222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5223 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
5224 var
5225   TempPos: Integer;
5226 begin
5227   if not Assigned(aResType) then begin
5228     TempPos   := Pos('.', aResource);
5229     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
5230     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
5231   end;
5232 end;
5233
5234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5235 procedure TglBitmap.LoadFromFile(const aFilename: String);
5236 var
5237   fs: TFileStream;
5238 begin
5239   if not FileExists(aFilename) then
5240     raise EglBitmap.Create('file does not exist: ' + aFilename);
5241   fFilename := aFilename;
5242   fs := TFileStream.Create(fFilename, fmOpenRead);
5243   try
5244     fs.Position := 0;
5245     LoadFromStream(fs);
5246   finally
5247     fs.Free;
5248   end;
5249 end;
5250
5251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5252 procedure TglBitmap.LoadFromStream(const aStream: TStream);
5253 begin
5254   {$IFDEF GLB_SUPPORT_PNG_READ}
5255   if not LoadPNG(aStream) then
5256   {$ENDIF}
5257   {$IFDEF GLB_SUPPORT_JPEG_READ}
5258   if not LoadJPEG(aStream) then
5259   {$ENDIF}
5260   if not LoadDDS(aStream) then
5261   if not LoadTGA(aStream) then
5262   if not LoadBMP(aStream) then
5263   if not LoadRAW(aStream) then
5264     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
5265 end;
5266
5267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5268 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
5269   const aFormat: TglBitmapFormat; const aArgs: Pointer);
5270 var
5271   tmpData: PByte;
5272   size: Integer;
5273 begin
5274   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5275   GetMem(tmpData, size);
5276   try
5277     FillChar(tmpData^, size, #$FF);
5278     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5279   except
5280     if Assigned(tmpData) then
5281       FreeMem(tmpData);
5282     raise;
5283   end;
5284   Convert(Self, aFunc, false, aFormat, aArgs);
5285 end;
5286
5287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5288 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
5289 var
5290   rs: TResourceStream;
5291 begin
5292   PrepareResType(aResource, aResType);
5293   rs := TResourceStream.Create(aInstance, aResource, aResType);
5294   try
5295     LoadFromStream(rs);
5296   finally
5297     rs.Free;
5298   end;
5299 end;
5300
5301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5302 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5303 var
5304   rs: TResourceStream;
5305 begin
5306   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5307   try
5308     LoadFromStream(rs);
5309   finally
5310     rs.Free;
5311   end;
5312 end;
5313
5314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5315 procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
5316 var
5317   fs: TFileStream;
5318 begin
5319   fs := TFileStream.Create(aFileName, fmCreate);
5320   try
5321     fs.Position := 0;
5322     SaveToStream(fs, aFileType);
5323   finally
5324     fs.Free;
5325   end;
5326 end;
5327
5328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5329 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
5330 begin
5331   case aFileType of
5332     {$IFDEF GLB_SUPPORT_PNG_WRITE}
5333     ftPNG:  SavePNG(aStream);
5334     {$ENDIF}
5335     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5336     ftJPEG: SaveJPEG(aStream);
5337     {$ENDIF}
5338     ftDDS:  SaveDDS(aStream);
5339     ftTGA:  SaveTGA(aStream);
5340     ftBMP:  SaveBMP(aStream);
5341     ftRAW:  SaveRAW(aStream);
5342   end;
5343 end;
5344
5345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5346 function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
5347 begin
5348   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
5349 end;
5350
5351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5352 function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
5353   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
5354 var
5355   DestData, TmpData, SourceData: pByte;
5356   TempHeight, TempWidth: Integer;
5357   SourceFD, DestFD: TFormatDescriptor;
5358   SourceMD, DestMD: Pointer;
5359
5360   FuncRec: TglBitmapFunctionRec;
5361 begin
5362   Assert(Assigned(Data));
5363   Assert(Assigned(aSource));
5364   Assert(Assigned(aSource.Data));
5365
5366   result := false;
5367   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
5368     SourceFD := TFormatDescriptor.Get(aSource.Format);
5369     DestFD   := TFormatDescriptor.Get(aFormat);
5370
5371     if (SourceFD.IsCompressed) then
5372       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
5373     if (DestFD.IsCompressed) then
5374       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
5375
5376     // inkompatible Formats so CreateTemp
5377     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
5378       aCreateTemp := true;
5379
5380     // Values
5381     TempHeight := Max(1, aSource.Height);
5382     TempWidth  := Max(1, aSource.Width);
5383
5384     FuncRec.Sender := Self;
5385     FuncRec.Args   := aArgs;
5386
5387     TmpData := nil;
5388     if aCreateTemp then begin
5389       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
5390       DestData := TmpData;
5391     end else
5392       DestData := Data;
5393
5394     try
5395       SourceFD.PreparePixel(FuncRec.Source);
5396       DestFD.PreparePixel  (FuncRec.Dest);
5397
5398       SourceMD := SourceFD.CreateMappingData;
5399       DestMD   := DestFD.CreateMappingData;
5400
5401       FuncRec.Size            := aSource.Dimension;
5402       FuncRec.Position.Fields := FuncRec.Size.Fields;
5403
5404       try
5405         SourceData := aSource.Data;
5406         FuncRec.Position.Y := 0;
5407         while FuncRec.Position.Y < TempHeight do begin
5408           FuncRec.Position.X := 0;
5409           while FuncRec.Position.X < TempWidth do begin
5410             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5411             aFunc(FuncRec);
5412             DestFD.Map(FuncRec.Dest, DestData, DestMD);
5413             inc(FuncRec.Position.X);
5414           end;
5415           inc(FuncRec.Position.Y);
5416         end;
5417
5418         // Updating Image or InternalFormat
5419         if aCreateTemp then
5420           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
5421         else if (aFormat <> fFormat) then
5422           Format := aFormat;
5423
5424         result := true;
5425       finally
5426         SourceFD.FreeMappingData(SourceMD);
5427         DestFD.FreeMappingData(DestMD);
5428       end;
5429     except
5430       if aCreateTemp and Assigned(TmpData) then
5431         FreeMem(TmpData);
5432       raise;
5433     end;
5434   end;
5435 end;
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5439 var
5440   SourceFD, DestFD: TFormatDescriptor;
5441   SourcePD, DestPD: TglBitmapPixelData;
5442   ShiftData: TShiftData;
5443
5444   function DataIsIdentical: Boolean;
5445   begin
5446     result := SourceFD.MaskMatch(DestFD.Mask);
5447   end;
5448
5449   function CanCopyDirect: Boolean;
5450   begin
5451     result :=
5452       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5453       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5454       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5455       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5456   end;
5457
5458   function CanShift: Boolean;
5459   begin
5460     result :=
5461       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5462       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5463       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5464       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5465   end;
5466
5467   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5468   begin
5469     result := 0;
5470     while (aSource > aDest) and (aSource > 0) do begin
5471       inc(result);
5472       aSource := aSource shr 1;
5473     end;
5474   end;
5475
5476 begin
5477   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5478     SourceFD := TFormatDescriptor.Get(Format);
5479     DestFD   := TFormatDescriptor.Get(aFormat);
5480
5481     if DataIsIdentical then begin
5482       result := true;
5483       Format := aFormat;
5484       exit;
5485     end;
5486
5487     SourceFD.PreparePixel(SourcePD);
5488     DestFD.PreparePixel  (DestPD);
5489
5490     if CanCopyDirect then
5491       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
5492     else if CanShift then begin
5493       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5494       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5495       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5496       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5497       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5498     end else
5499       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5500   end else
5501     result := true;
5502 end;
5503
5504 {$IFDEF GLB_SDL}
5505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5506 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
5507 var
5508   Row, RowSize: Integer;
5509   SourceData, TmpData: PByte;
5510   TempDepth: Integer;
5511   FormatDesc: TFormatDescriptor;
5512
5513   function GetRowPointer(Row: Integer): pByte;
5514   begin
5515     result := aSurface.pixels;
5516     Inc(result, Row * RowSize);
5517   end;
5518
5519 begin
5520   result := false;
5521
5522   FormatDesc := TFormatDescriptor.Get(Format);
5523   if FormatDesc.IsCompressed then
5524     raise EglBitmapUnsupportedFormat.Create(Format);
5525
5526   if Assigned(Data) then begin
5527     case Trunc(FormatDesc.PixelSize) of
5528       1: TempDepth :=  8;
5529       2: TempDepth := 16;
5530       3: TempDepth := 24;
5531       4: TempDepth := 32;
5532     else
5533       raise EglBitmapUnsupportedFormat.Create(Format);
5534     end;
5535
5536     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
5537       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
5538     SourceData := Data;
5539     RowSize    := FormatDesc.GetSize(FileWidth, 1);
5540
5541     for Row := 0 to FileHeight-1 do begin
5542       TmpData := GetRowPointer(Row);
5543       if Assigned(TmpData) then begin
5544         Move(SourceData^, TmpData^, RowSize);
5545         inc(SourceData, RowSize);
5546       end;
5547     end;
5548     result := true;
5549   end;
5550 end;
5551
5552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5553 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
5554 var
5555   pSource, pData, pTempData: PByte;
5556   Row, RowSize, TempWidth, TempHeight: Integer;
5557   IntFormat: TglBitmapFormat;
5558   fd: TFormatDescriptor;
5559   Mask: TglBitmapMask;
5560
5561   function GetRowPointer(Row: Integer): pByte;
5562   begin
5563     result := aSurface^.pixels;
5564     Inc(result, Row * RowSize);
5565   end;
5566
5567 begin
5568   result := false;
5569   if (Assigned(aSurface)) then begin
5570     with aSurface^.format^ do begin
5571       Mask.r := RMask;
5572       Mask.g := GMask;
5573       Mask.b := BMask;
5574       Mask.a := AMask;
5575       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5576       if (IntFormat = tfEmpty) then
5577         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5578     end;
5579
5580     fd := TFormatDescriptor.Get(IntFormat);
5581     TempWidth  := aSurface^.w;
5582     TempHeight := aSurface^.h;
5583     RowSize := fd.GetSize(TempWidth, 1);
5584     GetMem(pData, TempHeight * RowSize);
5585     try
5586       pTempData := pData;
5587       for Row := 0 to TempHeight -1 do begin
5588         pSource := GetRowPointer(Row);
5589         if (Assigned(pSource)) then begin
5590           Move(pSource^, pTempData^, RowSize);
5591           Inc(pTempData, RowSize);
5592         end;
5593       end;
5594       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5595       result := true;
5596     except
5597       if Assigned(pData) then
5598         FreeMem(pData);
5599       raise;
5600     end;
5601   end;
5602 end;
5603
5604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5605 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5606 var
5607   Row, Col, AlphaInterleave: Integer;
5608   pSource, pDest: PByte;
5609
5610   function GetRowPointer(Row: Integer): pByte;
5611   begin
5612     result := aSurface.pixels;
5613     Inc(result, Row * Width);
5614   end;
5615
5616 begin
5617   result := false;
5618   if Assigned(Data) then begin
5619     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5620       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5621
5622       AlphaInterleave := 0;
5623       case Format of
5624         tfLuminance8Alpha8ub2:
5625           AlphaInterleave := 1;
5626         tfBGRA8ub4, tfRGBA8ub4:
5627           AlphaInterleave := 3;
5628       end;
5629
5630       pSource := Data;
5631       for Row := 0 to Height -1 do begin
5632         pDest := GetRowPointer(Row);
5633         if Assigned(pDest) then begin
5634           for Col := 0 to Width -1 do begin
5635             Inc(pSource, AlphaInterleave);
5636             pDest^ := pSource^;
5637             Inc(pDest);
5638             Inc(pSource);
5639           end;
5640         end;
5641       end;
5642       result := true;
5643     end;
5644   end;
5645 end;
5646
5647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5648 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5649 var
5650   bmp: TglBitmap2D;
5651 begin
5652   bmp := TglBitmap2D.Create;
5653   try
5654     bmp.AssignFromSurface(aSurface);
5655     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5656   finally
5657     bmp.Free;
5658   end;
5659 end;
5660 {$ENDIF}
5661
5662 {$IFDEF GLB_DELPHI}
5663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5664 function CreateGrayPalette: HPALETTE;
5665 var
5666   Idx: Integer;
5667   Pal: PLogPalette;
5668 begin
5669   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5670
5671   Pal.palVersion := $300;
5672   Pal.palNumEntries := 256;
5673
5674   for Idx := 0 to Pal.palNumEntries - 1 do begin
5675     Pal.palPalEntry[Idx].peRed   := Idx;
5676     Pal.palPalEntry[Idx].peGreen := Idx;
5677     Pal.palPalEntry[Idx].peBlue  := Idx;
5678     Pal.palPalEntry[Idx].peFlags := 0;
5679   end;
5680   Result := CreatePalette(Pal^);
5681   FreeMem(Pal);
5682 end;
5683
5684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5685 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5686 var
5687   Row: Integer;
5688   pSource, pData: PByte;
5689 begin
5690   result := false;
5691   if Assigned(Data) then begin
5692     if Assigned(aBitmap) then begin
5693       aBitmap.Width  := Width;
5694       aBitmap.Height := Height;
5695
5696       case Format of
5697         tfAlpha8ub1, tfLuminance8ub1: begin
5698           aBitmap.PixelFormat := pf8bit;
5699           aBitmap.Palette     := CreateGrayPalette;
5700         end;
5701         tfRGB5A1us1:
5702           aBitmap.PixelFormat := pf15bit;
5703         tfR5G6B5us1:
5704           aBitmap.PixelFormat := pf16bit;
5705         tfRGB8ub3, tfBGR8ub3:
5706           aBitmap.PixelFormat := pf24bit;
5707         tfRGBA8ub4, tfBGRA8ub4:
5708           aBitmap.PixelFormat := pf32bit;
5709       else
5710         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5711       end;
5712
5713       pSource := Data;
5714       for Row := 0 to FileHeight -1 do begin
5715         pData := aBitmap.Scanline[Row];
5716         Move(pSource^, pData^, fRowSize);
5717         Inc(pSource, fRowSize);
5718         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5719           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5720       end;
5721       result := true;
5722     end;
5723   end;
5724 end;
5725
5726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5727 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5728 var
5729   pSource, pData, pTempData: PByte;
5730   Row, RowSize, TempWidth, TempHeight: Integer;
5731   IntFormat: TglBitmapFormat;
5732 begin
5733   result := false;
5734
5735   if (Assigned(aBitmap)) then begin
5736     case aBitmap.PixelFormat of
5737       pf8bit:
5738         IntFormat := tfLuminance8ub1;
5739       pf15bit:
5740         IntFormat := tfRGB5A1us1;
5741       pf16bit:
5742         IntFormat := tfR5G6B5us1;
5743       pf24bit:
5744         IntFormat := tfBGR8ub3;
5745       pf32bit:
5746         IntFormat := tfBGRA8ub4;
5747     else
5748       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5749     end;
5750
5751     TempWidth  := aBitmap.Width;
5752     TempHeight := aBitmap.Height;
5753     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5754     GetMem(pData, TempHeight * RowSize);
5755     try
5756       pTempData := pData;
5757       for Row := 0 to TempHeight -1 do begin
5758         pSource := aBitmap.Scanline[Row];
5759         if (Assigned(pSource)) then begin
5760           Move(pSource^, pTempData^, RowSize);
5761           Inc(pTempData, RowSize);
5762         end;
5763       end;
5764       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5765       result := true;
5766     except
5767       if Assigned(pData) then
5768         FreeMem(pData);
5769       raise;
5770     end;
5771   end;
5772 end;
5773
5774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5775 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5776 var
5777   Row, Col, AlphaInterleave: Integer;
5778   pSource, pDest: PByte;
5779 begin
5780   result := false;
5781
5782   if Assigned(Data) then begin
5783     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5784       if Assigned(aBitmap) then begin
5785         aBitmap.PixelFormat := pf8bit;
5786         aBitmap.Palette     := CreateGrayPalette;
5787         aBitmap.Width       := Width;
5788         aBitmap.Height      := Height;
5789
5790         case Format of
5791           tfLuminance8Alpha8ub2:
5792             AlphaInterleave := 1;
5793           tfRGBA8ub4, tfBGRA8ub4:
5794             AlphaInterleave := 3;
5795           else
5796             AlphaInterleave := 0;
5797         end;
5798
5799         // Copy Data
5800         pSource := Data;
5801
5802         for Row := 0 to Height -1 do begin
5803           pDest := aBitmap.Scanline[Row];
5804           if Assigned(pDest) then begin
5805             for Col := 0 to Width -1 do begin
5806               Inc(pSource, AlphaInterleave);
5807               pDest^ := pSource^;
5808               Inc(pDest);
5809               Inc(pSource);
5810             end;
5811           end;
5812         end;
5813         result := true;
5814       end;
5815     end;
5816   end;
5817 end;
5818
5819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5820 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5821 var
5822   tex: TglBitmap2D;
5823 begin
5824   tex := TglBitmap2D.Create;
5825   try
5826     tex.AssignFromBitmap(ABitmap);
5827     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5828   finally
5829     tex.Free;
5830   end;
5831 end;
5832 {$ENDIF}
5833
5834 {$IFDEF GLB_LAZARUS}
5835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5836 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5837 var
5838   rid: TRawImageDescription;
5839   FormatDesc: TFormatDescriptor;
5840 begin
5841   if not Assigned(Data) then
5842     raise EglBitmap.Create('no pixel data assigned. load data before save');
5843
5844   result := false;
5845   if not Assigned(aImage) or (Format = tfEmpty) then
5846     exit;
5847   FormatDesc := TFormatDescriptor.Get(Format);
5848   if FormatDesc.IsCompressed then
5849     exit;
5850
5851   FillChar(rid{%H-}, SizeOf(rid), 0);
5852   if FormatDesc.IsGrayscale then
5853     rid.Format := ricfGray
5854   else
5855     rid.Format := ricfRGBA;
5856
5857   rid.Width        := Width;
5858   rid.Height       := Height;
5859   rid.Depth        := FormatDesc.BitsPerPixel;
5860   rid.BitOrder     := riboBitsInOrder;
5861   rid.ByteOrder    := riboLSBFirst;
5862   rid.LineOrder    := riloTopToBottom;
5863   rid.LineEnd      := rileTight;
5864   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5865   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5866   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5867   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5868   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5869   rid.RedShift     := FormatDesc.Shift.r;
5870   rid.GreenShift   := FormatDesc.Shift.g;
5871   rid.BlueShift    := FormatDesc.Shift.b;
5872   rid.AlphaShift   := FormatDesc.Shift.a;
5873
5874   rid.MaskBitsPerPixel  := 0;
5875   rid.PaletteColorCount := 0;
5876
5877   aImage.DataDescription := rid;
5878   aImage.CreateData;
5879
5880   if not Assigned(aImage.PixelData) then
5881     raise EglBitmap.Create('error while creating LazIntfImage');
5882   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5883
5884   result := true;
5885 end;
5886
5887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5888 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5889 var
5890   f: TglBitmapFormat;
5891   FormatDesc: TFormatDescriptor;
5892   ImageData: PByte;
5893   ImageSize: Integer;
5894   CanCopy: Boolean;
5895   Mask: TglBitmapRec4ul;
5896
5897   procedure CopyConvert;
5898   var
5899     bfFormat: TbmpBitfieldFormat;
5900     pSourceLine, pDestLine: PByte;
5901     pSourceMD, pDestMD: Pointer;
5902     Shift, Prec: TglBitmapRec4ub;
5903     x, y: Integer;
5904     pixel: TglBitmapPixelData;
5905   begin
5906     bfFormat  := TbmpBitfieldFormat.Create;
5907     with aImage.DataDescription do begin
5908       Prec.r := RedPrec;
5909       Prec.g := GreenPrec;
5910       Prec.b := BluePrec;
5911       Prec.a := AlphaPrec;
5912       Shift.r := RedShift;
5913       Shift.g := GreenShift;
5914       Shift.b := BlueShift;
5915       Shift.a := AlphaShift;
5916       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5917     end;
5918     pSourceMD := bfFormat.CreateMappingData;
5919     pDestMD   := FormatDesc.CreateMappingData;
5920     try
5921       for y := 0 to aImage.Height-1 do begin
5922         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5923         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5924         for x := 0 to aImage.Width-1 do begin
5925           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5926           FormatDesc.Map(pixel, pDestLine, pDestMD);
5927         end;
5928       end;
5929     finally
5930       FormatDesc.FreeMappingData(pDestMD);
5931       bfFormat.FreeMappingData(pSourceMD);
5932       bfFormat.Free;
5933     end;
5934   end;
5935
5936 begin
5937   result := false;
5938   if not Assigned(aImage) then
5939     exit;
5940
5941   with aImage.DataDescription do begin
5942     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5943     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5944     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5945     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5946   end;
5947   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5948   f          := FormatDesc.Format;
5949   if (f = tfEmpty) then
5950     exit;
5951
5952   CanCopy :=
5953     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5954     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5955
5956   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5957   ImageData := GetMem(ImageSize);
5958   try
5959     if CanCopy then
5960       Move(aImage.PixelData^, ImageData^, ImageSize)
5961     else
5962       CopyConvert;
5963     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5964   except
5965     if Assigned(ImageData) then
5966       FreeMem(ImageData);
5967     raise;
5968   end;
5969
5970   result := true;
5971 end;
5972
5973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5974 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5975 var
5976   rid: TRawImageDescription;
5977   FormatDesc: TFormatDescriptor;
5978   Pixel: TglBitmapPixelData;
5979   x, y: Integer;
5980   srcMD: Pointer;
5981   src, dst: PByte;
5982 begin
5983   result := false;
5984   if not Assigned(aImage) or (Format = tfEmpty) then
5985     exit;
5986   FormatDesc := TFormatDescriptor.Get(Format);
5987   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5988     exit;
5989
5990   FillChar(rid{%H-}, SizeOf(rid), 0);
5991   rid.Format       := ricfGray;
5992   rid.Width        := Width;
5993   rid.Height       := Height;
5994   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5995   rid.BitOrder     := riboBitsInOrder;
5996   rid.ByteOrder    := riboLSBFirst;
5997   rid.LineOrder    := riloTopToBottom;
5998   rid.LineEnd      := rileTight;
5999   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
6000   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
6001   rid.GreenPrec    := 0;
6002   rid.BluePrec     := 0;
6003   rid.AlphaPrec    := 0;
6004   rid.RedShift     := 0;
6005   rid.GreenShift   := 0;
6006   rid.BlueShift    := 0;
6007   rid.AlphaShift   := 0;
6008
6009   rid.MaskBitsPerPixel  := 0;
6010   rid.PaletteColorCount := 0;
6011
6012   aImage.DataDescription := rid;
6013   aImage.CreateData;
6014
6015   srcMD := FormatDesc.CreateMappingData;
6016   try
6017     FormatDesc.PreparePixel(Pixel);
6018     src := Data;
6019     dst := aImage.PixelData;
6020     for y := 0 to Height-1 do
6021       for x := 0 to Width-1 do begin
6022         FormatDesc.Unmap(src, Pixel, srcMD);
6023         case rid.BitsPerPixel of
6024            8: begin
6025             dst^ := Pixel.Data.a;
6026             inc(dst);
6027           end;
6028           16: begin
6029             PWord(dst)^ := Pixel.Data.a;
6030             inc(dst, 2);
6031           end;
6032           24: begin
6033             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
6034             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
6035             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
6036             inc(dst, 3);
6037           end;
6038           32: begin
6039             PCardinal(dst)^ := Pixel.Data.a;
6040             inc(dst, 4);
6041           end;
6042         else
6043           raise EglBitmapUnsupportedFormat.Create(Format);
6044         end;
6045       end;
6046   finally
6047     FormatDesc.FreeMappingData(srcMD);
6048   end;
6049   result := true;
6050 end;
6051
6052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6053 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6054 var
6055   tex: TglBitmap2D;
6056 begin
6057   tex := TglBitmap2D.Create;
6058   try
6059     tex.AssignFromLazIntfImage(aImage);
6060     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
6061   finally
6062     tex.Free;
6063   end;
6064 end;
6065 {$ENDIF}
6066
6067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6068 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
6069   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6070 var
6071   rs: TResourceStream;
6072 begin
6073   PrepareResType(aResource, aResType);
6074   rs := TResourceStream.Create(aInstance, aResource, aResType);
6075   try
6076     result := AddAlphaFromStream(rs, aFunc, aArgs);
6077   finally
6078     rs.Free;
6079   end;
6080 end;
6081
6082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6083 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
6084   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6085 var
6086   rs: TResourceStream;
6087 begin
6088   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6089   try
6090     result := AddAlphaFromStream(rs, aFunc, aArgs);
6091   finally
6092     rs.Free;
6093   end;
6094 end;
6095
6096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6097 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6098 begin
6099   if TFormatDescriptor.Get(Format).IsCompressed then
6100     raise EglBitmapUnsupportedFormat.Create(Format);
6101   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
6102 end;
6103
6104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6105 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6106 var
6107   FS: TFileStream;
6108 begin
6109   FS := TFileStream.Create(aFileName, fmOpenRead);
6110   try
6111     result := AddAlphaFromStream(FS, aFunc, aArgs);
6112   finally
6113     FS.Free;
6114   end;
6115 end;
6116
6117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6118 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6119 var
6120   tex: TglBitmap2D;
6121 begin
6122   tex := TglBitmap2D.Create(aStream);
6123   try
6124     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
6125   finally
6126     tex.Free;
6127   end;
6128 end;
6129
6130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6131 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
6132 var
6133   DestData, DestData2, SourceData: pByte;
6134   TempHeight, TempWidth: Integer;
6135   SourceFD, DestFD: TFormatDescriptor;
6136   SourceMD, DestMD, DestMD2: Pointer;
6137
6138   FuncRec: TglBitmapFunctionRec;
6139 begin
6140   result := false;
6141
6142   Assert(Assigned(Data));
6143   Assert(Assigned(aBitmap));
6144   Assert(Assigned(aBitmap.Data));
6145
6146   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
6147     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
6148
6149     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
6150     DestFD   := TFormatDescriptor.Get(Format);
6151
6152     if not Assigned(aFunc) then begin
6153       aFunc        := glBitmapAlphaFunc;
6154       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
6155     end else
6156       FuncRec.Args := aArgs;
6157
6158     // Values
6159     TempHeight := aBitmap.FileHeight;
6160     TempWidth  := aBitmap.FileWidth;
6161
6162     FuncRec.Sender          := Self;
6163     FuncRec.Size            := Dimension;
6164     FuncRec.Position.Fields := FuncRec.Size.Fields;
6165
6166     DestData   := Data;
6167     DestData2  := Data;
6168     SourceData := aBitmap.Data;
6169
6170     // Mapping
6171     SourceFD.PreparePixel(FuncRec.Source);
6172     DestFD.PreparePixel  (FuncRec.Dest);
6173
6174     SourceMD := SourceFD.CreateMappingData;
6175     DestMD   := DestFD.CreateMappingData;
6176     DestMD2  := DestFD.CreateMappingData;
6177     try
6178       FuncRec.Position.Y := 0;
6179       while FuncRec.Position.Y < TempHeight do begin
6180         FuncRec.Position.X := 0;
6181         while FuncRec.Position.X < TempWidth do begin
6182           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6183           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
6184           aFunc(FuncRec);
6185           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
6186           inc(FuncRec.Position.X);
6187         end;
6188         inc(FuncRec.Position.Y);
6189       end;
6190     finally
6191       SourceFD.FreeMappingData(SourceMD);
6192       DestFD.FreeMappingData(DestMD);
6193       DestFD.FreeMappingData(DestMD2);
6194     end;
6195   end;
6196 end;
6197
6198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6199 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
6200 begin
6201   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
6202 end;
6203
6204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6205 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
6206 var
6207   PixelData: TglBitmapPixelData;
6208 begin
6209   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6210   result := AddAlphaFromColorKeyFloat(
6211     aRed   / PixelData.Range.r,
6212     aGreen / PixelData.Range.g,
6213     aBlue  / PixelData.Range.b,
6214     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
6215 end;
6216
6217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6218 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
6219 var
6220   values: array[0..2] of Single;
6221   tmp: Cardinal;
6222   i: Integer;
6223   PixelData: TglBitmapPixelData;
6224 begin
6225   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6226   with PixelData do begin
6227     values[0] := aRed;
6228     values[1] := aGreen;
6229     values[2] := aBlue;
6230
6231     for i := 0 to 2 do begin
6232       tmp          := Trunc(Range.arr[i] * aDeviation);
6233       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
6234       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
6235     end;
6236     Data.a  := 0;
6237     Range.a := 0;
6238   end;
6239   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
6240 end;
6241
6242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6243 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
6244 begin
6245   result := AddAlphaFromValueFloat(aAlpha / $FF);
6246 end;
6247
6248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6249 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
6250 var
6251   PixelData: TglBitmapPixelData;
6252 begin
6253   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6254   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
6255 end;
6256
6257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6258 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
6259 var
6260   PixelData: TglBitmapPixelData;
6261 begin
6262   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6263   with PixelData do
6264     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
6265   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
6266 end;
6267
6268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6269 function TglBitmap.RemoveAlpha: Boolean;
6270 var
6271   FormatDesc: TFormatDescriptor;
6272 begin
6273   result := false;
6274   FormatDesc := TFormatDescriptor.Get(Format);
6275   if Assigned(Data) then begin
6276     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
6277       raise EglBitmapUnsupportedFormat.Create(Format);
6278     result := ConvertTo(FormatDesc.WithoutAlpha);
6279   end;
6280 end;
6281
6282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6283 function TglBitmap.Clone: TglBitmap;
6284 var
6285   Temp: TglBitmap;
6286   TempPtr: PByte;
6287   Size: Integer;
6288 begin
6289   result := nil;
6290   Temp := (ClassType.Create as TglBitmap);
6291   try
6292     // copy texture data if assigned
6293     if Assigned(Data) then begin
6294       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
6295       GetMem(TempPtr, Size);
6296       try
6297         Move(Data^, TempPtr^, Size);
6298         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
6299       except
6300         if Assigned(TempPtr) then
6301           FreeMem(TempPtr);
6302         raise;
6303       end;
6304     end else begin
6305       TempPtr := nil;
6306       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
6307     end;
6308
6309         // copy properties
6310     Temp.fID                      := ID;
6311     Temp.fTarget                  := Target;
6312     Temp.fFormat                  := Format;
6313     Temp.fMipMap                  := MipMap;
6314     Temp.fAnisotropic             := Anisotropic;
6315     Temp.fBorderColor             := fBorderColor;
6316     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
6317     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
6318     Temp.fFilterMin               := fFilterMin;
6319     Temp.fFilterMag               := fFilterMag;
6320     Temp.fWrapS                   := fWrapS;
6321     Temp.fWrapT                   := fWrapT;
6322     Temp.fWrapR                   := fWrapR;
6323     Temp.fFilename                := fFilename;
6324     Temp.fCustomName              := fCustomName;
6325     Temp.fCustomNameW             := fCustomNameW;
6326     Temp.fCustomData              := fCustomData;
6327
6328     result := Temp;
6329   except
6330     FreeAndNil(Temp);
6331     raise;
6332   end;
6333 end;
6334
6335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6336 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
6337 begin
6338   if aUseRGB or aUseAlpha then
6339     Convert(glBitmapInvertFunc, false, {%H-}Pointer(
6340       ((Byte(aUseAlpha) and 1) shl 1) or
6341        (Byte(aUseRGB)   and 1)      ));
6342 end;
6343
6344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6345 procedure TglBitmap.FreeData;
6346 var
6347   TempPtr: PByte;
6348 begin
6349   TempPtr := nil;
6350   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
6351 end;
6352
6353 {$IFNDEF OPENGL_ES}
6354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6355 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
6356 begin
6357   fBorderColor[0] := aRed;
6358   fBorderColor[1] := aGreen;
6359   fBorderColor[2] := aBlue;
6360   fBorderColor[3] := aAlpha;
6361   if (ID > 0) then begin
6362     Bind(false);
6363     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6364   end;
6365 end;
6366 {$ENDIF}
6367
6368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6369 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
6370   const aAlpha: Byte);
6371 begin
6372   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
6373 end;
6374
6375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6376 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
6377 var
6378   PixelData: TglBitmapPixelData;
6379 begin
6380   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
6381   FillWithColorFloat(
6382     aRed   / PixelData.Range.r,
6383     aGreen / PixelData.Range.g,
6384     aBlue  / PixelData.Range.b,
6385     aAlpha / PixelData.Range.a);
6386 end;
6387
6388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6389 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
6390 var
6391   PixelData: TglBitmapPixelData;
6392 begin
6393   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
6394   with PixelData do begin
6395     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
6396     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
6397     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
6398     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
6399   end;
6400   Convert(glBitmapFillWithColorFunc, false, @PixelData);
6401 end;
6402
6403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6404 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
6405 begin
6406   //check MIN filter
6407   case aMin of
6408     GL_NEAREST:
6409       fFilterMin := GL_NEAREST;
6410     GL_LINEAR:
6411       fFilterMin := GL_LINEAR;
6412     GL_NEAREST_MIPMAP_NEAREST:
6413       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
6414     GL_LINEAR_MIPMAP_NEAREST:
6415       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
6416     GL_NEAREST_MIPMAP_LINEAR:
6417       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
6418     GL_LINEAR_MIPMAP_LINEAR:
6419       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
6420     else
6421       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
6422   end;
6423
6424   //check MAG filter
6425   case aMag of
6426     GL_NEAREST:
6427       fFilterMag := GL_NEAREST;
6428     GL_LINEAR:
6429       fFilterMag := GL_LINEAR;
6430     else
6431       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
6432   end;
6433
6434   //apply filter
6435   if (ID > 0) then begin
6436     Bind(false);
6437     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
6438
6439     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
6440       case fFilterMin of
6441         GL_NEAREST, GL_LINEAR:
6442           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6443         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
6444           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
6445         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
6446           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
6447       end;
6448     end else
6449       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
6450   end;
6451 end;
6452
6453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6454 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
6455
6456   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
6457   begin
6458     case aValue of
6459 {$IFNDEF OPENGL_ES}
6460       GL_CLAMP:
6461         aTarget := GL_CLAMP;
6462 {$ENDIF}
6463
6464       GL_REPEAT:
6465         aTarget := GL_REPEAT;
6466
6467       GL_CLAMP_TO_EDGE: begin
6468 {$IFNDEF OPENGL_ES}
6469         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
6470           aTarget := GL_CLAMP
6471         else
6472 {$ENDIF}
6473           aTarget := GL_CLAMP_TO_EDGE;
6474       end;
6475
6476 {$IFNDEF OPENGL_ES}
6477       GL_CLAMP_TO_BORDER: begin
6478         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
6479           aTarget := GL_CLAMP_TO_BORDER
6480         else
6481           aTarget := GL_CLAMP;
6482       end;
6483 {$ENDIF}
6484
6485 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
6486       GL_MIRRORED_REPEAT: begin
6487   {$IFNDEF OPENGL_ES}
6488         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
6489   {$ELSE}
6490         if GL_VERSION_2_0 then
6491   {$ENDIF}
6492           aTarget := GL_MIRRORED_REPEAT
6493         else
6494           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
6495       end;
6496 {$IFEND}
6497     else
6498       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
6499     end;
6500   end;
6501
6502 begin
6503   CheckAndSetWrap(S, fWrapS);
6504   CheckAndSetWrap(T, fWrapT);
6505   CheckAndSetWrap(R, fWrapR);
6506
6507   if (ID > 0) then begin
6508     Bind(false);
6509     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
6510     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
6511 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6512     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
6513     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
6514 {$IFEND}
6515   end;
6516 end;
6517
6518 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
6519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6520 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
6521
6522   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
6523   begin
6524     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
6525        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
6526       fSwizzle[aIndex] := aValue
6527     else
6528       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
6529   end;
6530
6531 begin
6532 {$IFNDEF OPENGL_ES}
6533   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
6534     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6535 {$ELSE}
6536   if not GL_VERSION_3_0 then
6537     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
6538 {$ENDIF}
6539   CheckAndSetValue(r, 0);
6540   CheckAndSetValue(g, 1);
6541   CheckAndSetValue(b, 2);
6542   CheckAndSetValue(a, 3);
6543
6544   if (ID > 0) then begin
6545     Bind(false);
6546 {$IFNDEF OPENGL_ES}
6547     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
6548 {$ELSE}
6549     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
6550     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
6551     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
6552     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
6553 {$ENDIF}
6554   end;
6555 end;
6556 {$IFEND}
6557
6558 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6559 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
6560 begin
6561   if aEnableTextureUnit then
6562     glEnable(Target);
6563   if (ID > 0) then
6564     glBindTexture(Target, ID);
6565 end;
6566
6567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6568 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6569 begin
6570   if aDisableTextureUnit then
6571     glDisable(Target);
6572   glBindTexture(Target, 0);
6573 end;
6574
6575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6576 constructor TglBitmap.Create;
6577 begin
6578   if (ClassType = TglBitmap) then
6579     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6580 {$IFDEF GLB_NATIVE_OGL}
6581   glbReadOpenGLExtensions;
6582 {$ENDIF}
6583   inherited Create;
6584   fFormat            := glBitmapGetDefaultFormat;
6585   fFreeDataOnDestroy := true;
6586 end;
6587
6588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6589 constructor TglBitmap.Create(const aFileName: String);
6590 begin
6591   Create;
6592   LoadFromFile(aFileName);
6593 end;
6594
6595 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6596 constructor TglBitmap.Create(const aStream: TStream);
6597 begin
6598   Create;
6599   LoadFromStream(aStream);
6600 end;
6601
6602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6603 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
6604 var
6605   ImageSize: Integer;
6606 begin
6607   Create;
6608   if not Assigned(aData) then begin
6609     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6610     GetMem(aData, ImageSize);
6611     try
6612       FillChar(aData^, ImageSize, #$FF);
6613       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6614     except
6615       if Assigned(aData) then
6616         FreeMem(aData);
6617       raise;
6618     end;
6619   end else begin
6620     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6621   end;
6622 end;
6623
6624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6625 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6626 begin
6627   Create;
6628   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6629 end;
6630
6631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6632 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6633 begin
6634   Create;
6635   LoadFromResource(aInstance, aResource, aResType);
6636 end;
6637
6638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6639 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6640 begin
6641   Create;
6642   LoadFromResourceID(aInstance, aResourceID, aResType);
6643 end;
6644
6645 {$IFDEF GLB_SUPPORT_PNG_READ}
6646 {$IF DEFINED(GLB_LAZ_PNG)}
6647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6648 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6650 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6651 const
6652   MAGIC_LEN = 8;
6653   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6654 var
6655   reader: TLazReaderPNG;
6656   intf: TLazIntfImage;
6657   StreamPos: Int64;
6658   magic: String[MAGIC_LEN];
6659 begin
6660   result := true;
6661   StreamPos := aStream.Position;
6662
6663   SetLength(magic, MAGIC_LEN);
6664   aStream.Read(magic[1], MAGIC_LEN);
6665   aStream.Position := StreamPos;
6666   if (magic <> PNG_MAGIC) then begin
6667     result := false;
6668     exit;
6669   end;
6670
6671   intf   := TLazIntfImage.Create(0, 0);
6672   reader := TLazReaderPNG.Create;
6673   try try
6674     reader.UpdateDescription := true;
6675     reader.ImageRead(aStream, intf);
6676     AssignFromLazIntfImage(intf);
6677   except
6678     result := false;
6679     aStream.Position := StreamPos;
6680     exit;
6681   end;
6682   finally
6683     reader.Free;
6684     intf.Free;
6685   end;
6686 end;
6687
6688 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6690 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6691 var
6692   Surface: PSDL_Surface;
6693   RWops: PSDL_RWops;
6694 begin
6695   result := false;
6696   RWops := glBitmapCreateRWops(aStream);
6697   try
6698     if IMG_isPNG(RWops) > 0 then begin
6699       Surface := IMG_LoadPNG_RW(RWops);
6700       try
6701         AssignFromSurface(Surface);
6702         result := true;
6703       finally
6704         SDL_FreeSurface(Surface);
6705       end;
6706     end;
6707   finally
6708     SDL_FreeRW(RWops);
6709   end;
6710 end;
6711
6712 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6714 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6715 begin
6716   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6717 end;
6718
6719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6720 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6721 var
6722   StreamPos: Int64;
6723   signature: array [0..7] of byte;
6724   png: png_structp;
6725   png_info: png_infop;
6726
6727   TempHeight, TempWidth: Integer;
6728   Format: TglBitmapFormat;
6729
6730   png_data: pByte;
6731   png_rows: array of pByte;
6732   Row, LineSize: Integer;
6733 begin
6734   result := false;
6735
6736   if not init_libPNG then
6737     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6738
6739   try
6740     // signature
6741     StreamPos := aStream.Position;
6742     aStream.Read(signature{%H-}, 8);
6743     aStream.Position := StreamPos;
6744
6745     if png_check_sig(@signature, 8) <> 0 then begin
6746       // png read struct
6747       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6748       if png = nil then
6749         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6750
6751       // png info
6752       png_info := png_create_info_struct(png);
6753       if png_info = nil then begin
6754         png_destroy_read_struct(@png, nil, nil);
6755         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6756       end;
6757
6758       // set read callback
6759       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6760
6761       // read informations
6762       png_read_info(png, png_info);
6763
6764       // size
6765       TempHeight := png_get_image_height(png, png_info);
6766       TempWidth := png_get_image_width(png, png_info);
6767
6768       // format
6769       case png_get_color_type(png, png_info) of
6770         PNG_COLOR_TYPE_GRAY:
6771           Format := tfLuminance8ub1;
6772         PNG_COLOR_TYPE_GRAY_ALPHA:
6773           Format := tfLuminance8Alpha8us1;
6774         PNG_COLOR_TYPE_RGB:
6775           Format := tfRGB8ub3;
6776         PNG_COLOR_TYPE_RGB_ALPHA:
6777           Format := tfRGBA8ub4;
6778         else
6779           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6780       end;
6781
6782       // cut upper 8 bit from 16 bit formats
6783       if png_get_bit_depth(png, png_info) > 8 then
6784         png_set_strip_16(png);
6785
6786       // expand bitdepth smaller than 8
6787       if png_get_bit_depth(png, png_info) < 8 then
6788         png_set_expand(png);
6789
6790       // allocating mem for scanlines
6791       LineSize := png_get_rowbytes(png, png_info);
6792       GetMem(png_data, TempHeight * LineSize);
6793       try
6794         SetLength(png_rows, TempHeight);
6795         for Row := Low(png_rows) to High(png_rows) do begin
6796           png_rows[Row] := png_data;
6797           Inc(png_rows[Row], Row * LineSize);
6798         end;
6799
6800         // read complete image into scanlines
6801         png_read_image(png, @png_rows[0]);
6802
6803         // read end
6804         png_read_end(png, png_info);
6805
6806         // destroy read struct
6807         png_destroy_read_struct(@png, @png_info, nil);
6808
6809         SetLength(png_rows, 0);
6810
6811         // set new data
6812         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6813
6814         result := true;
6815       except
6816         if Assigned(png_data) then
6817           FreeMem(png_data);
6818         raise;
6819       end;
6820     end;
6821   finally
6822     quit_libPNG;
6823   end;
6824 end;
6825
6826 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6828 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6829 var
6830   StreamPos: Int64;
6831   Png: TPNGObject;
6832   Header: String[8];
6833   Row, Col, PixSize, LineSize: Integer;
6834   NewImage, pSource, pDest, pAlpha: pByte;
6835   PngFormat: TglBitmapFormat;
6836   FormatDesc: TFormatDescriptor;
6837
6838 const
6839   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6840
6841 begin
6842   result := false;
6843
6844   StreamPos := aStream.Position;
6845   aStream.Read(Header[0], SizeOf(Header));
6846   aStream.Position := StreamPos;
6847
6848   {Test if the header matches}
6849   if Header = PngHeader then begin
6850     Png := TPNGObject.Create;
6851     try
6852       Png.LoadFromStream(aStream);
6853
6854       case Png.Header.ColorType of
6855         COLOR_GRAYSCALE:
6856           PngFormat := tfLuminance8ub1;
6857         COLOR_GRAYSCALEALPHA:
6858           PngFormat := tfLuminance8Alpha8us1;
6859         COLOR_RGB:
6860           PngFormat := tfBGR8ub3;
6861         COLOR_RGBALPHA:
6862           PngFormat := tfBGRA8ub4;
6863         else
6864           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6865       end;
6866
6867       FormatDesc := TFormatDescriptor.Get(PngFormat);
6868       PixSize    := Round(FormatDesc.PixelSize);
6869       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6870
6871       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6872       try
6873         pDest := NewImage;
6874
6875         case Png.Header.ColorType of
6876           COLOR_RGB, COLOR_GRAYSCALE:
6877             begin
6878               for Row := 0 to Png.Height -1 do begin
6879                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6880                 Inc(pDest, LineSize);
6881               end;
6882             end;
6883           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6884             begin
6885               PixSize := PixSize -1;
6886
6887               for Row := 0 to Png.Height -1 do begin
6888                 pSource := Png.Scanline[Row];
6889                 pAlpha := pByte(Png.AlphaScanline[Row]);
6890
6891                 for Col := 0 to Png.Width -1 do begin
6892                   Move (pSource^, pDest^, PixSize);
6893                   Inc(pSource, PixSize);
6894                   Inc(pDest, PixSize);
6895
6896                   pDest^ := pAlpha^;
6897                   inc(pAlpha);
6898                   Inc(pDest);
6899                 end;
6900               end;
6901             end;
6902           else
6903             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6904         end;
6905
6906         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6907
6908         result := true;
6909       except
6910         if Assigned(NewImage) then
6911           FreeMem(NewImage);
6912         raise;
6913       end;
6914     finally
6915       Png.Free;
6916     end;
6917   end;
6918 end;
6919 {$IFEND}
6920 {$ENDIF}
6921
6922 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6923 {$IFDEF GLB_LIB_PNG}
6924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6925 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6926 begin
6927   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6928 end;
6929 {$ENDIF}
6930
6931 {$IF DEFINED(GLB_LAZ_PNG)}
6932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6933 procedure TglBitmap.SavePNG(const aStream: TStream);
6934 var
6935   png: TPortableNetworkGraphic;
6936   intf: TLazIntfImage;
6937   raw: TRawImage;
6938 begin
6939   png  := TPortableNetworkGraphic.Create;
6940   intf := TLazIntfImage.Create(0, 0);
6941   try
6942     if not AssignToLazIntfImage(intf) then
6943       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6944     intf.GetRawImage(raw);
6945     png.LoadFromRawImage(raw, false);
6946     png.SaveToStream(aStream);
6947   finally
6948     png.Free;
6949     intf.Free;
6950   end;
6951 end;
6952
6953 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6955 procedure TglBitmap.SavePNG(const aStream: TStream);
6956 var
6957   png: png_structp;
6958   png_info: png_infop;
6959   png_rows: array of pByte;
6960   LineSize: Integer;
6961   ColorType: Integer;
6962   Row: Integer;
6963   FormatDesc: TFormatDescriptor;
6964 begin
6965   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6966     raise EglBitmapUnsupportedFormat.Create(Format);
6967
6968   if not init_libPNG then
6969     raise Exception.Create('unable to initialize libPNG.');
6970
6971   try
6972     case Format of
6973       tfAlpha8ub1, tfLuminance8ub1:
6974         ColorType := PNG_COLOR_TYPE_GRAY;
6975       tfLuminance8Alpha8us1:
6976         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6977       tfBGR8ub3, tfRGB8ub3:
6978         ColorType := PNG_COLOR_TYPE_RGB;
6979       tfBGRA8ub4, tfRGBA8ub4:
6980         ColorType := PNG_COLOR_TYPE_RGBA;
6981       else
6982         raise EglBitmapUnsupportedFormat.Create(Format);
6983     end;
6984
6985     FormatDesc := TFormatDescriptor.Get(Format);
6986     LineSize := FormatDesc.GetSize(Width, 1);
6987
6988     // creating array for scanline
6989     SetLength(png_rows, Height);
6990     try
6991       for Row := 0 to Height - 1 do begin
6992         png_rows[Row] := Data;
6993         Inc(png_rows[Row], Row * LineSize)
6994       end;
6995
6996       // write struct
6997       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6998       if png = nil then
6999         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
7000
7001       // create png info
7002       png_info := png_create_info_struct(png);
7003       if png_info = nil then begin
7004         png_destroy_write_struct(@png, nil);
7005         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
7006       end;
7007
7008       // set read callback
7009       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
7010
7011       // set compression
7012       png_set_compression_level(png, 6);
7013
7014       if Format in [tfBGR8ub3, tfBGRA8ub4] then
7015         png_set_bgr(png);
7016
7017       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
7018       png_write_info(png, png_info);
7019       png_write_image(png, @png_rows[0]);
7020       png_write_end(png, png_info);
7021       png_destroy_write_struct(@png, @png_info);
7022     finally
7023       SetLength(png_rows, 0);
7024     end;
7025   finally
7026     quit_libPNG;
7027   end;
7028 end;
7029
7030 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
7031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7032 procedure TglBitmap.SavePNG(const aStream: TStream);
7033 var
7034   Png: TPNGObject;
7035
7036   pSource, pDest: pByte;
7037   X, Y, PixSize: Integer;
7038   ColorType: Cardinal;
7039   Alpha: Boolean;
7040
7041   pTemp: pByte;
7042   Temp: Byte;
7043 begin
7044   if not (ftPNG in FormatGetSupportedFiles (Format)) then
7045     raise EglBitmapUnsupportedFormat.Create(Format);
7046
7047   case Format of
7048     tfAlpha8ub1, tfLuminance8ub1: begin
7049       ColorType := COLOR_GRAYSCALE;
7050       PixSize   := 1;
7051       Alpha     := false;
7052     end;
7053     tfLuminance8Alpha8us1: begin
7054       ColorType := COLOR_GRAYSCALEALPHA;
7055       PixSize   := 1;
7056       Alpha     := true;
7057     end;
7058     tfBGR8ub3, tfRGB8ub3: begin
7059       ColorType := COLOR_RGB;
7060       PixSize   := 3;
7061       Alpha     := false;
7062     end;
7063     tfBGRA8ub4, tfRGBA8ub4: begin
7064       ColorType := COLOR_RGBALPHA;
7065       PixSize   := 3;
7066       Alpha     := true
7067     end;
7068   else
7069     raise EglBitmapUnsupportedFormat.Create(Format);
7070   end;
7071
7072   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
7073   try
7074     // Copy ImageData
7075     pSource := Data;
7076     for Y := 0 to Height -1 do begin
7077       pDest := png.ScanLine[Y];
7078       for X := 0 to Width -1 do begin
7079         Move(pSource^, pDest^, PixSize);
7080         Inc(pDest, PixSize);
7081         Inc(pSource, PixSize);
7082         if Alpha then begin
7083           png.AlphaScanline[Y]^[X] := pSource^;
7084           Inc(pSource);
7085         end;
7086       end;
7087
7088       // convert RGB line to BGR
7089       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
7090         pTemp := png.ScanLine[Y];
7091         for X := 0 to Width -1 do begin
7092           Temp := pByteArray(pTemp)^[0];
7093           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
7094           pByteArray(pTemp)^[2] := Temp;
7095           Inc(pTemp, 3);
7096         end;
7097       end;
7098     end;
7099
7100     // Save to Stream
7101     Png.CompressionLevel := 6;
7102     Png.SaveToStream(aStream);
7103   finally
7104     FreeAndNil(Png);
7105   end;
7106 end;
7107 {$IFEND}
7108 {$ENDIF}
7109
7110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7111 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7113 {$IFDEF GLB_LIB_JPEG}
7114 type
7115   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
7116   glBitmap_libJPEG_source_mgr = record
7117     pub: jpeg_source_mgr;
7118
7119     SrcStream: TStream;
7120     SrcBuffer: array [1..4096] of byte;
7121   end;
7122
7123   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
7124   glBitmap_libJPEG_dest_mgr = record
7125     pub: jpeg_destination_mgr;
7126
7127     DestStream: TStream;
7128     DestBuffer: array [1..4096] of byte;
7129   end;
7130
7131 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
7132 begin
7133   //DUMMY
7134 end;
7135
7136
7137 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
7138 begin
7139   //DUMMY
7140 end;
7141
7142
7143 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
7144 begin
7145   //DUMMY
7146 end;
7147
7148 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
7149 begin
7150   //DUMMY
7151 end;
7152
7153
7154 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
7155 begin
7156   //DUMMY
7157 end;
7158
7159
7160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7161 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
7162 var
7163   src: glBitmap_libJPEG_source_mgr_ptr;
7164   bytes: integer;
7165 begin
7166   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
7167
7168   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
7169         if (bytes <= 0) then begin
7170                 src^.SrcBuffer[1] := $FF;
7171                 src^.SrcBuffer[2] := JPEG_EOI;
7172                 bytes := 2;
7173         end;
7174
7175         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
7176         src^.pub.bytes_in_buffer := bytes;
7177
7178   result := true;
7179 end;
7180
7181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7182 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
7183 var
7184   src: glBitmap_libJPEG_source_mgr_ptr;
7185 begin
7186   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
7187
7188   if num_bytes > 0 then begin
7189     // wanted byte isn't in buffer so set stream position and read buffer
7190     if num_bytes > src^.pub.bytes_in_buffer then begin
7191       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
7192       src^.pub.fill_input_buffer(cinfo);
7193     end else begin
7194       // wanted byte is in buffer so only skip
7195                 inc(src^.pub.next_input_byte, num_bytes);
7196                 dec(src^.pub.bytes_in_buffer, num_bytes);
7197     end;
7198   end;
7199 end;
7200
7201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7202 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
7203 var
7204   dest: glBitmap_libJPEG_dest_mgr_ptr;
7205 begin
7206   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
7207
7208   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
7209     // write complete buffer
7210     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
7211
7212     // reset buffer
7213     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
7214     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
7215   end;
7216
7217   result := true;
7218 end;
7219
7220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7221 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
7222 var
7223   Idx: Integer;
7224   dest: glBitmap_libJPEG_dest_mgr_ptr;
7225 begin
7226   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
7227
7228   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
7229     // check for endblock
7230     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
7231       // write endblock
7232       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
7233
7234       // leave
7235       break;
7236     end else
7237       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
7238   end;
7239 end;
7240 {$ENDIF}
7241
7242 {$IFDEF GLB_SUPPORT_JPEG_READ}
7243 {$IF DEFINED(GLB_LAZ_JPEG)}
7244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7245 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7246 const
7247   MAGIC_LEN = 2;
7248   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
7249 var
7250   intf: TLazIntfImage;
7251   reader: TFPReaderJPEG;
7252   StreamPos: Int64;
7253   magic: String[MAGIC_LEN];
7254 begin
7255   result := true;
7256   StreamPos := aStream.Position;
7257
7258   SetLength(magic, MAGIC_LEN);
7259   aStream.Read(magic[1], MAGIC_LEN);
7260   aStream.Position := StreamPos;
7261   if (magic <> JPEG_MAGIC) then begin
7262     result := false;
7263     exit;
7264   end;
7265
7266   reader := TFPReaderJPEG.Create;
7267   intf := TLazIntfImage.Create(0, 0);
7268   try try
7269     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
7270     reader.ImageRead(aStream, intf);
7271     AssignFromLazIntfImage(intf);
7272   except
7273     result := false;
7274     aStream.Position := StreamPos;
7275     exit;
7276   end;
7277   finally
7278     reader.Free;
7279     intf.Free;
7280   end;
7281 end;
7282
7283 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
7284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7285 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7286 var
7287   Surface: PSDL_Surface;
7288   RWops: PSDL_RWops;
7289 begin
7290   result := false;
7291
7292   RWops := glBitmapCreateRWops(aStream);
7293   try
7294     if IMG_isJPG(RWops) > 0 then begin
7295       Surface := IMG_LoadJPG_RW(RWops);
7296       try
7297         AssignFromSurface(Surface);
7298         result := true;
7299       finally
7300         SDL_FreeSurface(Surface);
7301       end;
7302     end;
7303   finally
7304     SDL_FreeRW(RWops);
7305   end;
7306 end;
7307
7308 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7310 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7311 var
7312   StreamPos: Int64;
7313   Temp: array[0..1]of Byte;
7314
7315   jpeg: jpeg_decompress_struct;
7316   jpeg_err: jpeg_error_mgr;
7317
7318   IntFormat: TglBitmapFormat;
7319   pImage: pByte;
7320   TempHeight, TempWidth: Integer;
7321
7322   pTemp: pByte;
7323   Row: Integer;
7324
7325   FormatDesc: TFormatDescriptor;
7326 begin
7327   result := false;
7328
7329   if not init_libJPEG then
7330     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
7331
7332   try
7333     // reading first two bytes to test file and set cursor back to begin
7334     StreamPos := aStream.Position;
7335     aStream.Read({%H-}Temp[0], 2);
7336     aStream.Position := StreamPos;
7337
7338     // if Bitmap then read file.
7339     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7340       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
7341       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7342
7343       // error managment
7344       jpeg.err := jpeg_std_error(@jpeg_err);
7345       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7346       jpeg_err.output_message := glBitmap_libJPEG_output_message;
7347
7348       // decompression struct
7349       jpeg_create_decompress(@jpeg);
7350
7351       // allocation space for streaming methods
7352       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
7353
7354       // seeting up custom functions
7355       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
7356         pub.init_source       := glBitmap_libJPEG_init_source;
7357         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
7358         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
7359         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
7360         pub.term_source       := glBitmap_libJPEG_term_source;
7361
7362         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
7363         pub.next_input_byte := nil;   // until buffer loaded
7364
7365         SrcStream := aStream;
7366       end;
7367
7368       // set global decoding state
7369       jpeg.global_state := DSTATE_START;
7370
7371       // read header of jpeg
7372       jpeg_read_header(@jpeg, false);
7373
7374       // setting output parameter
7375       case jpeg.jpeg_color_space of
7376         JCS_GRAYSCALE:
7377           begin
7378             jpeg.out_color_space := JCS_GRAYSCALE;
7379             IntFormat := tfLuminance8ub1;
7380           end;
7381         else
7382           jpeg.out_color_space := JCS_RGB;
7383           IntFormat := tfRGB8ub3;
7384       end;
7385
7386       // reading image
7387       jpeg_start_decompress(@jpeg);
7388
7389       TempHeight := jpeg.output_height;
7390       TempWidth := jpeg.output_width;
7391
7392       FormatDesc := TFormatDescriptor.Get(IntFormat);
7393
7394       // creating new image
7395       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
7396       try
7397         pTemp := pImage;
7398
7399         for Row := 0 to TempHeight -1 do begin
7400           jpeg_read_scanlines(@jpeg, @pTemp, 1);
7401           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
7402         end;
7403
7404         // finish decompression
7405         jpeg_finish_decompress(@jpeg);
7406
7407         // destroy decompression
7408         jpeg_destroy_decompress(@jpeg);
7409
7410         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
7411
7412         result := true;
7413       except
7414         if Assigned(pImage) then
7415           FreeMem(pImage);
7416         raise;
7417       end;
7418     end;
7419   finally
7420     quit_libJPEG;
7421   end;
7422 end;
7423
7424 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7426 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
7427 var
7428   bmp: TBitmap;
7429   jpg: TJPEGImage;
7430   StreamPos: Int64;
7431   Temp: array[0..1]of Byte;
7432 begin
7433   result := false;
7434
7435   // reading first two bytes to test file and set cursor back to begin
7436   StreamPos := aStream.Position;
7437   aStream.Read(Temp[0], 2);
7438   aStream.Position := StreamPos;
7439
7440   // if Bitmap then read file.
7441   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
7442     bmp := TBitmap.Create;
7443     try
7444       jpg := TJPEGImage.Create;
7445       try
7446         jpg.LoadFromStream(aStream);
7447         bmp.Assign(jpg);
7448         result := AssignFromBitmap(bmp);
7449       finally
7450         jpg.Free;
7451       end;
7452     finally
7453       bmp.Free;
7454     end;
7455   end;
7456 end;
7457 {$IFEND}
7458 {$ENDIF}
7459
7460 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
7461 {$IF DEFINED(GLB_LAZ_JPEG)}
7462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7463 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7464 var
7465   jpeg: TJPEGImage;
7466   intf: TLazIntfImage;
7467   raw: TRawImage;
7468 begin
7469   jpeg := TJPEGImage.Create;
7470   intf := TLazIntfImage.Create(0, 0);
7471   try
7472     if not AssignToLazIntfImage(intf) then
7473       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
7474     intf.GetRawImage(raw);
7475     jpeg.LoadFromRawImage(raw, false);
7476     jpeg.SaveToStream(aStream);
7477   finally
7478     intf.Free;
7479     jpeg.Free;
7480   end;
7481 end;
7482
7483 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
7484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7485 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7486 var
7487   jpeg: jpeg_compress_struct;
7488   jpeg_err: jpeg_error_mgr;
7489   Row: Integer;
7490   pTemp, pTemp2: pByte;
7491
7492   procedure CopyRow(pDest, pSource: pByte);
7493   var
7494     X: Integer;
7495   begin
7496     for X := 0 to Width - 1 do begin
7497       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
7498       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
7499       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
7500       Inc(pDest, 3);
7501       Inc(pSource, 3);
7502     end;
7503   end;
7504
7505 begin
7506   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7507     raise EglBitmapUnsupportedFormat.Create(Format);
7508
7509   if not init_libJPEG then
7510     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
7511
7512   try
7513     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
7514     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
7515
7516     // error managment
7517     jpeg.err := jpeg_std_error(@jpeg_err);
7518     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
7519     jpeg_err.output_message := glBitmap_libJPEG_output_message;
7520
7521     // compression struct
7522     jpeg_create_compress(@jpeg);
7523
7524     // allocation space for streaming methods
7525     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
7526
7527     // seeting up custom functions
7528     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
7529       pub.init_destination    := glBitmap_libJPEG_init_destination;
7530       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
7531       pub.term_destination    := glBitmap_libJPEG_term_destination;
7532
7533       pub.next_output_byte  := @DestBuffer[1];
7534       pub.free_in_buffer    := Length(DestBuffer);
7535
7536       DestStream := aStream;
7537     end;
7538
7539     // very important state
7540     jpeg.global_state := CSTATE_START;
7541     jpeg.image_width  := Width;
7542     jpeg.image_height := Height;
7543     case Format of
7544       tfAlpha8ub1, tfLuminance8ub1: begin
7545         jpeg.input_components := 1;
7546         jpeg.in_color_space   := JCS_GRAYSCALE;
7547       end;
7548       tfRGB8ub3, tfBGR8ub3: begin
7549         jpeg.input_components := 3;
7550         jpeg.in_color_space   := JCS_RGB;
7551       end;
7552     end;
7553
7554     jpeg_set_defaults(@jpeg);
7555     jpeg_set_quality(@jpeg, 95, true);
7556     jpeg_start_compress(@jpeg, true);
7557     pTemp := Data;
7558
7559     if Format = tfBGR8ub3 then
7560       GetMem(pTemp2, fRowSize)
7561     else
7562       pTemp2 := pTemp;
7563
7564     try
7565       for Row := 0 to jpeg.image_height -1 do begin
7566         // prepare row
7567         if Format = tfBGR8ub3 then
7568           CopyRow(pTemp2, pTemp)
7569         else
7570           pTemp2 := pTemp;
7571
7572         // write row
7573         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7574         inc(pTemp, fRowSize);
7575       end;
7576     finally
7577       // free memory
7578       if Format = tfBGR8ub3 then
7579         FreeMem(pTemp2);
7580     end;
7581     jpeg_finish_compress(@jpeg);
7582     jpeg_destroy_compress(@jpeg);
7583   finally
7584     quit_libJPEG;
7585   end;
7586 end;
7587
7588 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7590 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7591 var
7592   Bmp: TBitmap;
7593   Jpg: TJPEGImage;
7594 begin
7595   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7596     raise EglBitmapUnsupportedFormat.Create(Format);
7597
7598   Bmp := TBitmap.Create;
7599   try
7600     Jpg := TJPEGImage.Create;
7601     try
7602       AssignToBitmap(Bmp);
7603       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7604         Jpg.Grayscale   := true;
7605         Jpg.PixelFormat := jf8Bit;
7606       end;
7607       Jpg.Assign(Bmp);
7608       Jpg.SaveToStream(aStream);
7609     finally
7610       FreeAndNil(Jpg);
7611     end;
7612   finally
7613     FreeAndNil(Bmp);
7614   end;
7615 end;
7616 {$IFEND}
7617 {$ENDIF}
7618
7619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7620 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7622 type
7623   RawHeader = packed record
7624     Magic:        String[5];
7625     Version:      Byte;
7626     Width:        Integer;
7627     Height:       Integer;
7628     DataSize:     Integer;
7629     BitsPerPixel: Integer;
7630     Precision:    TglBitmapRec4ub;
7631     Shift:        TglBitmapRec4ub;
7632   end;
7633
7634 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7635 var
7636   header: RawHeader;
7637   StartPos: Int64;
7638   fd: TFormatDescriptor;
7639   buf: PByte;
7640 begin
7641   result := false;
7642   StartPos := aStream.Position;
7643   aStream.Read(header{%H-}, SizeOf(header));
7644   if (header.Magic <> 'glBMP') then begin
7645     aStream.Position := StartPos;
7646     exit;
7647   end;
7648
7649   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7650   if (fd.Format = tfEmpty) then
7651     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7652
7653   buf := GetMemory(header.DataSize);
7654   aStream.Read(buf^, header.DataSize);
7655   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7656
7657   result := true;
7658 end;
7659
7660 procedure TglBitmap.SaveRAW(const aStream: TStream);
7661 var
7662   header: RawHeader;
7663   fd: TFormatDescriptor;
7664 begin
7665   fd := TFormatDescriptor.Get(Format);
7666   header.Magic        := 'glBMP';
7667   header.Version      := 1;
7668   header.Width        := Width;
7669   header.Height       := Height;
7670   header.DataSize     := fd.GetSize(fDimension);
7671   header.BitsPerPixel := fd.BitsPerPixel;
7672   header.Precision    := fd.Precision;
7673   header.Shift        := fd.Shift;
7674   aStream.Write(header, SizeOf(header));
7675   aStream.Write(Data^,  header.DataSize);
7676 end;
7677
7678 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7679 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7681 const
7682   BMP_MAGIC          = $4D42;
7683
7684   BMP_COMP_RGB       = 0;
7685   BMP_COMP_RLE8      = 1;
7686   BMP_COMP_RLE4      = 2;
7687   BMP_COMP_BITFIELDS = 3;
7688
7689 type
7690   TBMPHeader = packed record
7691     bfType: Word;
7692     bfSize: Cardinal;
7693     bfReserved1: Word;
7694     bfReserved2: Word;
7695     bfOffBits: Cardinal;
7696   end;
7697
7698   TBMPInfo = packed record
7699     biSize: Cardinal;
7700     biWidth: Longint;
7701     biHeight: Longint;
7702     biPlanes: Word;
7703     biBitCount: Word;
7704     biCompression: Cardinal;
7705     biSizeImage: Cardinal;
7706     biXPelsPerMeter: Longint;
7707     biYPelsPerMeter: Longint;
7708     biClrUsed: Cardinal;
7709     biClrImportant: Cardinal;
7710   end;
7711
7712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7713 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7714
7715   //////////////////////////////////////////////////////////////////////////////////////////////////
7716   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7717   begin
7718     result := tfEmpty;
7719     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7720     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7721
7722     //Read Compression
7723     case aInfo.biCompression of
7724       BMP_COMP_RLE4,
7725       BMP_COMP_RLE8: begin
7726         raise EglBitmap.Create('RLE compression is not supported');
7727       end;
7728       BMP_COMP_BITFIELDS: begin
7729         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7730           aStream.Read(aMask.r, SizeOf(aMask.r));
7731           aStream.Read(aMask.g, SizeOf(aMask.g));
7732           aStream.Read(aMask.b, SizeOf(aMask.b));
7733           aStream.Read(aMask.a, SizeOf(aMask.a));
7734         end else
7735           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7736       end;
7737     end;
7738
7739     //get suitable format
7740     case aInfo.biBitCount of
7741        8: result := tfLuminance8ub1;
7742       16: result := tfX1RGB5us1;
7743       24: result := tfBGR8ub3;
7744       32: result := tfXRGB8ui1;
7745     end;
7746   end;
7747
7748   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7749   var
7750     i, c: Integer;
7751     ColorTable: TbmpColorTable;
7752   begin
7753     result := nil;
7754     if (aInfo.biBitCount >= 16) then
7755       exit;
7756     aFormat := tfLuminance8ub1;
7757     c := aInfo.biClrUsed;
7758     if (c = 0) then
7759       c := 1 shl aInfo.biBitCount;
7760     SetLength(ColorTable, c);
7761     for i := 0 to c-1 do begin
7762       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7763       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7764         aFormat := tfRGB8ub3;
7765     end;
7766
7767     result := TbmpColorTableFormat.Create;
7768     result.BitsPerPixel := aInfo.biBitCount;
7769     result.ColorTable   := ColorTable;
7770     result.CalcValues;
7771   end;
7772
7773   //////////////////////////////////////////////////////////////////////////////////////////////////
7774   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7775   var
7776     FormatDesc: TFormatDescriptor;
7777   begin
7778     result := nil;
7779     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7780       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7781       if (FormatDesc.Format = tfEmpty) then
7782         exit;
7783       aFormat := FormatDesc.Format;
7784       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7785         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7786       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7787         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7788
7789       result := TbmpBitfieldFormat.Create;
7790       result.SetCustomValues(aInfo.biBitCount, aMask);
7791     end;
7792   end;
7793
7794 var
7795   //simple types
7796   StartPos: Int64;
7797   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7798   PaddingBuff: Cardinal;
7799   LineBuf, ImageData, TmpData: PByte;
7800   SourceMD, DestMD: Pointer;
7801   BmpFormat: TglBitmapFormat;
7802
7803   //records
7804   Mask: TglBitmapRec4ul;
7805   Header: TBMPHeader;
7806   Info: TBMPInfo;
7807
7808   //classes
7809   SpecialFormat: TFormatDescriptor;
7810   FormatDesc: TFormatDescriptor;
7811
7812   //////////////////////////////////////////////////////////////////////////////////////////////////
7813   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7814   var
7815     i: Integer;
7816     Pixel: TglBitmapPixelData;
7817   begin
7818     aStream.Read(aLineBuf^, rbLineSize);
7819     SpecialFormat.PreparePixel(Pixel);
7820     for i := 0 to Info.biWidth-1 do begin
7821       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7822       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7823       FormatDesc.Map(Pixel, aData, DestMD);
7824     end;
7825   end;
7826
7827 begin
7828   result        := false;
7829   BmpFormat     := tfEmpty;
7830   SpecialFormat := nil;
7831   LineBuf       := nil;
7832   SourceMD      := nil;
7833   DestMD        := nil;
7834
7835   // Header
7836   StartPos := aStream.Position;
7837   aStream.Read(Header{%H-}, SizeOf(Header));
7838
7839   if Header.bfType = BMP_MAGIC then begin
7840     try try
7841       BmpFormat        := ReadInfo(Info, Mask);
7842       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7843       if not Assigned(SpecialFormat) then
7844         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7845       aStream.Position := StartPos + Header.bfOffBits;
7846
7847       if (BmpFormat <> tfEmpty) then begin
7848         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7849         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7850         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7851         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7852
7853         //get Memory
7854         DestMD    := FormatDesc.CreateMappingData;
7855         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7856         GetMem(ImageData, ImageSize);
7857         if Assigned(SpecialFormat) then begin
7858           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7859           SourceMD := SpecialFormat.CreateMappingData;
7860         end;
7861
7862         //read Data
7863         try try
7864           FillChar(ImageData^, ImageSize, $FF);
7865           TmpData := ImageData;
7866           if (Info.biHeight > 0) then
7867             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7868           for i := 0 to Abs(Info.biHeight)-1 do begin
7869             if Assigned(SpecialFormat) then
7870               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7871             else
7872               aStream.Read(TmpData^, wbLineSize);   //else only read data
7873             if (Info.biHeight > 0) then
7874               dec(TmpData, wbLineSize)
7875             else
7876               inc(TmpData, wbLineSize);
7877             aStream.Read(PaddingBuff{%H-}, Padding);
7878           end;
7879           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7880           result := true;
7881         finally
7882           if Assigned(LineBuf) then
7883             FreeMem(LineBuf);
7884           if Assigned(SourceMD) then
7885             SpecialFormat.FreeMappingData(SourceMD);
7886           FormatDesc.FreeMappingData(DestMD);
7887         end;
7888         except
7889           if Assigned(ImageData) then
7890             FreeMem(ImageData);
7891           raise;
7892         end;
7893       end else
7894         raise EglBitmap.Create('LoadBMP - No suitable format found');
7895     except
7896       aStream.Position := StartPos;
7897       raise;
7898     end;
7899     finally
7900       FreeAndNil(SpecialFormat);
7901     end;
7902   end
7903     else aStream.Position := StartPos;
7904 end;
7905
7906 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7907 procedure TglBitmap.SaveBMP(const aStream: TStream);
7908 var
7909   Header: TBMPHeader;
7910   Info: TBMPInfo;
7911   Converter: TFormatDescriptor;
7912   FormatDesc: TFormatDescriptor;
7913   SourceFD, DestFD: Pointer;
7914   pData, srcData, dstData, ConvertBuffer: pByte;
7915
7916   Pixel: TglBitmapPixelData;
7917   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7918   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7919
7920   PaddingBuff: Cardinal;
7921
7922   function GetLineWidth : Integer;
7923   begin
7924     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7925   end;
7926
7927 begin
7928   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7929     raise EglBitmapUnsupportedFormat.Create(Format);
7930
7931   Converter  := nil;
7932   FormatDesc := TFormatDescriptor.Get(Format);
7933   ImageSize  := FormatDesc.GetSize(Dimension);
7934
7935   FillChar(Header{%H-}, SizeOf(Header), 0);
7936   Header.bfType      := BMP_MAGIC;
7937   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7938   Header.bfReserved1 := 0;
7939   Header.bfReserved2 := 0;
7940   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7941
7942   FillChar(Info{%H-}, SizeOf(Info), 0);
7943   Info.biSize        := SizeOf(Info);
7944   Info.biWidth       := Width;
7945   Info.biHeight      := Height;
7946   Info.biPlanes      := 1;
7947   Info.biCompression := BMP_COMP_RGB;
7948   Info.biSizeImage   := ImageSize;
7949
7950   try
7951     case Format of
7952       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7953       begin
7954         Info.biBitCount  :=  8;
7955         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7956         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7957         Converter := TbmpColorTableFormat.Create;
7958         with (Converter as TbmpColorTableFormat) do begin
7959           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7960           CreateColorTable;
7961         end;
7962       end;
7963
7964       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7965       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7966       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7967       begin
7968         Info.biBitCount    := 16;
7969         Info.biCompression := BMP_COMP_BITFIELDS;
7970       end;
7971
7972       tfBGR8ub3, tfRGB8ub3:
7973       begin
7974         Info.biBitCount := 24;
7975         if (Format = tfRGB8ub3) then
7976           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7977       end;
7978
7979       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7980       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7981       begin
7982         Info.biBitCount    := 32;
7983         Info.biCompression := BMP_COMP_BITFIELDS;
7984       end;
7985     else
7986       raise EglBitmapUnsupportedFormat.Create(Format);
7987     end;
7988     Info.biXPelsPerMeter := 2835;
7989     Info.biYPelsPerMeter := 2835;
7990
7991     // prepare bitmasks
7992     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7993       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7994       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7995
7996       RedMask    := FormatDesc.Mask.r;
7997       GreenMask  := FormatDesc.Mask.g;
7998       BlueMask   := FormatDesc.Mask.b;
7999       AlphaMask  := FormatDesc.Mask.a;
8000     end;
8001
8002     // headers
8003     aStream.Write(Header, SizeOf(Header));
8004     aStream.Write(Info, SizeOf(Info));
8005
8006     // colortable
8007     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
8008       with (Converter as TbmpColorTableFormat) do
8009         aStream.Write(ColorTable[0].b,
8010           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
8011
8012     // bitmasks
8013     if Info.biCompression = BMP_COMP_BITFIELDS then begin
8014       aStream.Write(RedMask,   SizeOf(Cardinal));
8015       aStream.Write(GreenMask, SizeOf(Cardinal));
8016       aStream.Write(BlueMask,  SizeOf(Cardinal));
8017       aStream.Write(AlphaMask, SizeOf(Cardinal));
8018     end;
8019
8020     // image data
8021     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
8022     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
8023     Padding     := GetLineWidth - wbLineSize;
8024     PaddingBuff := 0;
8025
8026     pData := Data;
8027     inc(pData, (Height-1) * rbLineSize);
8028
8029     // prepare row buffer. But only for RGB because RGBA supports color masks
8030     // so it's possible to change color within the image.
8031     if Assigned(Converter) then begin
8032       FormatDesc.PreparePixel(Pixel);
8033       GetMem(ConvertBuffer, wbLineSize);
8034       SourceFD := FormatDesc.CreateMappingData;
8035       DestFD   := Converter.CreateMappingData;
8036     end else
8037       ConvertBuffer := nil;
8038
8039     try
8040       for LineIdx := 0 to Height - 1 do begin
8041         // preparing row
8042         if Assigned(Converter) then begin
8043           srcData := pData;
8044           dstData := ConvertBuffer;
8045           for PixelIdx := 0 to Info.biWidth-1 do begin
8046             FormatDesc.Unmap(srcData, Pixel, SourceFD);
8047             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
8048             Converter.Map(Pixel, dstData, DestFD);
8049           end;
8050           aStream.Write(ConvertBuffer^, wbLineSize);
8051         end else begin
8052           aStream.Write(pData^, rbLineSize);
8053         end;
8054         dec(pData, rbLineSize);
8055         if (Padding > 0) then
8056           aStream.Write(PaddingBuff, Padding);
8057       end;
8058     finally
8059       // destroy row buffer
8060       if Assigned(ConvertBuffer) then begin
8061         FormatDesc.FreeMappingData(SourceFD);
8062         Converter.FreeMappingData(DestFD);
8063         FreeMem(ConvertBuffer);
8064       end;
8065     end;
8066   finally
8067     if Assigned(Converter) then
8068       Converter.Free;
8069   end;
8070 end;
8071
8072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8075 type
8076   TTGAHeader = packed record
8077     ImageID: Byte;
8078     ColorMapType: Byte;
8079     ImageType: Byte;
8080     //ColorMapSpec: Array[0..4] of Byte;
8081     ColorMapStart: Word;
8082     ColorMapLength: Word;
8083     ColorMapEntrySize: Byte;
8084     OrigX: Word;
8085     OrigY: Word;
8086     Width: Word;
8087     Height: Word;
8088     Bpp: Byte;
8089     ImageDesc: Byte;
8090   end;
8091
8092 const
8093   TGA_UNCOMPRESSED_RGB  =  2;
8094   TGA_UNCOMPRESSED_GRAY =  3;
8095   TGA_COMPRESSED_RGB    = 10;
8096   TGA_COMPRESSED_GRAY   = 11;
8097
8098   TGA_NONE_COLOR_TABLE  = 0;
8099
8100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8101 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
8102 var
8103   Header: TTGAHeader;
8104   ImageData: System.PByte;
8105   StartPosition: Int64;
8106   PixelSize, LineSize: Integer;
8107   tgaFormat: TglBitmapFormat;
8108   FormatDesc: TFormatDescriptor;
8109   Counter: packed record
8110     X, Y: packed record
8111       low, high, dir: Integer;
8112     end;
8113   end;
8114
8115 const
8116   CACHE_SIZE = $4000;
8117
8118   ////////////////////////////////////////////////////////////////////////////////////////
8119   procedure ReadUncompressed;
8120   var
8121     i, j: Integer;
8122     buf, tmp1, tmp2: System.PByte;
8123   begin
8124     buf := nil;
8125     if (Counter.X.dir < 0) then
8126       GetMem(buf, LineSize);
8127     try
8128       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
8129         tmp1 := ImageData;
8130         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
8131         if (Counter.X.dir < 0) then begin               //flip X
8132           aStream.Read(buf^, LineSize);
8133           tmp2 := buf;
8134           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
8135           for i := 0 to Header.Width-1 do begin         //for all pixels in line
8136             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
8137               tmp1^ := tmp2^;
8138               inc(tmp1);
8139               inc(tmp2);
8140             end;
8141             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
8142           end;
8143         end else
8144           aStream.Read(tmp1^, LineSize);
8145         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
8146       end;
8147     finally
8148       if Assigned(buf) then
8149         FreeMem(buf);
8150     end;
8151   end;
8152
8153   ////////////////////////////////////////////////////////////////////////////////////////
8154   procedure ReadCompressed;
8155
8156     /////////////////////////////////////////////////////////////////
8157     var
8158       TmpData: System.PByte;
8159       LinePixelsRead: Integer;
8160     procedure CheckLine;
8161     begin
8162       if (LinePixelsRead >= Header.Width) then begin
8163         LinePixelsRead := 0;
8164         inc(Counter.Y.low, Counter.Y.dir);                //next line index
8165         TmpData := ImageData;
8166         inc(TmpData, Counter.Y.low * LineSize);           //set line
8167         if (Counter.X.dir < 0) then                       //if x flipped then
8168           inc(TmpData, LineSize - PixelSize);             //set last pixel
8169       end;
8170     end;
8171
8172     /////////////////////////////////////////////////////////////////
8173     var
8174       Cache: PByte;
8175       CacheSize, CachePos: Integer;
8176     procedure CachedRead(out Buffer; Count: Integer);
8177     var
8178       BytesRead: Integer;
8179     begin
8180       if (CachePos + Count > CacheSize) then begin
8181         //if buffer overflow save non read bytes
8182         BytesRead := 0;
8183         if (CacheSize - CachePos > 0) then begin
8184           BytesRead := CacheSize - CachePos;
8185           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
8186           inc(CachePos, BytesRead);
8187         end;
8188
8189         //load cache from file
8190         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
8191         aStream.Read(Cache^, CacheSize);
8192         CachePos := 0;
8193
8194         //read rest of requested bytes
8195         if (Count - BytesRead > 0) then begin
8196           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
8197           inc(CachePos, Count - BytesRead);
8198         end;
8199       end else begin
8200         //if no buffer overflow just read the data
8201         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
8202         inc(CachePos, Count);
8203       end;
8204     end;
8205
8206     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
8207     begin
8208       case PixelSize of
8209         1: begin
8210           aBuffer^ := aData^;
8211           inc(aBuffer, Counter.X.dir);
8212         end;
8213         2: begin
8214           PWord(aBuffer)^ := PWord(aData)^;
8215           inc(aBuffer, 2 * Counter.X.dir);
8216         end;
8217         3: begin
8218           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
8219           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
8220           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
8221           inc(aBuffer, 3 * Counter.X.dir);
8222         end;
8223         4: begin
8224           PCardinal(aBuffer)^ := PCardinal(aData)^;
8225           inc(aBuffer, 4 * Counter.X.dir);
8226         end;
8227       end;
8228     end;
8229
8230   var
8231     TotalPixelsToRead, TotalPixelsRead: Integer;
8232     Temp: Byte;
8233     buf: array [0..3] of Byte; //1 pixel is max 32bit long
8234     PixelRepeat: Boolean;
8235     PixelsToRead, PixelCount: Integer;
8236   begin
8237     CacheSize := 0;
8238     CachePos  := 0;
8239
8240     TotalPixelsToRead := Header.Width * Header.Height;
8241     TotalPixelsRead   := 0;
8242     LinePixelsRead    := 0;
8243
8244     GetMem(Cache, CACHE_SIZE);
8245     try
8246       TmpData := ImageData;
8247       inc(TmpData, Counter.Y.low * LineSize);           //set line
8248       if (Counter.X.dir < 0) then                       //if x flipped then
8249         inc(TmpData, LineSize - PixelSize);             //set last pixel
8250
8251       repeat
8252         //read CommandByte
8253         CachedRead(Temp, 1);
8254         PixelRepeat  := (Temp and $80) > 0;
8255         PixelsToRead := (Temp and $7F) + 1;
8256         inc(TotalPixelsRead, PixelsToRead);
8257
8258         if PixelRepeat then
8259           CachedRead(buf[0], PixelSize);
8260         while (PixelsToRead > 0) do begin
8261           CheckLine;
8262           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
8263           while (PixelCount > 0) do begin
8264             if not PixelRepeat then
8265               CachedRead(buf[0], PixelSize);
8266             PixelToBuffer(@buf[0], TmpData);
8267             inc(LinePixelsRead);
8268             dec(PixelsToRead);
8269             dec(PixelCount);
8270           end;
8271         end;
8272       until (TotalPixelsRead >= TotalPixelsToRead);
8273     finally
8274       FreeMem(Cache);
8275     end;
8276   end;
8277
8278   function IsGrayFormat: Boolean;
8279   begin
8280     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
8281   end;
8282
8283 begin
8284   result := false;
8285
8286   // reading header to test file and set cursor back to begin
8287   StartPosition := aStream.Position;
8288   aStream.Read(Header{%H-}, SizeOf(Header));
8289
8290   // no colormapped files
8291   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
8292     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
8293   begin
8294     try
8295       if Header.ImageID <> 0 then       // skip image ID
8296         aStream.Position := aStream.Position + Header.ImageID;
8297
8298       tgaFormat := tfEmpty;
8299       case Header.Bpp of
8300          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
8301                0: tgaFormat := tfLuminance8ub1;
8302                8: tgaFormat := tfAlpha8ub1;
8303             end;
8304
8305         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
8306                0: tgaFormat := tfLuminance16us1;
8307                8: tgaFormat := tfLuminance8Alpha8ub2;
8308             end else case (Header.ImageDesc and $F) of
8309                0: tgaFormat := tfX1RGB5us1;
8310                1: tgaFormat := tfA1RGB5us1;
8311                4: tgaFormat := tfARGB4us1;
8312             end;
8313
8314         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
8315                0: tgaFormat := tfBGR8ub3;
8316             end;
8317
8318         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
8319                0: tgaFormat := tfDepth32ui1;
8320             end else case (Header.ImageDesc and $F) of
8321                0: tgaFormat := tfX2RGB10ui1;
8322                2: tgaFormat := tfA2RGB10ui1;
8323                8: tgaFormat := tfARGB8ui1;
8324             end;
8325       end;
8326
8327       if (tgaFormat = tfEmpty) then
8328         raise EglBitmap.Create('LoadTga - unsupported format');
8329
8330       FormatDesc := TFormatDescriptor.Get(tgaFormat);
8331       PixelSize  := FormatDesc.GetSize(1, 1);
8332       LineSize   := FormatDesc.GetSize(Header.Width, 1);
8333
8334       GetMem(ImageData, LineSize * Header.Height);
8335       try
8336         //column direction
8337         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
8338           Counter.X.low  := Header.Height-1;;
8339           Counter.X.high := 0;
8340           Counter.X.dir  := -1;
8341         end else begin
8342           Counter.X.low  := 0;
8343           Counter.X.high := Header.Height-1;
8344           Counter.X.dir  := 1;
8345         end;
8346
8347         // Row direction
8348         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
8349           Counter.Y.low  := 0;
8350           Counter.Y.high := Header.Height-1;
8351           Counter.Y.dir  := 1;
8352         end else begin
8353           Counter.Y.low  := Header.Height-1;;
8354           Counter.Y.high := 0;
8355           Counter.Y.dir  := -1;
8356         end;
8357
8358         // Read Image
8359         case Header.ImageType of
8360           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
8361             ReadUncompressed;
8362           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
8363             ReadCompressed;
8364         end;
8365
8366         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
8367         result := true;
8368       except
8369         if Assigned(ImageData) then
8370           FreeMem(ImageData);
8371         raise;
8372       end;
8373     finally
8374       aStream.Position := StartPosition;
8375     end;
8376   end
8377     else aStream.Position := StartPosition;
8378 end;
8379
8380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8381 procedure TglBitmap.SaveTGA(const aStream: TStream);
8382 var
8383   Header: TTGAHeader;
8384   Size: Integer;
8385   FormatDesc: TFormatDescriptor;
8386 begin
8387   if not (ftTGA in FormatGetSupportedFiles(Format)) then
8388     raise EglBitmapUnsupportedFormat.Create(Format);
8389
8390   //prepare header
8391   FormatDesc := TFormatDescriptor.Get(Format);
8392   FillChar(Header{%H-}, SizeOf(Header), 0);
8393   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
8394   Header.Bpp       := FormatDesc.BitsPerPixel;
8395   Header.Width     := Width;
8396   Header.Height    := Height;
8397   Header.ImageDesc := Header.ImageDesc or $20; //flip y
8398   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
8399     Header.ImageType := TGA_UNCOMPRESSED_GRAY
8400   else
8401     Header.ImageType := TGA_UNCOMPRESSED_RGB;
8402   aStream.Write(Header, SizeOf(Header));
8403
8404   // write Data
8405   Size := FormatDesc.GetSize(Dimension);
8406   aStream.Write(Data^, Size);
8407 end;
8408
8409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8410 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8412 const
8413   DDS_MAGIC: Cardinal         = $20534444;
8414
8415   // DDS_header.dwFlags
8416   DDSD_CAPS                   = $00000001;
8417   DDSD_HEIGHT                 = $00000002;
8418   DDSD_WIDTH                  = $00000004;
8419   DDSD_PIXELFORMAT            = $00001000;
8420
8421   // DDS_header.sPixelFormat.dwFlags
8422   DDPF_ALPHAPIXELS            = $00000001;
8423   DDPF_ALPHA                  = $00000002;
8424   DDPF_FOURCC                 = $00000004;
8425   DDPF_RGB                    = $00000040;
8426   DDPF_LUMINANCE              = $00020000;
8427
8428   // DDS_header.sCaps.dwCaps1
8429   DDSCAPS_TEXTURE             = $00001000;
8430
8431   // DDS_header.sCaps.dwCaps2
8432   DDSCAPS2_CUBEMAP            = $00000200;
8433
8434   D3DFMT_DXT1                 = $31545844;
8435   D3DFMT_DXT3                 = $33545844;
8436   D3DFMT_DXT5                 = $35545844;
8437
8438 type
8439   TDDSPixelFormat = packed record
8440     dwSize: Cardinal;
8441     dwFlags: Cardinal;
8442     dwFourCC: Cardinal;
8443     dwRGBBitCount: Cardinal;
8444     dwRBitMask: Cardinal;
8445     dwGBitMask: Cardinal;
8446     dwBBitMask: Cardinal;
8447     dwABitMask: Cardinal;
8448   end;
8449
8450   TDDSCaps = packed record
8451     dwCaps1: Cardinal;
8452     dwCaps2: Cardinal;
8453     dwDDSX: Cardinal;
8454     dwReserved: Cardinal;
8455   end;
8456
8457   TDDSHeader = packed record
8458     dwSize: Cardinal;
8459     dwFlags: Cardinal;
8460     dwHeight: Cardinal;
8461     dwWidth: Cardinal;
8462     dwPitchOrLinearSize: Cardinal;
8463     dwDepth: Cardinal;
8464     dwMipMapCount: Cardinal;
8465     dwReserved: array[0..10] of Cardinal;
8466     PixelFormat: TDDSPixelFormat;
8467     Caps: TDDSCaps;
8468     dwReserved2: Cardinal;
8469   end;
8470
8471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8472 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
8473 var
8474   Header: TDDSHeader;
8475   Converter: TbmpBitfieldFormat;
8476
8477   function GetDDSFormat: TglBitmapFormat;
8478   var
8479     fd: TFormatDescriptor;
8480     i: Integer;
8481     Mask: TglBitmapRec4ul;
8482     Range: TglBitmapRec4ui;
8483     match: Boolean;
8484   begin
8485     result := tfEmpty;
8486     with Header.PixelFormat do begin
8487       // Compresses
8488       if ((dwFlags and DDPF_FOURCC) > 0) then begin
8489         case Header.PixelFormat.dwFourCC of
8490           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
8491           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
8492           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
8493         end;
8494       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
8495         // prepare masks
8496         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
8497           Mask.r := dwRBitMask;
8498           Mask.g := dwGBitMask;
8499           Mask.b := dwBBitMask;
8500         end else begin
8501           Mask.r := dwRBitMask;
8502           Mask.g := dwRBitMask;
8503           Mask.b := dwRBitMask;
8504         end;
8505         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
8506           Mask.a := dwABitMask
8507         else
8508           Mask.a := 0;;
8509
8510         //find matching format
8511         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
8512         result := fd.Format;
8513         if (result <> tfEmpty) then
8514           exit;
8515
8516         //find format with same Range
8517         for i := 0 to 3 do
8518           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
8519         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
8520           fd := TFormatDescriptor.Get(result);
8521           match := true;
8522           for i := 0 to 3 do
8523             if (fd.Range.arr[i] <> Range.arr[i]) then begin
8524               match := false;
8525               break;
8526             end;
8527           if match then
8528             break;
8529         end;
8530
8531         //no format with same range found -> use default
8532         if (result = tfEmpty) then begin
8533           if (dwABitMask > 0) then
8534             result := tfRGBA8ui1
8535           else
8536             result := tfRGB8ub3;
8537         end;
8538
8539         Converter := TbmpBitfieldFormat.Create;
8540         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
8541       end;
8542     end;
8543   end;
8544
8545 var
8546   StreamPos: Int64;
8547   x, y, LineSize, RowSize, Magic: Cardinal;
8548   NewImage, TmpData, RowData, SrcData: System.PByte;
8549   SourceMD, DestMD: Pointer;
8550   Pixel: TglBitmapPixelData;
8551   ddsFormat: TglBitmapFormat;
8552   FormatDesc: TFormatDescriptor;
8553
8554 begin
8555   result    := false;
8556   Converter := nil;
8557   StreamPos := aStream.Position;
8558
8559   // Magic
8560   aStream.Read(Magic{%H-}, sizeof(Magic));
8561   if (Magic <> DDS_MAGIC) then begin
8562     aStream.Position := StreamPos;
8563     exit;
8564   end;
8565
8566   //Header
8567   aStream.Read(Header{%H-}, sizeof(Header));
8568   if (Header.dwSize <> SizeOf(Header)) or
8569      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8570         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8571   begin
8572     aStream.Position := StreamPos;
8573     exit;
8574   end;
8575
8576   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8577     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8578
8579   ddsFormat := GetDDSFormat;
8580   try
8581     if (ddsFormat = tfEmpty) then
8582       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8583
8584     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8585     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8586     GetMem(NewImage, Header.dwHeight * LineSize);
8587     try
8588       TmpData := NewImage;
8589
8590       //Converter needed
8591       if Assigned(Converter) then begin
8592         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8593         GetMem(RowData, RowSize);
8594         SourceMD := Converter.CreateMappingData;
8595         DestMD   := FormatDesc.CreateMappingData;
8596         try
8597           for y := 0 to Header.dwHeight-1 do begin
8598             TmpData := NewImage;
8599             inc(TmpData, y * LineSize);
8600             SrcData := RowData;
8601             aStream.Read(SrcData^, RowSize);
8602             for x := 0 to Header.dwWidth-1 do begin
8603               Converter.Unmap(SrcData, Pixel, SourceMD);
8604               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8605               FormatDesc.Map(Pixel, TmpData, DestMD);
8606             end;
8607           end;
8608         finally
8609           Converter.FreeMappingData(SourceMD);
8610           FormatDesc.FreeMappingData(DestMD);
8611           FreeMem(RowData);
8612         end;
8613       end else
8614
8615       // Compressed
8616       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8617         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8618         for Y := 0 to Header.dwHeight-1 do begin
8619           aStream.Read(TmpData^, RowSize);
8620           Inc(TmpData, LineSize);
8621         end;
8622       end else
8623
8624       // Uncompressed
8625       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8626         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8627         for Y := 0 to Header.dwHeight-1 do begin
8628           aStream.Read(TmpData^, RowSize);
8629           Inc(TmpData, LineSize);
8630         end;
8631       end else
8632         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8633
8634       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8635       result := true;
8636     except
8637       if Assigned(NewImage) then
8638         FreeMem(NewImage);
8639       raise;
8640     end;
8641   finally
8642     FreeAndNil(Converter);
8643   end;
8644 end;
8645
8646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8647 procedure TglBitmap.SaveDDS(const aStream: TStream);
8648 var
8649   Header: TDDSHeader;
8650   FormatDesc: TFormatDescriptor;
8651 begin
8652   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8653     raise EglBitmapUnsupportedFormat.Create(Format);
8654
8655   FormatDesc := TFormatDescriptor.Get(Format);
8656
8657   // Generell
8658   FillChar(Header{%H-}, SizeOf(Header), 0);
8659   Header.dwSize  := SizeOf(Header);
8660   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8661
8662   Header.dwWidth  := Max(1, Width);
8663   Header.dwHeight := Max(1, Height);
8664
8665   // Caps
8666   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8667
8668   // Pixelformat
8669   Header.PixelFormat.dwSize := sizeof(Header);
8670   if (FormatDesc.IsCompressed) then begin
8671     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8672     case Format of
8673       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8674       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8675       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8676     end;
8677   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8678     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8679     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8680     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8681   end else if FormatDesc.IsGrayscale then begin
8682     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8683     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8684     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8685     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8686   end else begin
8687     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8688     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8689     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8690     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8691     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8692     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8693   end;
8694
8695   if (FormatDesc.HasAlpha) then
8696     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8697
8698   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8699   aStream.Write(Header, SizeOf(Header));
8700   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8701 end;
8702
8703 {$IFNDEF OPENGL_ES}
8704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8705 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8707 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8708   const aWidth: Integer; const aHeight: Integer);
8709 var
8710   pTemp: pByte;
8711   Size: Integer;
8712 begin
8713   if (aHeight > 1) then begin
8714     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8715     GetMem(pTemp, Size);
8716     try
8717       Move(aData^, pTemp^, Size);
8718       FreeMem(aData);
8719       aData := nil;
8720     except
8721       FreeMem(pTemp);
8722       raise;
8723     end;
8724   end else
8725     pTemp := aData;
8726   inherited SetDataPointer(pTemp, aFormat, aWidth);
8727 end;
8728
8729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8730 function TglBitmap1D.FlipHorz: Boolean;
8731 var
8732   Col: Integer;
8733   pTempDest, pDest, pSource: PByte;
8734 begin
8735   result := inherited FlipHorz;
8736   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8737     pSource := Data;
8738     GetMem(pDest, fRowSize);
8739     try
8740       pTempDest := pDest;
8741       Inc(pTempDest, fRowSize);
8742       for Col := 0 to Width-1 do begin
8743         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8744         Move(pSource^, pTempDest^, fPixelSize);
8745         Inc(pSource, fPixelSize);
8746       end;
8747       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8748       result := true;
8749     except
8750       if Assigned(pDest) then
8751         FreeMem(pDest);
8752       raise;
8753     end;
8754   end;
8755 end;
8756
8757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8758 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8759 var
8760   FormatDesc: TFormatDescriptor;
8761 begin
8762   // Upload data
8763   FormatDesc := TFormatDescriptor.Get(Format);
8764   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8765     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8766
8767   if FormatDesc.IsCompressed then begin
8768     if not Assigned(glCompressedTexImage1D) then
8769       raise EglBitmap.Create('compressed formats not supported by video adapter');
8770     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8771   end else if aBuildWithGlu then
8772     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8773   else
8774     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8775
8776   // Free Data
8777   if (FreeDataAfterGenTexture) then
8778     FreeData;
8779 end;
8780
8781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8782 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8783 var
8784   BuildWithGlu, TexRec: Boolean;
8785   TexSize: Integer;
8786 begin
8787   if Assigned(Data) then begin
8788     // Check Texture Size
8789     if (aTestTextureSize) then begin
8790       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8791
8792       if (Width > TexSize) then
8793         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8794
8795       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8796                 (Target = GL_TEXTURE_RECTANGLE);
8797       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8798         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8799     end;
8800
8801     CreateId;
8802     SetupParameters(BuildWithGlu);
8803     UploadData(BuildWithGlu);
8804     glAreTexturesResident(1, @fID, @fIsResident);
8805   end;
8806 end;
8807
8808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8809 procedure TglBitmap1D.AfterConstruction;
8810 begin
8811   inherited;
8812   Target := GL_TEXTURE_1D;
8813 end;
8814 {$ENDIF}
8815
8816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8817 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8819 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8820 begin
8821   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8822     result := fLines[aIndex]
8823   else
8824     result := nil;
8825 end;
8826
8827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8828 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8829   const aWidth: Integer; const aHeight: Integer);
8830 var
8831   Idx, LineWidth: Integer;
8832 begin
8833   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8834
8835   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8836     // Assigning Data
8837     if Assigned(Data) then begin
8838       SetLength(fLines, GetHeight);
8839       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8840
8841       for Idx := 0 to GetHeight-1 do begin
8842         fLines[Idx] := Data;
8843         Inc(fLines[Idx], Idx * LineWidth);
8844       end;
8845     end
8846       else SetLength(fLines, 0);
8847   end else begin
8848     SetLength(fLines, 0);
8849   end;
8850 end;
8851
8852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8853 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8854 var
8855   FormatDesc: TFormatDescriptor;
8856 begin
8857   FormatDesc := TFormatDescriptor.Get(Format);
8858   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8859     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8860
8861   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8862
8863   if FormatDesc.IsCompressed then begin
8864     if not Assigned(glCompressedTexImage2D) then
8865       raise EglBitmap.Create('compressed formats not supported by video adapter');
8866     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8867 {$IFNDEF OPENGL_ES}
8868   end else if aBuildWithGlu then begin
8869     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8870       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8871 {$ENDIF}
8872   end else begin
8873     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8874       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8875   end;
8876
8877   // Freigeben
8878   if (FreeDataAfterGenTexture) then
8879     FreeData;
8880 end;
8881
8882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8883 procedure TglBitmap2D.AfterConstruction;
8884 begin
8885   inherited;
8886   Target := GL_TEXTURE_2D;
8887 end;
8888
8889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8890 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8891 var
8892   Temp: pByte;
8893   Size, w, h: Integer;
8894   FormatDesc: TFormatDescriptor;
8895 begin
8896   FormatDesc := TFormatDescriptor.Get(aFormat);
8897   if FormatDesc.IsCompressed then
8898     raise EglBitmapUnsupportedFormat.Create(aFormat);
8899
8900   w    := aRight  - aLeft;
8901   h    := aBottom - aTop;
8902   Size := FormatDesc.GetSize(w, h);
8903   GetMem(Temp, Size);
8904   try
8905     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8906     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8907     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8908     FlipVert;
8909   except
8910     if Assigned(Temp) then
8911       FreeMem(Temp);
8912     raise;
8913   end;
8914 end;
8915
8916 {$IFNDEF OPENGL_ES}
8917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8918 procedure TglBitmap2D.GetDataFromTexture;
8919 var
8920   Temp: PByte;
8921   TempWidth, TempHeight: Integer;
8922   TempIntFormat: GLint;
8923   IntFormat: TglBitmapFormat;
8924   FormatDesc: TFormatDescriptor;
8925 begin
8926   Bind;
8927
8928   // Request Data
8929   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8930   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8931   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8932
8933   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8934   IntFormat  := FormatDesc.Format;
8935
8936   // Getting data from OpenGL
8937   FormatDesc := TFormatDescriptor.Get(IntFormat);
8938   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8939   try
8940     if FormatDesc.IsCompressed then begin
8941       if not Assigned(glGetCompressedTexImage) then
8942         raise EglBitmap.Create('compressed formats not supported by video adapter');
8943       glGetCompressedTexImage(Target, 0, Temp)
8944     end else
8945       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8946     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8947   except
8948     if Assigned(Temp) then
8949       FreeMem(Temp);
8950     raise;
8951   end;
8952 end;
8953 {$ENDIF}
8954
8955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8956 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8957 var
8958   {$IFNDEF OPENGL_ES}
8959   BuildWithGlu, TexRec: Boolean;
8960   {$ENDIF}
8961   PotTex: Boolean;
8962   TexSize: Integer;
8963 begin
8964   if Assigned(Data) then begin
8965     // Check Texture Size
8966     if (aTestTextureSize) then begin
8967       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8968
8969       if ((Height > TexSize) or (Width > TexSize)) then
8970         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8971
8972       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8973 {$IF NOT DEFINED(OPENGL_ES)}
8974       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8975       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8976         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8977 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8978       if not PotTex and not GL_OES_texture_npot then
8979         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8980 {$ELSE}
8981       if not PotTex then
8982         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8983 {$IFEND}
8984     end;
8985
8986     CreateId;
8987     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8988     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8989 {$IFNDEF OPENGL_ES}
8990     glAreTexturesResident(1, @fID, @fIsResident);
8991 {$ENDIF}
8992   end;
8993 end;
8994
8995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8996 function TglBitmap2D.FlipHorz: Boolean;
8997 var
8998   Col, Row: Integer;
8999   TempDestData, DestData, SourceData: PByte;
9000   ImgSize: Integer;
9001 begin
9002   result := inherited FlipHorz;
9003   if Assigned(Data) then begin
9004     SourceData := Data;
9005     ImgSize := Height * fRowSize;
9006     GetMem(DestData, ImgSize);
9007     try
9008       TempDestData := DestData;
9009       Dec(TempDestData, fRowSize + fPixelSize);
9010       for Row := 0 to Height -1 do begin
9011         Inc(TempDestData, fRowSize * 2);
9012         for Col := 0 to Width -1 do begin
9013           Move(SourceData^, TempDestData^, fPixelSize);
9014           Inc(SourceData, fPixelSize);
9015           Dec(TempDestData, fPixelSize);
9016         end;
9017       end;
9018       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
9019       result := true;
9020     except
9021       if Assigned(DestData) then
9022         FreeMem(DestData);
9023       raise;
9024     end;
9025   end;
9026 end;
9027
9028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9029 function TglBitmap2D.FlipVert: Boolean;
9030 var
9031   Row: Integer;
9032   TempDestData, DestData, SourceData: PByte;
9033 begin
9034   result := inherited FlipVert;
9035   if Assigned(Data) then begin
9036     SourceData := Data;
9037     GetMem(DestData, Height * fRowSize);
9038     try
9039       TempDestData := DestData;
9040       Inc(TempDestData, Width * (Height -1) * fPixelSize);
9041       for Row := 0 to Height -1 do begin
9042         Move(SourceData^, TempDestData^, fRowSize);
9043         Dec(TempDestData, fRowSize);
9044         Inc(SourceData, fRowSize);
9045       end;
9046       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
9047       result := true;
9048     except
9049       if Assigned(DestData) then
9050         FreeMem(DestData);
9051       raise;
9052     end;
9053   end;
9054 end;
9055
9056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9057 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9059 type
9060   TMatrixItem = record
9061     X, Y: Integer;
9062     W: Single;
9063   end;
9064
9065   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
9066   TglBitmapToNormalMapRec = Record
9067     Scale: Single;
9068     Heights: array of Single;
9069     MatrixU : array of TMatrixItem;
9070     MatrixV : array of TMatrixItem;
9071   end;
9072
9073 const
9074   ONE_OVER_255 = 1 / 255;
9075
9076   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9077 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
9078 var
9079   Val: Single;
9080 begin
9081   with FuncRec do begin
9082     Val :=
9083       Source.Data.r * LUMINANCE_WEIGHT_R +
9084       Source.Data.g * LUMINANCE_WEIGHT_G +
9085       Source.Data.b * LUMINANCE_WEIGHT_B;
9086     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
9087   end;
9088 end;
9089
9090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9091 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
9092 begin
9093   with FuncRec do
9094     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
9095 end;
9096
9097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9098 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
9099 type
9100   TVec = Array[0..2] of Single;
9101 var
9102   Idx: Integer;
9103   du, dv: Double;
9104   Len: Single;
9105   Vec: TVec;
9106
9107   function GetHeight(X, Y: Integer): Single;
9108   begin
9109     with FuncRec do begin
9110       X := Max(0, Min(Size.X -1, X));
9111       Y := Max(0, Min(Size.Y -1, Y));
9112       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
9113     end;
9114   end;
9115
9116 begin
9117   with FuncRec do begin
9118     with PglBitmapToNormalMapRec(Args)^ do begin
9119       du := 0;
9120       for Idx := Low(MatrixU) to High(MatrixU) do
9121         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
9122
9123       dv := 0;
9124       for Idx := Low(MatrixU) to High(MatrixU) do
9125         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
9126
9127       Vec[0] := -du * Scale;
9128       Vec[1] := -dv * Scale;
9129       Vec[2] := 1;
9130     end;
9131
9132     // Normalize
9133     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9134     if Len <> 0 then begin
9135       Vec[0] := Vec[0] * Len;
9136       Vec[1] := Vec[1] * Len;
9137       Vec[2] := Vec[2] * Len;
9138     end;
9139
9140     // Farbe zuweisem
9141     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
9142     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
9143     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
9144   end;
9145 end;
9146
9147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9148 procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
9149 var
9150   Rec: TglBitmapToNormalMapRec;
9151
9152   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
9153   begin
9154     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
9155       Matrix[Index].X := X;
9156       Matrix[Index].Y := Y;
9157       Matrix[Index].W := W;
9158     end;
9159   end;
9160
9161 begin
9162   if TFormatDescriptor.Get(Format).IsCompressed then
9163     raise EglBitmapUnsupportedFormat.Create(Format);
9164
9165   if aScale > 100 then
9166     Rec.Scale := 100
9167   else if aScale < -100 then
9168     Rec.Scale := -100
9169   else
9170     Rec.Scale := aScale;
9171
9172   SetLength(Rec.Heights, Width * Height);
9173   try
9174     case aFunc of
9175       nm4Samples: begin
9176         SetLength(Rec.MatrixU, 2);
9177         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
9178         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
9179
9180         SetLength(Rec.MatrixV, 2);
9181         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
9182         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
9183       end;
9184
9185       nmSobel: begin
9186         SetLength(Rec.MatrixU, 6);
9187         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
9188         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
9189         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
9190         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
9191         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
9192         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
9193
9194         SetLength(Rec.MatrixV, 6);
9195         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
9196         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
9197         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
9198         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
9199         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
9200         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
9201       end;
9202
9203       nm3x3: begin
9204         SetLength(Rec.MatrixU, 6);
9205         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
9206         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
9207         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
9208         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
9209         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
9210         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
9211
9212         SetLength(Rec.MatrixV, 6);
9213         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
9214         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
9215         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
9216         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
9217         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
9218         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
9219       end;
9220
9221       nm5x5: begin
9222         SetLength(Rec.MatrixU, 20);
9223         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
9224         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
9225         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
9226         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
9227         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
9228         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
9229         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
9230         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
9231         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
9232         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
9233         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
9234         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
9235         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
9236         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
9237         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
9238         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
9239         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
9240         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
9241         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
9242         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
9243
9244         SetLength(Rec.MatrixV, 20);
9245         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
9246         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
9247         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
9248         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
9249         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
9250         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
9251         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
9252         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
9253         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
9254         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
9255         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
9256         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
9257         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
9258         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
9259         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
9260         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
9261         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
9262         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
9263         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
9264         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
9265       end;
9266     end;
9267
9268     // Daten Sammeln
9269     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
9270       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
9271     else
9272       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
9273     Convert(glBitmapToNormalMapFunc, false, @Rec);
9274   finally
9275     SetLength(Rec.Heights, 0);
9276   end;
9277 end;
9278
9279 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9281 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9283 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
9284 begin
9285   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
9286 end;
9287
9288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9289 procedure TglBitmapCubeMap.AfterConstruction;
9290 begin
9291   inherited;
9292
9293 {$IFNDEF OPENGL_ES}
9294   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
9295     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9296 {$ELSE}
9297   if not (GL_VERSION_2_0) then
9298     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
9299 {$ENDIF}
9300
9301   SetWrap;
9302   Target   := GL_TEXTURE_CUBE_MAP;
9303 {$IFNDEF OPENGL_ES}
9304   fGenMode := GL_REFLECTION_MAP;
9305 {$ENDIF}
9306 end;
9307
9308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9309 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
9310 var
9311   {$IFNDEF OPENGL_ES}
9312   BuildWithGlu: Boolean;
9313   {$ENDIF}
9314   TexSize: Integer;
9315 begin
9316   if (aTestTextureSize) then begin
9317     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
9318
9319     if (Height > TexSize) or (Width > TexSize) then
9320       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
9321
9322 {$IF NOT DEFINED(OPENGL_ES)}
9323     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
9324       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9325 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
9326     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
9327       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9328 {$ELSE}
9329     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
9330       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
9331 {$IFEND}
9332   end;
9333
9334   if (ID = 0) then
9335     CreateID;
9336   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
9337   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
9338 end;
9339
9340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9341 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
9342 begin
9343   inherited Bind (aEnableTextureUnit);
9344 {$IFNDEF OPENGL_ES}
9345   if aEnableTexCoordsGen then begin
9346     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
9347     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
9348     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
9349     glEnable(GL_TEXTURE_GEN_S);
9350     glEnable(GL_TEXTURE_GEN_T);
9351     glEnable(GL_TEXTURE_GEN_R);
9352   end;
9353 {$ENDIF}
9354 end;
9355
9356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9357 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
9358 begin
9359   inherited Unbind(aDisableTextureUnit);
9360 {$IFNDEF OPENGL_ES}
9361   if aDisableTexCoordsGen then begin
9362     glDisable(GL_TEXTURE_GEN_S);
9363     glDisable(GL_TEXTURE_GEN_T);
9364     glDisable(GL_TEXTURE_GEN_R);
9365   end;
9366 {$ENDIF}
9367 end;
9368 {$IFEND}
9369
9370 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
9371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9372 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9374 type
9375   TVec = Array[0..2] of Single;
9376   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9377
9378   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
9379   TglBitmapNormalMapRec = record
9380     HalfSize : Integer;
9381     Func: TglBitmapNormalMapGetVectorFunc;
9382   end;
9383
9384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9385 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9386 begin
9387   aVec[0] := aHalfSize;
9388   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9389   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
9390 end;
9391
9392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9393 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9394 begin
9395   aVec[0] := - aHalfSize;
9396   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9397   aVec[2] := aPosition.X + 0.5 - aHalfSize;
9398 end;
9399
9400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9401 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9402 begin
9403   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9404   aVec[1] := aHalfSize;
9405   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
9406 end;
9407
9408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9409 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9410 begin
9411   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9412   aVec[1] := - aHalfSize;
9413   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
9414 end;
9415
9416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9417 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9418 begin
9419   aVec[0] := aPosition.X + 0.5 - aHalfSize;
9420   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9421   aVec[2] := aHalfSize;
9422 end;
9423
9424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9425 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
9426 begin
9427   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
9428   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
9429   aVec[2] := - aHalfSize;
9430 end;
9431
9432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9433 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
9434 var
9435   i: Integer;
9436   Vec: TVec;
9437   Len: Single;
9438 begin
9439   with FuncRec do begin
9440     with PglBitmapNormalMapRec(Args)^ do begin
9441       Func(Vec, Position, HalfSize);
9442
9443       // Normalize
9444       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
9445       if Len <> 0 then begin
9446         Vec[0] := Vec[0] * Len;
9447         Vec[1] := Vec[1] * Len;
9448         Vec[2] := Vec[2] * Len;
9449       end;
9450
9451       // Scale Vector and AddVectro
9452       Vec[0] := Vec[0] * 0.5 + 0.5;
9453       Vec[1] := Vec[1] * 0.5 + 0.5;
9454       Vec[2] := Vec[2] * 0.5 + 0.5;
9455     end;
9456
9457     // Set Color
9458     for i := 0 to 2 do
9459       Dest.Data.arr[i] := Round(Vec[i] * 255);
9460   end;
9461 end;
9462
9463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9464 procedure TglBitmapNormalMap.AfterConstruction;
9465 begin
9466   inherited;
9467 {$IFNDEF OPENGL_ES}
9468   fGenMode := GL_NORMAL_MAP;
9469 {$ENDIF}
9470 end;
9471
9472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
9473 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
9474 var
9475   Rec: TglBitmapNormalMapRec;
9476   SizeRec: TglBitmapSize;
9477 begin
9478   Rec.HalfSize := aSize div 2;
9479   FreeDataAfterGenTexture := false;
9480
9481   SizeRec.Fields := [ffX, ffY];
9482   SizeRec.X := aSize;
9483   SizeRec.Y := aSize;
9484
9485   // Positive X
9486   Rec.Func := glBitmapNormalMapPosX;
9487   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9488   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
9489
9490   // Negative X
9491   Rec.Func := glBitmapNormalMapNegX;
9492   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9493   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
9494
9495   // Positive Y
9496   Rec.Func := glBitmapNormalMapPosY;
9497   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9498   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
9499
9500   // Negative Y
9501   Rec.Func := glBitmapNormalMapNegY;
9502   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9503   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
9504
9505   // Positive Z
9506   Rec.Func := glBitmapNormalMapPosZ;
9507   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9508   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
9509
9510   // Negative Z
9511   Rec.Func := glBitmapNormalMapNegZ;
9512   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
9513   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
9514 end;
9515 {$IFEND}
9516
9517 initialization
9518   glBitmapSetDefaultFormat (tfEmpty);
9519   glBitmapSetDefaultMipmap (mmMipmap);
9520   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
9521   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
9522 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
9523   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
9524 {$IFEND}
9525
9526   glBitmapSetDefaultFreeDataAfterGenTexture(true);
9527   glBitmapSetDefaultDeleteTextureOnFree    (true);
9528
9529   TFormatDescriptor.Init;
9530
9531 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9532   OpenGLInitialized := false;
9533   InitOpenGLCS := TCriticalSection.Create;
9534 {$ENDIF}
9535
9536 finalization
9537   TFormatDescriptor.Finalize;
9538
9539 {$IFDEF GLB_NATIVE_OGL}
9540   if Assigned(GL_LibHandle) then
9541     glbFreeLibrary(GL_LibHandle);
9542
9543 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
9544   if Assigned(GLU_LibHandle) then
9545     glbFreeLibrary(GLU_LibHandle);
9546   FreeAndNil(InitOpenGLCS);
9547 {$ENDIF}
9548 {$ENDIF}
9549
9550 end.