glBitmap.pas

   1 {***********************************************************
   2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
   4 ------------------------------------------------------------
   5 The contents of this file are used with permission, subject to
   6 the Mozilla Public License Version 1.1 (the "License"); you may
   7 not use this file except in compliance with the License. You may
   8 obtain a copy of the License at
   9 http://www.mozilla.org/MPL/MPL-1.1.html
  10 ------------------------------------------------------------
  11 Version 2.0.3
  12 ------------------------------------------------------------
  13 History
  14 21-03-2010
  15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16   then it's your problem if that isn't true. This prevents the unit for incompatibility
  17   with newer versions of Delphi.
  18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20 10-08-2008
  21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22 - Additional Datapointer for functioninterface now has the name CustomData
  23 24-07-2008
  24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25 - If you load an texture from an file the property Filename will be set to the name of the file
  26 - Three new properties to attach custom data to the Texture objects
  27   - CustomName  (free for use string)
  28   - CustomNameW (free for use widestring)
  29   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30 27-05-2008
  31 - RLE TGAs loaded much faster
  32 26-05-2008
  33 - fixed some problem with reading RLE TGAs.
  34 21-05-2008
  35 - function clone now only copys data if it's assigned and now it also copies the ID
  36 - it seems that lazarus dont like comments in comments.
  37 01-05-2008
  38 - It's possible to set the id of the texture
  39 - define GLB_NO_NATIVE_GL deactivated by default
  40 27-04-2008
  41 - Now supports the following libraries
  42   - SDL and SDL_image
  43   - libPNG
  44   - libJPEG
  45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46 - BMPs now loaded manuel
  47 - Large restructuring
  48 - Property DataPtr now has the name Data
  49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50 - Unused Depth removed
  51 - Function FreeData to freeing image data added
  52 24-10-2007
  53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54 15-11-2006
  55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57 - Function ReadOpenGLExtension is now only intern
  58 29-06-2006
  59 - pngimage now disabled by default like all other versions.
  60 26-06-2006
  61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62 22-06-2006
  63 - Fixed some Problem with Delphi 5
  64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65 22-03-2006
  66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67 09-03-2006
  68 - Internal Format ifDepth8 added
  69 - function GrabScreen now supports all uncompressed formats
  70 31-01-2006
  71 - AddAlphaFromglBitmap implemented
  72 29-12-2005
  73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74 28-12-2005
  75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76   property Width, Height, Depth are still existing and new property Dimension are avail
  77 11-12-2005
  78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79 19-10-2005
  80 - Added function GrabScreen to class TglBitmap2D
  81 18-10-2005
  82 - Added support to Save images
  83 - Added function Clone to Clone Instance
  84 11-10-2005
  85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86   Usefull for Future
  87 - Several speed optimizations
  88 09-10-2005
  89 - Internal structure change. Loading of TGA, PNG and DDS improved.
  90   Data, format and size will now set directly with SetDataPtr.
  91 - AddFunc now works with all Types of Images and Formats
  92 - Some Funtions moved to Baseclass TglBitmap
  93 06-10-2005
  94 - Added Support to decompress DXT3 and DXT5 compressed Images.
  95 - Added Mapping to convert data from one format into an other.
  96 05-10-2005
  97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98   supported Input format (supported by GetPixel) into any uncompresed Format
  99 - Added Support to decompress DXT1 compressed Images.
 100 - SwapColors replaced by ConvertTo
 101 04-10-2005
 102 - Added Support for compressed DDSs
 103 - Added new internal formats (DXT1, DXT3, DXT5)
 104 29-09-2005
 105 - Parameter Components renamed to InternalFormat
 106 23-09-2005
 107 - Some AllocMem replaced with GetMem (little speed change)
 108 - better exception handling. Better protection from memory leaks.
 109 22-09-2005
 110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
 111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
 112 07-09-2005
 113 - Added support for Grayscale textures
 114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
 115 10-07-2005
 116 - Added support for GL_VERSION_2_0
 117 - Added support for GL_EXT_texture_filter_anisotropic
 118 04-07-2005
 119 - Function FillWithColor fills the Image with one Color
 120 - Function LoadNormalMap added
 121 30-06-2005
 122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
 123 - ToNormalMap now supports Sobel (nmSobel) function.
 124 29-06-2005
 125 - support for RLE Compressed RGB TGAs added
 126 28-06-2005
 127 - Class TglBitmapNormalMap added to support Normalmap generation
 128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
 129   3 Filters are supported. (4 Samples, 3x3 and 5x5)
 130 16-06-2005
 131 - Method LoadCubeMapClass removed
 132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
 133 - virtual abstract method GenTexture in class TglBitmap now is protected
 134 12-06-2005
 135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
 136 10-06-2005
 137 - little enhancement for IsPowerOfTwo
 138 - TglBitmap1D.GenTexture now tests NPOT Textures
 139 06-06-2005
 140 - some little name changes. All properties or function with Texture in name are
 141   now without texture in name. We have allways texture so we dosn't name it.
 142 03-06-2005
 143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
 144   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
 145 02-06-2005
 146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
 147 25-04-2005
 148 - Function Unbind added
 149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
 150 21-04-2005
 151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
 152 29-03-2005
 153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
 154   To Enable png's use the define pngimage
 155 22-03-2005
 156 - New Functioninterface added
 157 - Function GetPixel added
 158 27-11-2004
 159 - Property BuildMipMaps renamed to MipMap
 160 21-11-2004
 161 - property Name removed.
 162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
 163 22-05-2004
 164 - property name added. Only used in glForms!
 165 26-11-2003
 166 - property FreeDataAfterGenTexture is now available as default (default = true)
 167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
 168 - function MoveMemory replaced with function Move (little speed change)
 169 - several calculations stored in variables (little speed change)
 170 29-09-2003
 171 - property BuildMipsMaps added (default = true)
 172   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
 173 - property FreeDataAfterGenTexture added (default = true)
 174   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
 175 - parameter DisableOtherTextureUnits of Bind removed
 176 - parameter FreeDataAfterGeneration of GenTextures removed
 177 12-09-2003
 178 - TglBitmap dosn't delete data if class was destroyed (fixed)
 179 09-09-2003
 180 - Bind now enables TextureUnits (by params)
 181 - GenTextures can leave data (by param)
 182 - LoadTextures now optimal
 183 03-09-2003
 184 - Performance optimization in AddFunc
 185 - procedure Bind moved to subclasses
 186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
 187 19-08-2003
 188 - Texturefilter and texturewrap now also as defaults
 189   Minfilter = GL_LINEAR_MIPMAP_LINEAR
 190   Magfilter = GL_LINEAR
 191   Wrap(str) = GL_CLAMP_TO_EDGE
 192 - Added new format tfCompressed to create a compressed texture.
 193 - propertys IsCompressed, TextureSize and IsResident added
 194   IsCompressed and TextureSize only contains data from level 0
 195 18-08-2003
 196 - Added function AddFunc to add PerPixelEffects to Image
 197 - LoadFromFunc now based on AddFunc
 198 - Invert now based on AddFunc
 199 - SwapColors now based on AddFunc
 200 16-08-2003
 201 - Added function FlipHorz
 202 15-08-2003
 203 - Added function LaodFromFunc to create images with function
 204 - Added function FlipVert
 205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
 206 29-07-2003
 207 - Added Alphafunctions to calculate alpha per function
 208 - Added Alpha from ColorKey using alphafunctions
 209 28-07-2003
 210 - First full functionally Version of glBitmap
 211 - Support for 24Bit and 32Bit TGA Pictures added
 212 25-07-2003
 213 - begin of programming
 214 ***********************************************************}
 215 unit glBitmap;
 216
 217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
 218 // Please uncomment the defines below to configure the glBitmap to your preferences.
 219 // If you have configured the unit you can uncomment the warning above.
 220
 221 // ###### Start of preferences ################################################
 222
 223 {$DEFINE GLB_NO_NATIVE_GL}
 224 // To enable the dglOpenGL.pas Header
 225 // With native GL then bindings are staticlly declared to support other headers
 226 // or use the glBitmap inside of DLLs (minimize codesize).
 227
 228
 229 {.$DEFINE GLB_SDL}
 230 // To enable the support for SDL_surfaces
 231
 232 {.$DEFINE GLB_DELPHI}
 233 // To enable the support for TBitmap from Delphi (not lazarus)
 234
 235
 236 // *** image libs ***
 237
 238 {.$DEFINE GLB_SDL_IMAGE}
 239 // To enable the support of SDL_image to load files. (READ ONLY)
 240 // If you enable SDL_image all other libraries will be ignored!
 241
 242
 243 {.$DEFINE GLB_PNGIMAGE}
 244 // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
 245 // if you enable pngimage the libPNG will be ignored
 246
 247 {.$DEFINE GLB_LIB_PNG}
 248 // to use the libPNG http://www.libpng.org/
 249 // You will need an aditional header.
 250 // http://www.opengl24.de/index.php?cat=header&file=libpng
 251
 252 {.$DEFINE GLB_DELPHI_JPEG}
 253 // if you enable delphi jpegs the libJPEG will be ignored
 254
 255 {.$DEFINE GLB_LIB_JPEG}
 256 // to use the libJPEG http://www.ijg.org/
 257 // You will need an aditional header.
 258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
 259
 260 // ###### End of preferences ##################################################
 261
 262
 263 // ###### PRIVATE. Do not change anything. ####################################
 264 // *** old defines for compatibility ***
 265 {$IFDEF NO_NATIVE_GL}
 266   {$DEFINE GLB_NO_NATIVE_GL}
 267 {$ENDIF}
 268 {$IFDEF pngimage}
 269   {$definde GLB_PNGIMAGE}
 270 {$ENDIF}
 271
 272 // *** Delphi Versions ***
 273 {$IFDEF fpc}
 274   {$MODE Delphi}
 275
 276   {$IFDEF CPUI386}
 277     {$DEFINE CPU386}
 278     {$ASMMODE INTEL}
 279   {$ENDIF}
 280
 281   {$IFNDEF WINDOWS}
 282     {$linklib c}
 283   {$ENDIF}
 284 {$ENDIF}
 285
 286 // *** checking define combinations ***
 287 {$IFDEF GLB_SDL_IMAGE}
 288   {$IFNDEF GLB_SDL}
 289     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 290     {$DEFINE GLB_SDL}
 291   {$ENDIF}
 292   {$IFDEF GLB_PNGIMAGE}
 293     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 294     {$undef GLB_PNGIMAGE}
 295   {$ENDIF}
 296   {$IFDEF GLB_DELPHI_JPEG}
 297     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 298     {$undef GLB_DELPHI_JPEG}
 299   {$ENDIF}
 300   {$IFDEF GLB_LIB_PNG}
 301     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 302     {$undef GLB_LIB_PNG}
 303   {$ENDIF}
 304   {$IFDEF GLB_LIB_JPEG}
 305     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 306     {$undef GLB_LIB_JPEG}
 307   {$ENDIF}
 308
 309   {$DEFINE GLB_SUPPORT_PNG_READ}
 310   {$DEFINE GLB_SUPPORT_JPEG_READ}
 311 {$ENDIF}
 312
 313 {$IFDEF GLB_PNGIMAGE}
 314   {$IFDEF GLB_LIB_PNG}
 315     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 316     {$undef GLB_LIB_PNG}
 317   {$ENDIF}
 318
 319   {$DEFINE GLB_SUPPORT_PNG_READ}
 320   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 321 {$ENDIF}
 322
 323 {$IFDEF GLB_LIB_PNG}
 324   {$DEFINE GLB_SUPPORT_PNG_READ}
 325   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 326 {$ENDIF}
 327
 328 {$IFDEF GLB_DELPHI_JPEG}
 329   {$IFDEF GLB_LIB_JPEG}
 330     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 331     {$undef GLB_LIB_JPEG}
 332   {$ENDIF}
 333
 334   {$DEFINE GLB_SUPPORT_JPEG_READ}
 335   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 336 {$ENDIF}
 337
 338 {$IFDEF GLB_LIB_JPEG}
 339   {$DEFINE GLB_SUPPORT_JPEG_READ}
 340   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 341 {$ENDIF}
 342
 343 // *** general options ***
 344 {$EXTENDEDSYNTAX ON}
 345 {$LONGSTRINGS ON}
 346 {$ALIGN ON}
 347 {$IFNDEF FPC}
 348   {$OPTIMIZATION ON}
 349 {$ENDIF}
 350
 351 interface
 352
 353 uses
 354   {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL,                            {$ENDIF}
 355
 356   {$IFDEF GLB_SDL}          SDL,                                  {$ENDIF}
 357   {$IFDEF GLB_DELPHI}       Dialogs, Windows, Graphics,           {$ENDIF}
 358
 359   {$IFDEF GLB_SDL_IMAGE}    SDL_image,                            {$ENDIF}
 360
 361   {$IFDEF GLB_PNGIMAGE}     pngimage,                             {$ENDIF}
 362   {$IFDEF GLB_LIB_PNG}      libPNG,                               {$ENDIF}
 363
 364   {$IFDEF GLB_DELPHI_JPEG}  JPEG,                                 {$ENDIF}
 365   {$IFDEF GLB_LIB_JPEG}     libJPEG,                              {$ENDIF}
 366   Classes, SysUtils;
 367
 368 {$IFNDEF GLB_DELPHI}
 369 type
 370   HGLRC = Cardinal;
 371   DWORD = Cardinal;
 372   PDWORD = ^DWORD;
 373
 374   TRGBQuad = packed record
 375     rgbBlue: Byte;
 376     rgbGreen: Byte;
 377     rgbRed: Byte;
 378     rgbReserved: Byte;
 379   end;
 380 {$ENDIF}
 381
 382 (* TODO dglOpenGL
 383 {$IFNDEF GLB_NO_NATIVE_GL}
 384 // Native OpenGL Implementation
 385 type
 386   PByteBool = ^ByteBool;
 387
 388 {$IFDEF GLB_DELPHI}
 389 var
 390   gLastContext: HGLRC;
 391 {$ENDIF}
 392
 393 const
 394   // Generell
 395   GL_VERSION = $1F02;
 396   GL_EXTENSIONS = $1F03;
 397
 398   GL_TRUE = 1;
 399   GL_FALSE = 0;
 400
 401   GL_TEXTURE_1D = $0DE0;
 402   GL_TEXTURE_2D = $0DE1;
 403
 404   GL_MAX_TEXTURE_SIZE = $0D33;
 405   GL_PACK_ALIGNMENT = $0D05;
 406   GL_UNPACK_ALIGNMENT = $0CF5;
 407
 408   // Textureformats
 409   GL_RGB = $1907;
 410   GL_RGB4 = $804F;
 411   GL_RGB8 = $8051;
 412   GL_RGBA = $1908;
 413   GL_RGBA4 = $8056;
 414   GL_RGBA8 = $8058;
 415   GL_BGR = $80E0;
 416   GL_BGRA = $80E1;
 417   GL_ALPHA4 = $803B;
 418   GL_ALPHA8 = $803C;
 419   GL_LUMINANCE4 = $803F;
 420   GL_LUMINANCE8 = $8040;
 421   GL_LUMINANCE4_ALPHA4 = $8043;
 422   GL_LUMINANCE8_ALPHA8 = $8045;
 423   GL_DEPTH_COMPONENT = $1902;
 424
 425   GL_UNSIGNED_BYTE = $1401;
 426   GL_ALPHA = $1906;
 427   GL_LUMINANCE = $1909;
 428   GL_LUMINANCE_ALPHA = $190A;
 429
 430   GL_TEXTURE_WIDTH = $1000;
 431   GL_TEXTURE_HEIGHT = $1001;
 432   GL_TEXTURE_INTERNAL_FORMAT = $1003;
 433   GL_TEXTURE_RED_SIZE = $805C;
 434   GL_TEXTURE_GREEN_SIZE = $805D;
 435   GL_TEXTURE_BLUE_SIZE = $805E;
 436   GL_TEXTURE_ALPHA_SIZE = $805F;
 437   GL_TEXTURE_LUMINANCE_SIZE = $8060;
 438
 439   // Dataformats
 440   GL_UNSIGNED_SHORT_5_6_5 = $8363;
 441   GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
 442   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
 443   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
 444   GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
 445
 446   // Filter
 447   GL_NEAREST = $2600;
 448   GL_LINEAR = $2601;
 449   GL_NEAREST_MIPMAP_NEAREST = $2700;
 450   GL_LINEAR_MIPMAP_NEAREST = $2701;
 451   GL_NEAREST_MIPMAP_LINEAR = $2702;
 452   GL_LINEAR_MIPMAP_LINEAR = $2703;
 453   GL_TEXTURE_MAG_FILTER = $2800;
 454   GL_TEXTURE_MIN_FILTER = $2801;
 455
 456   // Wrapmodes
 457   GL_TEXTURE_WRAP_S = $2802;
 458   GL_TEXTURE_WRAP_T = $2803;
 459   GL_CLAMP = $2900;
 460   GL_REPEAT = $2901;
 461   GL_CLAMP_TO_EDGE = $812F;
 462   GL_CLAMP_TO_BORDER = $812D;
 463   GL_TEXTURE_WRAP_R = $8072;
 464
 465   GL_MIRRORED_REPEAT = $8370;
 466
 467   // Border Color
 468   GL_TEXTURE_BORDER_COLOR = $1004;
 469
 470   // Texgen
 471   GL_NORMAL_MAP = $8511;
 472   GL_REFLECTION_MAP = $8512;
 473   GL_S = $2000;
 474   GL_T = $2001;
 475   GL_R = $2002;
 476   GL_TEXTURE_GEN_MODE = $2500;
 477   GL_TEXTURE_GEN_S = $0C60;
 478   GL_TEXTURE_GEN_T = $0C61;
 479   GL_TEXTURE_GEN_R = $0C62;
 480
 481   // Cubemaps
 482   GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
 483   GL_TEXTURE_CUBE_MAP = $8513;
 484   GL_TEXTURE_BINDING_CUBE_MAP = $8514;
 485   GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
 486   GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
 487   GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
 488   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
 489   GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
 490   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
 491
 492   GL_TEXTURE_RECTANGLE_ARB = $84F5;
 493
 494   // GL_SGIS_generate_mipmap
 495   GL_GENERATE_MIPMAP = $8191;
 496
 497   // GL_EXT_texture_compression_s3tc
 498   GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
 499   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
 500   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
 501   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
 502
 503   // GL_EXT_texture_filter_anisotropic
 504   GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
 505   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
 506
 507   // GL_ARB_texture_compression
 508   GL_COMPRESSED_RGB = $84ED;
 509   GL_COMPRESSED_RGBA = $84EE;
 510   GL_COMPRESSED_ALPHA = $84E9;
 511   GL_COMPRESSED_LUMINANCE = $84EA;
 512   GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
 513
 514   // Extensions
 515 var
 516   GL_VERSION_1_2,
 517   GL_VERSION_1_3,
 518   GL_VERSION_1_4,
 519   GL_VERSION_2_0,
 520
 521   GL_ARB_texture_border_clamp,
 522   GL_ARB_texture_cube_map,
 523   GL_ARB_texture_compression,
 524   GL_ARB_texture_non_power_of_two,
 525   GL_ARB_texture_rectangle,
 526   GL_ARB_texture_mirrored_repeat,
 527   GL_EXT_bgra,
 528   GL_EXT_texture_edge_clamp,
 529   GL_EXT_texture_cube_map,
 530   GL_EXT_texture_compression_s3tc,
 531   GL_EXT_texture_filter_anisotropic,
 532   GL_EXT_texture_rectangle,
 533   GL_NV_texture_rectangle,
 534   GL_IBM_texture_mirrored_repeat,
 535   GL_SGIS_generate_mipmap: Boolean;
 536
 537 const
 538 {$IFDEF LINUX}
 539   libglu = 'libGLU.so.1';
 540   libopengl = 'libGL.so.1';
 541 {$else}
 542   libglu = 'glu32.dll';
 543   libopengl = 'opengl32.dll';
 544 {$ENDIF}
 545
 546 {$IFDEF LINUX}
 547   function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
 548 {$else}
 549   function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
 550 {$ENDIF}
 551
 552   function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 553
 554   procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 555   procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 556   procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 557
 558   procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 559   procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 560
 561   procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 562   procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 563   procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 564
 565   procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 566   procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 567   procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 568
 569   function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool;  {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 570   procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 571   procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 572   procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 573   procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
 574
 575   function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 576   function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
 577
 578 var
 579   glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 580   glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 581   glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
 582 {$ENDIF}
 583 *)
 584
 585 type
 586 ////////////////////////////////////////////////////////////////////////////////////////////////////
 587   EglBitmapException               = class(Exception);
 588   EglBitmapSizeToLargeException    = class(EglBitmapException);
 589   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
 590   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
 591
 592 ////////////////////////////////////////////////////////////////////////////////////////////////////
 593   TglBitmapPixelDesc = packed record
 594     RedRange: Cardinal;
 595     RedShift: Shortint;
 596     GreenRange: Cardinal;
 597     GreenShift: Shortint;
 598     BlueRange: Cardinal;
 599     BlueShift: Shortint;
 600     AlphaRange: Cardinal;
 601     AlphaShift: Shortint;
 602   end;
 603   PglBitmapPixelDesc = ^TglBitmapPixelDesc;
 604
 605 ////////////////////////////////////////////////////////////////////////////////////////////////////
 606   TglBitmapPixelData = packed record
 607     Red: Cardinal;
 608     Green: Cardinal;
 609     Blue: Cardinal;
 610     Alpha: Cardinal;
 611     PixelDesc: TglBitmapPixelDesc;
 612   end;
 613
 614 ////////////////////////////////////////////////////////////////////////////////////////////////////
 615   TglBitmapFormatDesc = packed record
 616     Format: Cardinal;
 617     InternalFormat: Cardinal;
 618     DataType: Cardinal;
 619   end;
 620
 621 ////////////////////////////////////////////////////////////////////////////////////////////////////
 622   TglBitmapPixelPositionFields = set of (ffX, ffY);
 623   TglBitmapPixelPosition = record
 624     Fields : TglBitmapPixelPositionFields;
 625     X : Word;
 626     Y : Word;
 627   end;
 628
 629 ////////////////////////////////////////////////////////////////////////////////////////////////////
 630   TglBitmap = class;
 631   TglBitmapFunctionRec = record
 632     Sender:   TglBitmap;
 633     Size:     TglBitmapPixelPosition;
 634     Position: TglBitmapPixelPosition;
 635     Source:   TglBitmapPixelData;
 636     Dest:     TglBitmapPixelData;
 637     Args:     PtrInt;
 638   end;
 639   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 640
 641 ////////////////////////////////////////////////////////////////////////////////////////////////////
 642   TglBitmapFileType = (
 643       {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 644       {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 645       ftDDS,
 646       ftTGA,
 647       ftBMP);
 648   TglBitmapFileTypes = set of TglBitmapFileType;
 649
 650   TglBitmapMipMap = (
 651     mmNone,
 652     mmMipmap,
 653     mmMipmapGlu);
 654
 655   TglBitmapNormalMapFunc = (
 656     nm4Samples,
 657     nmSobel,
 658     nm3x3,
 659     nm5x5);
 660
 661   TglBitmapFormat = (
 662     tfEmpty = 0,
 663     //TODO
 664     //tfAlpha4,
 665     //tfAlpha8,
 666     //tfAlpha12,
 667     //tfAlpha16,
 668
 669     //tfLuminance4,
 670     tfLuminance8,
 671     //tfLuminance12,
 672     //tfLuminance16,
 673     //
 674     //tfuminance4Alpha4,
 675     //tfLuminance6Alpha2,
 676     tfLuminance8Alpha8,
 677     //tfLuminance12Alpha4,
 678     //tfLuminance12Alpha12,
 679     //tfLuminance16Alpha16,
 680
 681     //tfR3G3B2,
 682     //tfRGB4,
 683     tfRGB5,
 684     tfRGB8,
 685     //tfRGB10,
 686     //tfRGB12,
 687     //tfRGB16,
 688
 689     //tfRGBA2,
 690     //tfRGBA4,
 691     tfRGB5A1,
 692     tfRGBA8,
 693     //tfRGB10A2,
 694     //tfRGBA12,
 695     //tfRGBA16,
 696
 697     //tfBGR4,
 698     //tfBGR5,
 699     tfBGR8,
 700     //tfBGR10,
 701     //tfBGR12,
 702     //tfBGR16,
 703
 704     //tfBGRA2,
 705     //tfBGRA4,
 706     //tfBGR5A1,
 707     tfBGRA8
 708     //tfBGR10A2,
 709     //tfBGRA12,
 710     //tfBGRA16,
 711
 712     //tfDepth16,
 713     //tfDepth24,
 714     //tfDepth32
 715   );
 716
 717 ////////////////////////////////////////////////////////////////////////////////////////////////////
 718   TglBitmapGetPixel  = procedure(const aPos: TglBitmapPixelPosition; var   aPixel: TglBitmapPixelData) of object;
 719   TglBitmapSetPixel  = procedure(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData) of object;
 720
 721   TglBitmapMapFunc   = procedure(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
 722   TglBitmapUnMapFunc = procedure(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
 723
 724 ////////////////////////////////////////////////////////////////////////////////////////////////////
 725   TglBitmapFormatDescriptor = class(TObject)
 726   public
 727     //virtual abstract
 728     class function GetFormat:     TglBitmapFormat;     virtual; abstract;
 729     class function GetPixelDesc:  TglBitmapPixelDesc;  virtual; abstract;
 730     class function GetFormatDesc: TglBitmapFormatDesc; virtual; abstract;
 731
 732     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); virtual; abstract;
 733     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); virtual; abstract;
 734
 735     //virtual
 736     class function WithoutAlpha: TglBitmapFormat; virtual;
 737     class function WithAlpha:    TglBitmapFormat; virtual;
 738
 739     class function GetSize: Single; virtual; overload;
 740     class function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
 741     class function GetColorCompCount: Integer; virtual;
 742
 743     class function IsEmpty:  Boolean; virtual;
 744     class function HasAlpha: Boolean; virtual;
 745     class function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
 746
 747     class procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
 748
 749     (* TODO
 750     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
 751     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
 752     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
 753     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
 754     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
 755     *)
 756   end;
 757   TglBitmapFormatDescClass = class of TglBitmapFormatDescriptor;
 758
 759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 760   TglBitmap = class
 761   protected
 762     fID: GLuint;
 763     fTarget: GLuint;
 764     fAnisotropic: Integer;
 765     fDeleteTextureOnFree: Boolean;
 766     fFreeDataAfterGenTexture: Boolean;
 767     fData: PByte;
 768     fIsResident: Boolean;
 769     fBorderColor: array[0..3] of Single;
 770
 771     fDimension: TglBitmapPixelPosition;
 772     fMipMap: TglBitmapMipMap;
 773     fFormat: TglBitmapFormat;
 774
 775     // Mapping
 776     fPixelSize: Integer;
 777     fRowSize: Integer;
 778     //TODO delete? fUnmapFunc: TglBitmapUnMapFunc;
 779     //TODO delete? fMapFunc: TglBitmapMapFunc;
 780
 781     // Filtering
 782     fFilterMin: Cardinal;
 783     fFilterMag: Cardinal;
 784
 785     // TexturWarp
 786     fWrapS: Cardinal;
 787     fWrapT: Cardinal;
 788     fWrapR: Cardinal;
 789
 790     //TODO delete? fGetPixelFunc: TglBitmapGetPixel;
 791     //TODO delete? fSetPixelFunc: TglBitmapSetPixel;
 792
 793     // CustomData
 794     fFilename: String;
 795     fCustomName: String;
 796     fCustomNameW: WideString;
 797     fCustomData: Pointer;
 798
 799     //Getter
 800     function GetWidth:  Integer; virtual;
 801     function GetHeight: Integer; virtual;
 802
 803     function GetFileWidth:  Integer; virtual;
 804     function GetFileHeight: Integer; virtual;
 805
 806     //Setter
 807     procedure SetCustomData(const aValue: Pointer);
 808     procedure SetCustomName(const aValue: String);
 809     procedure SetCustomNameW(const aValue: WideString);
 810     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 811     procedure SetFormat(const aValue: TglBitmapFormat);
 812     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 813     procedure SetID(const aValue: Cardinal);
 814     procedure SetMipMap(const aValue: TglBitmapMipMap);
 815     procedure SetTarget(const aValue: Cardinal);
 816     procedure SetAnisotropic(const aValue: Integer);
 817
 818     procedure CreateID;
 819     procedure SetupParameters(var aBuildWithGlu: Boolean);
 820     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 821       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 822     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 823
 824     function FlipHorz: Boolean; virtual;
 825     function FlipVert: Boolean; virtual;
 826
 827     property Width:  Integer read GetWidth;
 828     property Height: Integer read GetHeight;
 829
 830     property FileWidth:  Integer read GetFileWidth;
 831     property FileHeight: Integer read GetFileHeight;
 832   public
 833     //Properties
 834     property ID:           Cardinal        read fID          write SetID;
 835     property Target:       Cardinal        read fTarget      write SetTarget;
 836     property Format:       TglBitmapFormat read fFormat      write SetFormat;
 837     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
 838     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
 839
 840     property Filename:    String     read fFilename;
 841     property CustomName:  String     read fCustomName  write SetCustomName;
 842     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 843     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 844
 845     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 846     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 847
 848     property Dimension:  TglBitmapPixelPosition  read fDimension;
 849     property Data:       PByte                   read fData;
 850     property IsResident: Boolean                 read fIsResident;
 851
 852     procedure AfterConstruction; override;
 853     procedure BeforeDestruction; override;
 854
 855     //Load
 856     procedure LoadFromFile(const aFilename: String);
 857     procedure LoadFromStream(const aStream: TStream); virtual;
 858     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 859       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
 860     {$IFDEF GLB_DELPHI}
 861     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
 862     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 863     {$ENDIF}
 864
 865     //Save
 866     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 867     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 868
 869     //Convert
 870     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
 871     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 872       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
 873   public
 874     //Alpha & Co
 875     {$IFDEF GLB_SDL}
 876     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 877     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 878     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 879     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 880       const aArgs: PtrInt = 0): Boolean;
 881     {$ENDIF}
 882
 883     {$IFDEF GLB_DELPHI}
 884     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 885     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 886     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 887     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 888       const aArgs: PtrInt = 0): Boolean;
 889     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 890       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 891     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 892       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 893     {$ENDIF}
 894
 895     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 896     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 897     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 898     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 899
 900     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 901     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 902     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 903
 904     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 905     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 906     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 907
 908     function RemoveAlpha: Boolean; virtual;
 909   public
 910     //Common
 911     function Clone: TglBitmap;
 912     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 913     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 914     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 915     procedure FreeData;
 916
 917     //ColorFill
 918     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 919     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 920     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 921
 922     //TexParameters
 923     procedure SetFilter(const aMin, aMag: Cardinal);
 924     procedure SetWrap(
 925       const S: Cardinal = GL_CLAMP_TO_EDGE;
 926       const T: Cardinal = GL_CLAMP_TO_EDGE;
 927       const R: Cardinal = GL_CLAMP_TO_EDGE);
 928
 929     procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);   virtual;
 930     procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
 931
 932     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 933     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 934
 935     //Constructors
 936     constructor Create; overload;
 937     constructor Create(const aFileName: String); overload;
 938     constructor Create(const aStream: TStream); overload;
 939     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
 940     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
 941     {$IFDEF GLB_DELPHI}
 942     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 943     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 944     {$ENDIF}
 945   private
 946     {$IFDEF GLB_SUPPORT_PNG_READ}
 947     function LoadPNG(const aStream: TStream): Boolean; virtual;
 948     procedure SavePNG(const aStream: TStream); virtual;
 949     {$ENDIF}
 950     {$IFDEF GLB_SUPPORT_JPEG_READ}
 951     function LoadJPEG(const aStream: TStream): Boolean; virtual;
 952     procedure SaveJPEG(const aStream: TStream); virtual;
 953     {$ENDIF}
 954     function LoadBMP(const aStream: TStream): Boolean; virtual;
 955     procedure SaveBMP(const aStream: TStream); virtual;
 956
 957     function LoadTGA(const aStream: TStream): Boolean; virtual;
 958     procedure SaveTGA(const aStream: TStream); virtual;
 959
 960     function LoadDDS(const aStream: TStream): Boolean; virtual;
 961     procedure SaveDDS(const aStream: TStream); virtual;
 962   end;
 963
 964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 965   TglBitmap2D = class(TglBitmap)
 966   protected
 967     // Bildeinstellungen
 968     fLines: array of PByte;
 969
 970     (* TODO
 971     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
 972     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 973     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 974     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 975     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 976     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
 977     *)
 978
 979     function GetScanline(const aIndex: Integer): Pointer;
 980     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
 981       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
 982     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
 983   public
 984     property Width;
 985     property Height;
 986     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
 987
 988     procedure AfterConstruction; override;
 989
 990     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
 991     procedure GetDataFromTexture;
 992     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
 993
 994     function FlipHorz: Boolean; override;
 995     function FlipVert: Boolean; override;
 996
 997     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 998       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 999   end;
1000
1001 (* TODO
1002   TglBitmapCubeMap = class(TglBitmap2D)
1003   protected
1004     fGenMode: Integer;
1005
1006     // Hide GenTexture
1007     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1008   public
1009     procedure AfterConstruction; override;
1010
1011     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1012
1013     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1014     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1015   end;
1016
1017
1018   TglBitmapNormalMap = class(TglBitmapCubeMap)
1019   public
1020     procedure AfterConstruction; override;
1021
1022     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1023   end;
1024
1025
1026   TglBitmap1D = class(TglBitmap)
1027   protected
1028     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1029
1030     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1031     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1032   public
1033     // propertys
1034     property Width;
1035
1036     procedure AfterConstruction; override;
1037
1038     // Other
1039     function FlipHorz: Boolean; override;
1040
1041     // Generation
1042     procedure GenTexture(TestTextureSize: Boolean = true); override;
1043   end;
1044 *)
1045
1046 const
1047   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1048
1049 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1050 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1051 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1052 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1053 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1054 procedure glBitmapSetDefaultWrap(
1055   const S: Cardinal = GL_CLAMP_TO_EDGE;
1056   const T: Cardinal = GL_CLAMP_TO_EDGE;
1057   const R: Cardinal = GL_CLAMP_TO_EDGE);
1058
1059 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1060 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1061 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1062 function glBitmapGetDefaultFormat: TglBitmapFormat;
1063 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1064 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1065
1066 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1067
1068 var
1069   glBitmapDefaultDeleteTextureOnFree: Boolean;
1070   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1071   glBitmapDefaultFormat: TglBitmapFormat;
1072   glBitmapDefaultMipmap: TglBitmapMipMap;
1073   glBitmapDefaultFilterMin: Cardinal;
1074   glBitmapDefaultFilterMag: Cardinal;
1075   glBitmapDefaultWrapS: Cardinal;
1076   glBitmapDefaultWrapT: Cardinal;
1077   glBitmapDefaultWrapR: Cardinal;
1078
1079 {$IFDEF GLB_DELPHI}
1080 function CreateGrayPalette: HPALETTE;
1081 {$ENDIF}
1082
1083 implementation
1084
1085 uses
1086   Math;
1087
1088 type
1089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1090   TBitfieldFormat = class(TObject)
1091   private
1092     fRedShift: ShortInt;
1093     fGreenShift: ShortInt;
1094     fBlueShift: ShortInt;
1095     fAlphaShift: ShortInt;
1096
1097     fRedRange: Cardinal;
1098     fGreenRange: Cardinal;
1099     fBlueRange: Cardinal;
1100     fAlphaRange: Cardinal;
1101
1102     fRedMask: UInt64;
1103     fGreenMask: UInt64;
1104     fBlueMask: UInt64;
1105     fAlphaMask: UInt64;
1106     function GetSize: Integer;
1107     procedure SetAlphaMask(aValue: UInt64);
1108     procedure SetAlphaRange(aValue: Cardinal);
1109     procedure SetAlphaShift(aValue: ShortInt);
1110     procedure SetBlueMask(aValue: UInt64);
1111     procedure SetBlueRange(aValue: Cardinal);
1112     procedure SetBlueShift(aValue: ShortInt);
1113     procedure SetGreenMask(aValue: UInt64);
1114     procedure SetGreenRange(aValue: Cardinal);
1115     procedure SetGreenShift(aValue: ShortInt);
1116     procedure SetRedMask(aValue: UInt64);
1117     procedure SetRedRange(aValue: Cardinal);
1118     procedure SetRedShift(aValue: ShortInt);
1119
1120     procedure CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal; out aShift: ShortInt);
1121   public
1122     property RedShift:   ShortInt read fRedShift   write SetRedShift;
1123     property GreenShift: ShortInt read fGreenShift write SetGreenShift;
1124     property BlueShift:  ShortInt read fBlueShift  write SetBlueShift;
1125     property AlphaShift: ShortInt read fAlphaShift write SetAlphaShift;
1126
1127     property RedRange:   Cardinal read fRedRange   write SetRedRange;
1128     property GreenRange: Cardinal read fGreenRange write SetGreenRange;
1129     property BlueRange:  Cardinal read fBlueRange  write SetBlueRange;
1130     property AlphaRange: Cardinal read fAlphaRange write SetAlphaRange;
1131
1132     property RedMask:   UInt64 read fRedMask   write SetRedMask;
1133     property GreenMask: UInt64 read fGreenMask write SetGreenMask;
1134     property BlueMask:  UInt64 read fBlueMask  write SetBlueMask;
1135     property AlphaMask: UInt64 read fAlphaMask write SetAlphaMask;
1136
1137     property Size: Integer read GetSize;
1138
1139     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte);
1140     procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); overload;
1141     procedure Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData); overload;
1142   end;
1143
1144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1145   TfdEmpty = class(TglBitmapFormatDescriptor)
1146   public
1147     class function GetFormat: TglBitmapFormat; override;
1148     class function GetPixelDesc: TglBitmapPixelDesc; override;
1149     class function GetFormatDesc: TglBitmapFormatDesc; override;
1150
1151     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1152     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1153   end;
1154
1155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1156   TfdLuminance8 = class(TglBitmapFormatDescriptor)
1157   public
1158     class function GetFormat: TglBitmapFormat; override;
1159     class function GetPixelDesc: TglBitmapPixelDesc; override;
1160     class function GetFormatDesc: TglBitmapFormatDesc; override;
1161     class function WithAlpha: TglBitmapFormat; override;
1162
1163     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1164     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1165   end;
1166
1167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1168   TfdLuminance8Alpha8 = class(TglBitmapFormatDescriptor)
1169     public
1170       class function GetFormat: TglBitmapFormat; override;
1171       class function GetPixelDesc: TglBitmapPixelDesc; override;
1172       class function GetFormatDesc: TglBitmapFormatDesc; override;
1173       class function WithoutAlpha: TglBitmapFormat; override;
1174
1175       class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1176       class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1177     end;
1178
1179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1180   TfdRGB5 = class(TglBitmapFormatDescriptor)
1181   public
1182     class function GetFormat: TglBitmapFormat; override;
1183     class function GetPixelDesc: TglBitmapPixelDesc; override;
1184     class function GetFormatDesc: TglBitmapFormatDesc; override;
1185     class function WithAlpha: TglBitmapFormat; override;
1186
1187     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1188     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1189   end;
1190
1191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1192   TfdRGB8 = class(TglBitmapFormatDescriptor)
1193   public
1194     class function GetFormat: TglBitmapFormat; override;
1195     class function GetPixelDesc: TglBitmapPixelDesc; override;
1196     class function GetFormatDesc: TglBitmapFormatDesc; override;
1197     class function WithAlpha: TglBitmapFormat; override;
1198
1199     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1200     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1201   end;
1202
1203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1204   TfdRGB5A1 = class(TglBitmapFormatDescriptor)
1205   public
1206     class function GetFormat: TglBitmapFormat; override;
1207     class function GetPixelDesc: TglBitmapPixelDesc; override;
1208     class function GetFormatDesc: TglBitmapFormatDesc; override;
1209     class function WithoutAlpha: TglBitmapFormat; override;
1210
1211     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1212     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1213   end;
1214
1215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1216   TfdRGBA8 = class(TglBitmapFormatDescriptor)
1217   public
1218     class function GetFormat: TglBitmapFormat; override;
1219     class function GetPixelDesc: TglBitmapPixelDesc; override;
1220     class function GetFormatDesc: TglBitmapFormatDesc; override;
1221     class function WithoutAlpha: TglBitmapFormat; override;
1222
1223     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1224     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1225   end;
1226
1227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1228   TfdBGR8 = class(TglBitmapFormatDescriptor)
1229   public
1230     class function GetFormat: TglBitmapFormat; override;
1231     class function GetPixelDesc: TglBitmapPixelDesc; override;
1232     class function GetFormatDesc: TglBitmapFormatDesc; override;
1233     class function WithAlpha: TglBitmapFormat; override;
1234
1235     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1236     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1237   end;
1238
1239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1240   TfdBGRA8 = class(TglBitmapFormatDescriptor)
1241   public
1242     class function GetFormat: TglBitmapFormat; override;
1243     class function GetPixelDesc: TglBitmapPixelDesc; override;
1244     class function GetFormatDesc: TglBitmapFormatDesc; override;
1245     class function WithoutAlpha: TglBitmapFormat; override;
1246
1247     class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
1248     class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
1249   end;
1250
1251 const
1252   LUMINANCE_WEIGHT_R = 0.30;
1253   LUMINANCE_WEIGHT_G = 0.59;
1254   LUMINANCE_WEIGHT_B = 0.11;
1255
1256   ALPHA_WEIGHT_R = 0.30;
1257   ALPHA_WEIGHT_G = 0.59;
1258   ALPHA_WEIGHT_B = 0.11;
1259
1260   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1261
1262   FORMAT_DESCRIPTORS: array[TglBitmapFormat] of TglBitmapFormatDescClass = (
1263     TfdEmpty,
1264
1265     TfdLuminance8,
1266     TfdLuminance8Alpha8,
1267
1268     TfdRGB5,
1269     TfdRGB8,
1270
1271     TfdRGB5A1,
1272     TfdRGBA8,
1273
1274     TfdBGR8,
1275     TfdBGRA8
1276   );
1277
1278
1279 {$REGION Private Helper}
1280 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1281 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1282 begin
1283   result.Fields := [];
1284
1285   if X >= 0 then
1286     result.Fields := result.Fields + [ffX];
1287   if Y >= 0 then
1288     result.Fields := result.Fields + [ffY];
1289
1290   result.X := Max(0, X);
1291   result.Y := Max(0, Y);
1292 end;
1293
1294 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1295 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1296 begin
1297   //TODO Supported File Formats!
1298   result := [ftDDS, ftTGA, ftBMP];
1299   (*
1300   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1301   if aFormat in [
1302     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1303     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1304     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1305     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1306     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1307     tfDepth16, tfDepth24, tfDepth32]
1308   then
1309     result := result + [ftPNG];
1310   {$ENDIF}
1311
1312   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1313   if Format in [
1314     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1315     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1316     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1317     tfDepth16, tfDepth24, tfDepth32]
1318   then
1319     result := result + [ftJPEG];
1320   {$ENDIF}
1321
1322   if aFormat in [
1323     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1324     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1325     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1326     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1327     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1328     tfDepth16, tfDepth24, tfDepth32]
1329   then
1330     result := result + [ftDDS, ftTGA, ftBMP];
1331   *)
1332 end;
1333
1334 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1335 function IsPowerOfTwo(aNumber: Integer): Boolean;
1336 begin
1337   while (aNumber and 1) = 0 do
1338     aNumber := aNumber shr 1;
1339   result := aNumber = 1;
1340 end;
1341
1342 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1343 function GetTopMostBit(aBitSet: UInt64): Integer;
1344 begin
1345   result := 0;
1346   while aBitSet > 0 do begin
1347     inc(result);
1348     aBitSet := aBitSet shr 1;
1349   end;
1350 end;
1351
1352 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1353 function CountSetBits(aBitSet: UInt64): Integer;
1354 begin
1355   result := 0;
1356   while aBitSet > 0 do begin
1357     if (aBitSet and 1) = 1 then
1358       inc(result);
1359     aBitSet := aBitSet shr 1;
1360   end;
1361 end;
1362 {$ENDREGION}
1363
1364 //TODO check _ARB functions and constants
1365
1366 (* GLB_NO_NATIVE_GL
1367 {$IFNDEF GLB_NO_NATIVE_GL}
1368 procedure ReadOpenGLExtensions;
1369 var
1370   {$IFDEF GLB_DELPHI}
1371   Context: HGLRC;
1372   {$ENDIF}
1373   Buffer: AnsiString;
1374   MajorVersion, MinorVersion: Integer;
1375
1376
1377   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1378   var
1379     Separator: Integer;
1380   begin
1381     Minor := 0;
1382     Major := 0;
1383
1384     Separator := Pos(AnsiString('.'), Buffer);
1385
1386     if (Separator > 1) and (Separator < Length(Buffer)) and
1387        (Buffer[Separator - 1] in ['0'..'9']) and
1388        (Buffer[Separator + 1] in ['0'..'9']) then begin
1389
1390       Dec(Separator);
1391       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1392         Dec(Separator);
1393
1394       Delete(Buffer, 1, Separator);
1395       Separator := Pos(AnsiString('.'), Buffer) + 1;
1396
1397       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1398         Inc(Separator);
1399
1400       Delete(Buffer, Separator, 255);
1401       Separator := Pos(AnsiString('.'), Buffer);
1402
1403       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1404       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1405     end;
1406   end;
1407
1408
1409   function CheckExtension(const Extension: AnsiString): Boolean;
1410   var
1411     ExtPos: Integer;
1412   begin
1413     ExtPos := Pos(Extension, Buffer);
1414     result := ExtPos > 0;
1415
1416     if result then
1417       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1418   end;
1419
1420
1421   function glLoad (aFunc: pAnsiChar): pointer;
1422   begin
1423     {$IFDEF LINUX}
1424       result := glXGetProcAddress(aFunc);
1425     {$else}
1426       result := wglGetProcAddress(aFunc);
1427     {$ENDIF}
1428   end;
1429
1430
1431 begin
1432   {$IFDEF GLB_DELPHI}
1433   Context := wglGetCurrentContext;
1434
1435   if Context <> gLastContext then begin
1436     gLastContext := Context;
1437   {$ENDIF}
1438
1439     // Version
1440     Buffer := glGetString(GL_VERSION);
1441     TrimVersionString(Buffer, MajorVersion, MinorVersion);
1442
1443     GL_VERSION_1_2 := false;
1444     GL_VERSION_1_3 := false;
1445     GL_VERSION_1_4 := false;
1446     GL_VERSION_2_0 := false;
1447
1448     if MajorVersion = 1 then begin
1449       if MinorVersion >= 1 then begin
1450         if MinorVersion >= 2 then
1451           GL_VERSION_1_2 := true;
1452
1453         if MinorVersion >= 3 then
1454           GL_VERSION_1_3 := true;
1455
1456         if MinorVersion >= 4 then
1457           GL_VERSION_1_4 := true;
1458       end;
1459     end;
1460
1461     if MajorVersion >= 2 then begin
1462       GL_VERSION_1_2 := true;
1463       GL_VERSION_1_3 := true;
1464       GL_VERSION_1_4 := true;
1465       GL_VERSION_2_0 := true;
1466     end;
1467
1468     // Extensions
1469     Buffer := glGetString(GL_EXTENSIONS);
1470     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
1471     GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
1472     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');
1473     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
1474     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
1475     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
1476     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');
1477     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
1478     GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
1479     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');
1480     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1481     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
1482     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
1483     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
1484     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
1485
1486     // Funtions
1487     if GL_VERSION_1_3 then begin
1488       // Loading Core
1489       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1490       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1491       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1492     end else
1493
1494     begin
1495       // Try loading Extension
1496       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1497       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1498       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1499     end;
1500   {$IFDEF GLB_DELPHI}
1501   end;
1502   {$ENDIF}
1503 end;
1504 {$ENDIF}
1505 *)
1506
1507 (* TODO GLB_DELPHI
1508 {$IFDEF GLB_DELPHI}
1509 function CreateGrayPalette: HPALETTE;
1510 var
1511   Idx: Integer;
1512   Pal: PLogPalette;
1513 begin
1514   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
1515
1516   Pal.palVersion := $300;
1517   Pal.palNumEntries := 256;
1518
1519   {$IFOPT R+}
1520     {$DEFINE GLB_TEMPRANGECHECK}
1521     {$R-}
1522   {$ENDIF}
1523
1524   for Idx := 0 to 256 - 1 do begin
1525     Pal.palPalEntry[Idx].peRed   := Idx;
1526     Pal.palPalEntry[Idx].peGreen := Idx;
1527     Pal.palPalEntry[Idx].peBlue  := Idx;
1528     Pal.palPalEntry[Idx].peFlags := 0;
1529   end;
1530
1531   {$IFDEF GLB_TEMPRANGECHECK}
1532     {$UNDEF GLB_TEMPRANGECHECK}
1533     {$R+}
1534   {$ENDIF}
1535
1536   result := CreatePalette(Pal^);
1537
1538   FreeMem(Pal);
1539 end;
1540 {$ENDIF}
1541 *)
1542
1543 (* TODO GLB_SDL_IMAGE
1544 {$IFDEF GLB_SDL_IMAGE}
1545 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
1546 begin
1547   result := TStream(context^.unknown.data1).Seek(offset, whence);
1548 end;
1549
1550 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
1551 begin
1552   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
1553 end;
1554
1555 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
1556 begin
1557   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
1558 end;
1559
1560 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
1561 begin
1562   result := 0;
1563 end;
1564
1565 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
1566 begin
1567   result := SDL_AllocRW;
1568
1569   if result = nil then
1570     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
1571
1572   result^.seek := glBitmapRWseek;
1573   result^.read := glBitmapRWread;
1574   result^.write := glBitmapRWwrite;
1575   result^.close := glBitmapRWclose;
1576   result^.unknown.data1 := Stream;
1577 end;
1578 {$ENDIF}
1579 *)
1580
1581 (* TODO LoadFuncs
1582 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1583 var
1584   glBitmap: TglBitmap2D;
1585 begin
1586   result := false;
1587   Texture := 0;
1588
1589   {$IFDEF GLB_DELPHI}
1590   if Instance = 0 then
1591     Instance := HInstance;
1592
1593   if (LoadFromRes) then
1594     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
1595   else
1596   {$ENDIF}
1597     glBitmap := TglBitmap2D.Create(FileName);
1598
1599   try
1600     glBitmap.DeleteTextureOnFree := false;
1601     glBitmap.FreeDataAfterGenTexture := false;
1602     glBitmap.GenTexture(true);
1603     if (glBitmap.ID > 0) then begin
1604       Texture := glBitmap.ID;
1605       result := true;
1606     end;
1607   finally
1608     glBitmap.Free;
1609   end;
1610 end;
1611
1612 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
1613 var
1614   CM: TglBitmapCubeMap;
1615 begin
1616   Texture := 0;
1617
1618   {$IFDEF GLB_DELPHI}
1619   if Instance = 0 then
1620     Instance := HInstance;
1621   {$ENDIF}
1622
1623   CM := TglBitmapCubeMap.Create;
1624   try
1625     CM.DeleteTextureOnFree := false;
1626
1627     // Maps
1628     {$IFDEF GLB_DELPHI}
1629     if (LoadFromRes) then
1630       CM.LoadFromResource(Instance, PositiveX)
1631     else
1632     {$ENDIF}
1633       CM.LoadFromFile(PositiveX);
1634     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
1635
1636     {$IFDEF GLB_DELPHI}
1637     if (LoadFromRes) then
1638       CM.LoadFromResource(Instance, NegativeX)
1639     else
1640     {$ENDIF}
1641       CM.LoadFromFile(NegativeX);
1642     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
1643
1644     {$IFDEF GLB_DELPHI}
1645     if (LoadFromRes) then
1646       CM.LoadFromResource(Instance, PositiveY)
1647     else
1648     {$ENDIF}
1649       CM.LoadFromFile(PositiveY);
1650     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
1651
1652     {$IFDEF GLB_DELPHI}
1653     if (LoadFromRes) then
1654       CM.LoadFromResource(Instance, NegativeY)
1655     else
1656     {$ENDIF}
1657       CM.LoadFromFile(NegativeY);
1658     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
1659
1660     {$IFDEF GLB_DELPHI}
1661     if (LoadFromRes) then
1662       CM.LoadFromResource(Instance, PositiveZ)
1663     else
1664     {$ENDIF}
1665       CM.LoadFromFile(PositiveZ);
1666     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
1667
1668     {$IFDEF GLB_DELPHI}
1669     if (LoadFromRes) then
1670       CM.LoadFromResource(Instance, NegativeZ)
1671     else
1672     {$ENDIF}
1673       CM.LoadFromFile(NegativeZ);
1674     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
1675
1676     Texture := CM.ID;
1677     result := true;
1678   finally
1679     CM.Free;
1680   end;
1681 end;
1682
1683 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1684 var
1685   NM: TglBitmapNormalMap;
1686 begin
1687   Texture := 0;
1688
1689   NM := TglBitmapNormalMap.Create;
1690   try
1691     NM.DeleteTextureOnFree := false;
1692     NM.GenerateNormalMap(Size);
1693
1694     Texture := NM.ID;
1695     result := true;
1696   finally
1697     NM.Free;
1698   end;
1699 end;
1700 *)
1701
1702 {$REGION default Setter and Gettter}
1703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1704 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1705 begin
1706   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
1707 end;
1708
1709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1710 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1711 begin
1712   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
1713 end;
1714
1715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1716 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1717 begin
1718   glBitmapDefaultMipmap := aValue;
1719 end;
1720
1721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1722 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1723 begin
1724   glBitmapDefaultFormat := aFormat;
1725 end;
1726
1727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1728 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1729 begin
1730   glBitmapDefaultFilterMin := aMin;
1731   glBitmapDefaultFilterMag := aMag;
1732 end;
1733
1734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1735 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
1736 begin
1737   glBitmapDefaultWrapS := S;
1738   glBitmapDefaultWrapT := T;
1739   glBitmapDefaultWrapR := R;
1740 end;
1741
1742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1743 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1744 begin
1745   result := glBitmapDefaultDeleteTextureOnFree;
1746 end;
1747
1748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1749 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1750 begin
1751   result := glBitmapDefaultFreeDataAfterGenTextures;
1752 end;
1753
1754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1755 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1756 begin
1757   result := glBitmapDefaultMipmap;
1758 end;
1759
1760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1761 function glBitmapGetDefaultFormat: TglBitmapFormat;
1762 begin
1763   result := glBitmapDefaultFormat;
1764 end;
1765
1766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1767 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1768 begin
1769   aMin := glBitmapDefaultFilterMin;
1770   aMag := glBitmapDefaultFilterMag;
1771 end;
1772
1773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1774 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1775 begin
1776   S := glBitmapDefaultWrapS;
1777   T := glBitmapDefaultWrapT;
1778   R := glBitmapDefaultWrapR;
1779 end;
1780 {$ENDREGION}
1781
1782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1783 //TCustomFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 procedure TBitfieldFormat.SetAlphaMask(aValue: UInt64);
1786 begin
1787   if fAlphaMask = aValue then Exit;
1788   fAlphaMask := aValue;
1789   CalcShiftAndRange(fAlphaMask, fAlphaRange, fAlphaShift);
1790 end;
1791
1792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1793 function TBitfieldFormat.GetSize: Integer;
1794 var
1795   tmp: UInt64;
1796 begin
1797   tmp :=
1798     (fRedRange   shl fRedShift)   or
1799     (fGreenRange shl fGreenShift) or
1800     (fBlueRange  shl fBlueShift)  or
1801     (fAlphaRange shl fAlphaShift);
1802   result := Trunc(GetTopMostBit(tmp) / 8);
1803 end;
1804
1805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1806 procedure TBitfieldFormat.SetAlphaRange(aValue: Cardinal);
1807 begin
1808   if fAlphaRange = aValue then Exit;
1809   fAlphaRange := aValue;
1810   fAlphaMask := fAlphaRange shl fAlphaShift;
1811 end;
1812
1813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 procedure TBitfieldFormat.SetAlphaShift(aValue: ShortInt);
1815 begin
1816   if fAlphaShift = aValue then Exit;
1817   fAlphaShift := aValue;
1818   fAlphaMask := fAlphaRange shl fAlphaShift;
1819 end;
1820
1821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1822 procedure TBitfieldFormat.SetBlueMask(aValue: UInt64);
1823 begin
1824   if fBlueMask = aValue then Exit;
1825   fBlueMask := aValue;
1826   CalcShiftAndRange(fBlueMask, fBlueRange, fBlueShift);
1827 end;
1828
1829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1830 procedure TBitfieldFormat.SetBlueRange(aValue: Cardinal);
1831 begin
1832   if fBlueRange = aValue then Exit;
1833   fBlueRange := aValue;
1834   fBlueMask := fBlueRange shl fBlueShift;
1835 end;
1836
1837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1838 procedure TBitfieldFormat.SetBlueShift(aValue: ShortInt);
1839 begin
1840   if fBlueShift = aValue then Exit;
1841   fBlueShift := aValue;
1842   fBlueMask := fBlueRange shl fBlueShift;
1843 end;
1844
1845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 procedure TBitfieldFormat.SetGreenMask(aValue: UInt64);
1847 begin
1848   if fGreenMask = aValue then Exit;
1849   fGreenMask := aValue;
1850   CalcShiftAndRange(fGreenMask, fGreenRange, fGreenShift);
1851 end;
1852
1853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1854 procedure TBitfieldFormat.SetGreenRange(aValue: Cardinal);
1855 begin
1856   if fGreenRange = aValue then Exit;
1857   fGreenRange := aValue;
1858   fGreenMask := fGreenRange shl fGreenShift;
1859 end;
1860
1861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1862 procedure TBitfieldFormat.SetGreenShift(aValue: ShortInt);
1863 begin
1864   if fGreenShift = aValue then Exit;
1865   fGreenShift := aValue;
1866   fGreenMask := fGreenRange shl fGreenShift;
1867 end;
1868
1869 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1870 procedure TBitfieldFormat.SetRedMask(aValue: UInt64);
1871 begin
1872   if fRedMask = aValue then Exit;
1873   fRedMask := aValue;
1874   CalcShiftAndRange(fRedMask, fRedRange, fRedShift);
1875 end;
1876
1877 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1878 procedure TBitfieldFormat.SetRedRange(aValue: Cardinal);
1879 begin
1880   if fRedRange = aValue then Exit;
1881   fRedRange := aValue;
1882   fRedMask := fRedRange shl fRedShift;
1883 end;
1884
1885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1886 procedure TBitfieldFormat.SetRedShift(aValue: ShortInt);
1887 begin
1888   if fRedShift = aValue then Exit;
1889   fRedShift := aValue;
1890   fRedMask := fRedRange shl fRedShift;
1891 end;
1892
1893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1894 procedure TBitfieldFormat.CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal;
1895   out aShift: ShortInt);
1896 begin
1897   aShift := 0;
1898   aRange := 0;
1899   if (aMask = 0) then
1900     exit;
1901   while (aMask > 0) and ((aMask and 1) = 0) do begin
1902     inc(aShift);
1903     aMask := aMask shr 1;
1904   end;
1905   aRange := 1;
1906   while (aMask > 0) do begin
1907     aRange := aRange shl 1;
1908     aMask  := aMask  shr 1;
1909   end;
1910   dec(aRange);
1911 end;
1912
1913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1914 procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
1915 var
1916   data: UInt64;
1917   s: Integer;
1918 type
1919   PUInt64 = ^UInt64;
1920 begin
1921   data :=
1922     ((aPixel.Red   and fRedRange)   shl fRedShift)  or
1923     ((aPixel.Green and fGreenRange) shl fGreenShift) or
1924     ((aPixel.Blue  and fBlueRange)  shl fBlueShift)  or
1925     ((aPixel.Alpha and fAlphaRange) shl fAlphaShift);
1926   s := Size;
1927   case s of
1928     1:           aData^  := data;
1929     2:     PWord(aData)^ := data;
1930     4: PCardinal(aData)^ := data;
1931     8:   PUInt64(aData)^ := data;
1932   end;
1933   inc(aData, s);
1934 end;
1935
1936 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1937 procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
1938 var
1939   data: UInt64;
1940   s: Integer;
1941 type
1942   PUInt64 = ^UInt64;
1943 begin
1944   s := Size;
1945   case s of
1946     1: data :=           aData^;
1947     2: data :=     PWord(aData)^;
1948     4: data := PCardinal(aData)^;
1949     8: data :=   PUInt64(aData)^;
1950   end;
1951   Unmap(data, aPixel);
1952   inc(aData, s);
1953 end;
1954
1955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1956 procedure TBitfieldFormat.Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData);
1957 begin
1958   aPixel.Red   := (aData shr fRedShift)   and fRedRange;
1959   aPixel.Green := (aData shr fGreenShift) and fGreenRange;
1960   aPixel.Blue  := (aData shr fBlueShift)  and fBlueRange;
1961   aPixel.Alpha := (aData shr fAlphaShift) and fAlphaRange;
1962 end;
1963
1964 {$REGION TglBitmapFormatDescriptor}
1965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1966 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1968 class function TglBitmapFormatDescriptor.WithoutAlpha: TglBitmapFormat;
1969 begin
1970   if not HasAlpha then
1971     result := GetFormat
1972   else
1973     result := tfEmpty;
1974 end;
1975
1976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1977 class function TglBitmapFormatDescriptor.WithAlpha: TglBitmapFormat;
1978 begin
1979   if HasAlpha then
1980     result := GetFormat
1981   else
1982     result := tfEmpty;
1983 end;
1984
1985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1986 class function TglBitmapFormatDescriptor.GetSize: Single;
1987 var
1988   tmp: UInt64;
1989 begin
1990   with GetPixelDesc do begin
1991     tmp :=
1992       (RedRange   shl RedShift)   or
1993       (GreenRange shl GreenShift) or
1994       (BlueRange  shl BlueShift)  or
1995       (AlphaRange shl AlphaShift);
1996   end;
1997   result := Trunc(GetTopMostBit(tmp) / 4) / 2;
1998 end;
1999
2000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2001 class function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2002 var
2003   w, h: Integer;
2004 begin
2005   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2006     w := Max(1, aSize.X);
2007     h := Max(1, aSize.Y);
2008     result := Ceil(w * h * GetSize);
2009   end else
2010     result := 0;
2011 end;
2012
2013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2014 class function TglBitmapFormatDescriptor.GetColorCompCount: Integer;
2015 begin
2016   result := 0;
2017   with GetPixelDesc do begin
2018     if (RedRange > 0) then
2019       inc(result);
2020     if (GreenRange > 0) then
2021       inc(result);
2022     if (BlueRange > 0) then
2023       inc(result);
2024     if (AlphaRange > 0) then
2025       inc(result);
2026   end;
2027 end;
2028
2029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2030 class function TglBitmapFormatDescriptor.IsEmpty: Boolean;
2031 begin
2032   result := (GetFormat = tfEmpty);
2033 end;
2034
2035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2036 class function TglBitmapFormatDescriptor.HasAlpha: Boolean;
2037 begin
2038   result := (GetPixelDesc.AlphaRange > 0);
2039 end;
2040
2041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2042 class function TglBitmapFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
2043 var
2044   PixelDesc: TglBitmapPixelDesc;
2045 begin
2046   result := false;
2047
2048   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2049     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2050
2051   PixelDesc := GetPixelDesc;
2052   with PixelDesc do begin
2053     if (aRedMask   <> 0) and (aRedMask   <> (RedRange   shl RedShift)) then
2054       exit;
2055     if (aGreenMask <> 0) and (aGreenMask <> (GreenRange shl GreenShift)) then
2056       exit;
2057     if (aBlueMask  <> 0) and (aBlueMask  <> (BlueRange  shl BlueShift)) then
2058       exit;
2059     if (aAlphaMask <> 0) and (aAlphaMask <> (AlphaRange shl AlphaShift)) then
2060       exit;
2061   end;
2062   result := true;
2063 end;
2064
2065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2066 class procedure TglBitmapFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
2067 begin
2068   FillChar(aPixel, SizeOf(aPixel), 0);
2069   aPixel.PixelDesc := GetPixelDesc;
2070   with aPixel.PixelDesc do begin
2071     aPixel.Red   := RedRange;
2072     aPixel.Green := GreenRange;
2073     aPixel.Blue  := BlueRange;
2074     aPixel.Alpha := AlphaRange;
2075   end;
2076 end;
2077 {$ENDREGION}
2078
2079 {$REGION TfdEmpty}
2080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2081 //TfdEmpty////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2083 class function TfdEmpty.GetFormat: TglBitmapFormat;
2084 begin
2085   result := tfEmpty;
2086 end;
2087
2088 class function TfdEmpty.GetPixelDesc: TglBitmapPixelDesc;
2089 begin
2090   with result do begin
2091     RedRange   := $00000000; RedShift   := 0;
2092     GreenRange := $00000000; GreenShift := 0;
2093     BlueRange  := $00000000; BlueShift  := 0;
2094     AlphaRange := $00000000; AlphaShift := 0;
2095   end;
2096 end;
2097
2098 class function TfdEmpty.GetFormatDesc: TglBitmapFormatDesc;
2099 begin
2100   with result do begin
2101     Format         := 0;
2102     InternalFormat := 0;
2103     DataType       := 0;
2104   end;
2105 end;
2106
2107 class procedure TfdEmpty.Map(const aPixel: TglBitmapPixelData; var aData: PByte  );
2108 begin
2109   raise EglBitmapException.Create('format does not support mapping');
2110 end;
2111
2112 class procedure TfdEmpty.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2113 begin
2114   raise EglBitmapException.Create('format does not support unmapping');
2115 end;
2116 {$ENDREGION}
2117
2118 {$REGION TfdLuminance8}
2119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 //TfdLuminance8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2122 class function TfdLuminance8.GetFormat: TglBitmapFormat;
2123 begin
2124   result := tfEmpty;
2125 end;
2126
2127 class function TfdLuminance8.GetPixelDesc: TglBitmapPixelDesc;
2128 begin
2129   with result do begin
2130     RedRange   := $000000FF; RedShift   := 0;
2131     GreenRange := $000000FF; GreenShift := 0;
2132     BlueRange  := $000000FF; BlueShift  := 0;
2133     AlphaRange := $00000000; AlphaShift := 0;
2134   end;
2135 end;
2136
2137 class function TfdLuminance8.GetFormatDesc: TglBitmapFormatDesc;
2138 begin
2139   with result do begin
2140     Format         := GL_LUMINANCE;
2141     InternalFormat := GL_LUMINANCE8;
2142     DataType       := GL_UNSIGNED_BYTE;
2143   end;
2144 end;
2145
2146 class function TfdLuminance8.WithAlpha: TglBitmapFormat;
2147 begin
2148   result := tfLuminance8Alpha8;
2149 end;
2150
2151 class procedure TfdLuminance8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2152 begin
2153   aData^ := Trunc(
2154     aPixel.Red   * LUMINANCE_WEIGHT_R +
2155     aPixel.Green * LUMINANCE_WEIGHT_G +
2156     aPixel.Blue  * LUMINANCE_WEIGHT_B);
2157   inc(aData);
2158 end;
2159
2160 class procedure TfdLuminance8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2161 begin
2162   aPixel.Red   := aData^;
2163   aPixel.Green := aData^;
2164   aPixel.Blue  := aData^;
2165   aPixel.Alpha := 0;
2166   inc(aData);
2167 end;
2168 {$ENDREGION}
2169
2170 {$REGION TfdLuminance8Alpha8}
2171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 //TfdLuminance8Alpha8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 class function TfdLuminance8Alpha8.GetFormat: TglBitmapFormat;
2175 begin
2176   result := tfLuminance8Alpha8;
2177 end;
2178
2179 class function TfdLuminance8Alpha8.GetPixelDesc: TglBitmapPixelDesc;
2180 begin
2181   with result do begin
2182     RedRange   := $000000FF; RedShift   := 0;
2183     GreenRange := $000000FF; GreenShift := 0;
2184     BlueRange  := $000000FF; BlueShift  := 0;
2185     AlphaRange := $000000FF; AlphaShift := 8;
2186   end;
2187 end;
2188
2189 class function TfdLuminance8Alpha8.GetFormatDesc: TglBitmapFormatDesc;
2190 begin
2191   with result do begin
2192     Format         := GL_LUMINANCE_ALPHA;
2193     InternalFormat := GL_LUMINANCE8_ALPHA8;
2194     DataType       := GL_UNSIGNED_BYTE;
2195   end;
2196 end;
2197
2198 class function TfdLuminance8Alpha8.WithoutAlpha: TglBitmapFormat;
2199 begin
2200   result := tfLuminance8;
2201 end;
2202
2203 class procedure TfdLuminance8Alpha8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2204 begin
2205   aData^ := Trunc(
2206     aPixel.Red   * LUMINANCE_WEIGHT_R +
2207     aPixel.Green * LUMINANCE_WEIGHT_G +
2208     aPixel.Blue  * LUMINANCE_WEIGHT_B);
2209   inc(aData);
2210
2211   aData^ := aPixel.Alpha;
2212   inc(aData);
2213 end;
2214
2215 class procedure TfdLuminance8Alpha8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2216 begin
2217   aPixel.Red   := aData^;
2218   aPixel.Green := aData^;
2219   aPixel.Blue  := aData^;
2220   inc(aData);
2221
2222   aPixel.Alpha := aData^;
2223   inc(aData);
2224 end;
2225 {$ENDREGION}
2226
2227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2228 //TfdRGB5/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2230 class function TfdRGB5.GetFormat: TglBitmapFormat;
2231 begin
2232   result := tfRGB5;
2233 end;
2234
2235 class function TfdRGB5.GetPixelDesc: TglBitmapPixelDesc;
2236 begin
2237   with result do begin
2238     RedRange   := $0000001F; RedShift   := 0;
2239     GreenRange := $0000001F; GreenShift := 5;
2240     BlueRange  := $0000001F; BlueShift  := 10;
2241     AlphaRange := $00000000; AlphaShift := 0;
2242   end;
2243 end;
2244
2245 class function TfdRGB5.GetFormatDesc: TglBitmapFormatDesc;
2246 begin
2247   with result do begin
2248     Format         := GL_RGB;
2249     InternalFormat := GL_RGB5;
2250     DataType       := GL_UNSIGNED_SHORT_5_5_5_1;
2251   end;
2252 end;
2253
2254 class function TfdRGB5.WithAlpha: TglBitmapFormat;
2255 begin
2256   result := tfRGB5A1;
2257 end;
2258
2259 class procedure TfdRGB5.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2260 begin
2261   PWord(aData)^ :=
2262     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
2263     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
2264     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift);
2265   inc(aData, 2);
2266 end;
2267
2268 class procedure TfdRGB5.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2269 begin
2270   aPixel.Red   := (PWord(aData)^ shr aPixel.PixelDesc.RedShift)   and aPixel.PixelDesc.RedRange;
2271   aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange;
2272   aPixel.Blue  := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift)  and aPixel.PixelDesc.BlueRange;
2273   aPixel.Alpha := 0;
2274   inc(aData, 2);
2275 end;
2276
2277 {$REGION TfdRGB8}
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 //TfdRGB8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2281 class function TfdRGB8.GetFormat: TglBitmapFormat;
2282 begin
2283   result := tfRGB8;
2284 end;
2285
2286 class function TfdRGB8.GetPixelDesc: TglBitmapPixelDesc;
2287 begin
2288   with result do begin
2289     RedRange   := $000000FF; RedShift   := 0;
2290     GreenRange := $000000FF; GreenShift := 8;
2291     BlueRange  := $000000FF; BlueShift  := 16;
2292     AlphaRange := $00000000; AlphaShift := 0;
2293   end;
2294 end;
2295
2296 class function TfdRGB8.GetFormatDesc: TglBitmapFormatDesc;
2297 begin
2298   with result do begin
2299     Format         := GL_LUMINANCE;
2300     InternalFormat := GL_LUMINANCE8;
2301     DataType       := GL_UNSIGNED_BYTE;
2302   end;
2303 end;
2304
2305 class function TfdRGB8.WithAlpha: TglBitmapFormat;
2306 begin
2307   result := tfRGBA8;
2308 end;
2309
2310 class procedure TfdRGB8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2311 begin
2312   aData^ := aPixel.Red;
2313   inc(aData);
2314   aData^ := aPixel.Green;
2315   inc(aData);
2316   aData^ := aPixel.Blue;
2317   inc(aData);
2318 end;
2319
2320 class procedure TfdRGB8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2321 begin
2322   aPixel.Red := aData^;
2323   inc(aData);
2324   aPixel.Green := aData^;
2325   inc(aData);
2326   aPixel.Blue := aData^;
2327   inc(aData);
2328   aPixel.Alpha := 0;
2329 end;
2330 {$ENDREGION}
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 //TfdRGB5A1///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 class function TfdRGB5A1.GetFormat: TglBitmapFormat;
2336 begin
2337   result := tfRGB5A1;
2338 end;
2339
2340 class function TfdRGB5A1.GetPixelDesc: TglBitmapPixelDesc;
2341 begin
2342   with result do begin
2343     RedRange   := $0000001F; RedShift   := 0;
2344     GreenRange := $0000001F; GreenShift := 5;
2345     BlueRange  := $0000001F; BlueShift  := 10;
2346     AlphaRange := $00000001; AlphaShift := 15;
2347   end;
2348 end;
2349
2350 class function TfdRGB5A1.GetFormatDesc: TglBitmapFormatDesc;
2351 begin
2352   with result do begin
2353     Format         := GL_RGBA;
2354     InternalFormat := GL_RGB5_A1;
2355     DataType       := GL_UNSIGNED_SHORT_5_5_5_1;
2356   end;
2357 end;
2358
2359 class function TfdRGB5A1.WithoutAlpha: TglBitmapFormat;
2360 begin
2361   //TODO result := tfRGB5;
2362 end;
2363
2364 class procedure TfdRGB5A1.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2365 begin
2366   PWord(aData)^ :=
2367     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
2368     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
2369     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
2370     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
2371   inc(aData, 2);
2372 end;
2373
2374 class procedure TfdRGB5A1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2375 begin
2376   aPixel.Red   := (PWord(aData)^ shr aPixel.PixelDesc.RedShift)   and aPixel.PixelDesc.RedRange;
2377   aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange;
2378   aPixel.Blue  := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift)  and aPixel.PixelDesc.BlueRange;
2379   aPixel.Alpha := (PWord(aData)^ shr aPixel.PixelDesc.AlphaShift) and aPixel.PixelDesc.AlphaRange;
2380   inc(aData, 2);
2381 end;
2382
2383 {$REGION TfdRGBA8}
2384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2385 //TfdRGBA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 class function TfdRGBA8.GetFormat: TglBitmapFormat;
2388 begin
2389   result := tfRGBA8;
2390 end;
2391
2392 class function TfdRGBA8.GetPixelDesc: TglBitmapPixelDesc;
2393 begin
2394   with result do begin
2395     RedRange   := $000000FF; RedShift   := 0;
2396     GreenRange := $000000FF; GreenShift := 8;
2397     BlueRange  := $000000FF; BlueShift  := 16;
2398     AlphaRange := $000000FF; AlphaShift := 24;
2399   end;
2400 end;
2401
2402 class function TfdRGBA8.GetFormatDesc: TglBitmapFormatDesc;
2403 begin
2404   with result do begin
2405     Format         := GL_RGB;
2406     InternalFormat := GL_RGB8;
2407     DataType       := GL_UNSIGNED_BYTE;
2408   end;
2409 end;
2410
2411 class function TfdRGBA8.WithoutAlpha: TglBitmapFormat;
2412 begin
2413   result := tfRGB8;
2414 end;
2415
2416 class procedure TfdRGBA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2417 begin
2418   aData^ := aPixel.Red;
2419   inc(aData);
2420   aData^ := aPixel.Green;
2421   inc(aData);
2422   aData^ := aPixel.Blue;
2423   inc(aData);
2424   aData^ := aPixel.Alpha;
2425   inc(aData);
2426 end;
2427
2428 class procedure TfdRGBA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2429 begin
2430   aPixel.Red := aData^;
2431   inc(aData);
2432   aPixel.Green := aData^;
2433   inc(aData);
2434   aPixel.Blue := aData^;
2435   inc(aData);
2436   aPixel.Alpha := aData^;
2437   inc(aData);
2438 end;
2439 {$ENDREGION}
2440
2441 {$REGION TfdBGR8}
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 //TfdBGR8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2445 class function TfdBGR8.GetFormat: TglBitmapFormat;
2446 begin
2447   result := tfBGR8;
2448 end;
2449
2450 class function TfdBGR8.GetPixelDesc: TglBitmapPixelDesc;
2451 begin
2452   with result do begin
2453     RedRange   := $000000FF; RedShift   := 16;
2454     GreenRange := $000000FF; GreenShift := 8;
2455     BlueRange  := $000000FF; BlueShift  := 0;
2456     AlphaRange := $00000000; AlphaShift := 0;
2457   end;
2458 end;
2459
2460 class function TfdBGR8.GetFormatDesc: TglBitmapFormatDesc;
2461 begin
2462   with result do begin
2463     Format         := GL_BGR;
2464     InternalFormat := GL_RGB8;
2465     DataType       := GL_UNSIGNED_BYTE;
2466   end;
2467 end;
2468
2469 class function TfdBGR8.WithAlpha: TglBitmapFormat;
2470 begin
2471   result := tfBGRA8;
2472 end;
2473
2474 class procedure TfdBGR8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2475 begin
2476   aData^ := aPixel.Blue;
2477   inc(aData);
2478   aData^ := aPixel.Green;
2479   inc(aData);
2480   aData^ := aPixel.Red;
2481   inc(aData);
2482 end;
2483
2484 class procedure TfdBGR8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2485 begin
2486   aPixel.Blue := aData^;
2487   inc(aData);
2488   aPixel.Green := aData^;
2489   inc(aData);
2490   aPixel.Red := aData^;
2491   inc(aData);
2492 end;
2493 {$ENDREGION}
2494
2495 {$REGION TfdBGRA8}
2496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2497 //TfdBGRA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 class function TfdBGRA8.GetFormat: TglBitmapFormat;
2500 begin
2501   result := tfBGRA8;
2502 end;
2503
2504 class function TfdBGRA8.GetPixelDesc: TglBitmapPixelDesc;
2505 begin
2506   with result do begin
2507     RedRange   := $000000FF; RedShift   := 16;
2508     GreenRange := $000000FF; GreenShift := 8;
2509     BlueRange  := $000000FF; BlueShift  := 0;
2510     AlphaRange := $000000FF; AlphaShift := 24;
2511   end;
2512 end;
2513
2514 class function TfdBGRA8.GetFormatDesc: TglBitmapFormatDesc;
2515 begin
2516   with result do begin
2517     Format         := GL_BGRA;
2518     InternalFormat := GL_RGBA8;
2519     DataType       := GL_UNSIGNED_BYTE;
2520   end;
2521 end;
2522
2523 class function TfdBGRA8.WithoutAlpha: TglBitmapFormat;
2524 begin
2525   result := tfBGR8;
2526 end;
2527
2528 class procedure TfdBGRA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
2529 begin
2530   aData^ := aPixel.Blue;
2531   inc(aData);
2532   aData^ := aPixel.Green;
2533   inc(aData);
2534   aData^ := aPixel.Red;
2535   inc(aData);
2536   aData^ := aPixel.Alpha;
2537   inc(aData);
2538 end;
2539
2540 class procedure TfdBGRA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
2541 begin
2542   aPixel.Blue := aData^;
2543   inc(aData);
2544   aPixel.Green := aData^;
2545   inc(aData);
2546   aPixel.Red := aData^;
2547   inc(aData);
2548   aPixel.Alpha := aData^;
2549   inc(aData);
2550 end;
2551 {$ENDREGION}
2552
2553 {$REGION TglBitmap}
2554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
2558 begin
2559   with aFuncRec do begin
2560     if (Source.PixelDesc.RedRange   > 0) then
2561       Dest.Red   := Source.Red;
2562     if (Source.PixelDesc.GreenRange > 0) then
2563       Dest.Green := Source.Green;
2564     if (Source.PixelDesc.BlueRange  > 0) then
2565       Dest.Blue  := Source.Blue;
2566     if (Source.PixelDesc.AlphaRange > 0) then
2567       Dest.Alpha := Source.Alpha;
2568   end;
2569 end;
2570
2571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
2573 begin
2574   with aFuncRec do begin
2575     if (Source.PixelDesc.RedRange   > 0) then
2576       Dest.Red   := Round(Dest.PixelDesc.RedRange   * Source.Red   / Source.PixelDesc.RedRange);
2577     if (Source.PixelDesc.GreenRange > 0) then
2578       Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange);
2579     if (Source.PixelDesc.BlueRange  > 0) then
2580       Dest.Blue  := Round(Dest.PixelDesc.BlueRange  * Source.Blue  / Source.PixelDesc.BlueRange);
2581     if (Source.PixelDesc.AlphaRange > 0) then
2582       Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange);
2583   end;
2584 end;
2585
2586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
2588 begin
2589   with aFuncRec do
2590     with PglBitmapPixelDesc(Args)^ do begin
2591       if (Source.PixelDesc.RedRange   > 0) then
2592         Dest.Red   := Source.Red   shr RedShift;
2593       if (Source.PixelDesc.GreenRange > 0) then
2594         Dest.Green := Source.Green shr GreenShift;
2595       if (Source.PixelDesc.BlueRange  > 0) then
2596         Dest.Blue  := Source.Blue  shr BlueShift;
2597       if (Source.PixelDesc.AlphaRange > 0) then
2598         Dest.Alpha := Source.Alpha shr AlphaShift;
2599     end;
2600 end;
2601
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
2604 begin
2605   with aFuncRec do begin
2606     Dest.Red   := Source.Red;
2607     Dest.Green := Source.Green;
2608     Dest.Blue  := Source.Blue;
2609     Dest.Alpha := Source.Alpha;
2610     if (Args and $1 > 0) then begin
2611       Dest.Red   := Dest.Red   xor Dest.PixelDesc.RedRange;
2612       Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange;
2613       Dest.Blue  := Dest.Blue  xor Dest.PixelDesc.BlueRange;
2614     end;
2615     if (Args and $2 > 0) then begin
2616       Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange;
2617     end;
2618   end;
2619 end;
2620
2621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
2623 type
2624   PglBitmapPixelData = ^TglBitmapPixelData;
2625 begin
2626   with aFuncRec do begin
2627     Dest.Red   := PglBitmapPixelData(Args)^.Red;
2628     Dest.Green := PglBitmapPixelData(Args)^.Green;
2629     Dest.Blue  := PglBitmapPixelData(Args)^.Blue;
2630     Dest.Alpha := PglBitmapPixelData(Args)^.Alpha;
2631   end;
2632 end;
2633
2634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2635 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
2636 var
2637   Temp: Single;
2638 begin
2639   with FuncRec do begin
2640     if (FuncRec.Args = 0) then begin //source has no alpha
2641       Temp :=
2642         Source.Red   / Source.PixelDesc.RedRange   * ALPHA_WEIGHT_R +
2643         Source.Green / Source.PixelDesc.GreenRange * ALPHA_WEIGHT_G +
2644         Source.Blue  / Source.PixelDesc.BlueRange  * ALPHA_WEIGHT_B;
2645       Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Temp);
2646     end else
2647       Dest.Alpha := Round(Source.Alpha / Source.PixelDesc.AlphaRange * Dest.PixelDesc.AlphaRange);
2648   end;
2649 end;
2650
2651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2652 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
2653 type
2654   PglBitmapPixelData = ^TglBitmapPixelData;
2655 begin
2656   with FuncRec do begin
2657     Dest.Red   := Source.Red;
2658     Dest.Green := Source.Green;
2659     Dest.Blue  := Source.Blue;
2660
2661     with PglBitmapPixelData(Args)^ do
2662       if ((Dest.Red   <= Red  ) and (Dest.Red   >= PixelDesc.RedRange  ) and
2663           (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and
2664           (Dest.Blue  <= Blue ) and (Dest.Blue  >= PixelDesc.BlueRange )) then
2665         Dest.Alpha := 0
2666       else
2667         Dest.Alpha := Dest.PixelDesc.AlphaRange;
2668   end;
2669 end;
2670
2671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2672 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
2673 type
2674   PglBitmapPixelData = ^TglBitmapPixelData;
2675 begin
2676   with FuncRec do begin
2677     Dest.Red   := Source.Red;
2678     Dest.Green := Source.Green;
2679     Dest.Blue  := Source.Blue;
2680     with PglBitmapPixelData(Args)^ do
2681       Dest.Alpha := Alpha;
2682   end;
2683 end;
2684
2685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
2687 type
2688   PRGBPix = ^TRGBPix;
2689   TRGBPix = array [0..2] of byte;
2690 var
2691   Temp: Byte;
2692 begin
2693   while aWidth > 0 do begin
2694     Temp := PRGBPix(aData)^[0];
2695     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
2696     PRGBPix(aData)^[2] := Temp;
2697
2698     if aHasAlpha then
2699       Inc(aData, 4)
2700     else
2701       Inc(aData, 3);
2702     dec(aWidth);
2703   end;
2704 end;
2705
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2709 {$REGION Getter}
2710 function TglBitmap.GetWidth: Integer;
2711 begin
2712   if (ffX in fDimension.Fields) then
2713     result := fDimension.X
2714   else
2715     result := -1;
2716 end;
2717
2718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2719 function TglBitmap.GetHeight: Integer;
2720 begin
2721   if (ffY in fDimension.Fields) then
2722     result := fDimension.Y
2723   else
2724     result := -1;
2725 end;
2726
2727 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2728 function TglBitmap.GetFileWidth: Integer;
2729 begin
2730   result := Max(1, Width);
2731 end;
2732
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 function TglBitmap.GetFileHeight: Integer;
2735 begin
2736   result := Max(1, Height);
2737 end;
2738 {$ENDREGION}
2739
2740 {$REGION Setter}
2741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2742 procedure TglBitmap.SetCustomData(const aValue: Pointer);
2743 begin
2744   if fCustomData = aValue then
2745     exit;
2746   fCustomData := aValue;
2747 end;
2748
2749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2750 procedure TglBitmap.SetCustomName(const aValue: String);
2751 begin
2752   if fCustomName = aValue then
2753     exit;
2754   fCustomName := aValue;
2755 end;
2756
2757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
2759 begin
2760   if fCustomNameW = aValue then
2761     exit;
2762   fCustomNameW := aValue;
2763 end;
2764
2765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2766 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
2767 begin
2768   if fDeleteTextureOnFree = aValue then
2769     exit;
2770   fDeleteTextureOnFree := aValue;
2771 end;
2772
2773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2774 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
2775 begin
2776   if fFormat = aValue then
2777     exit;
2778   if (FORMAT_DESCRIPTORS[Format].GetSize <> FORMAT_DESCRIPTORS[aValue].GetSize) then
2779     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
2780   SetDataPointer(Data, aValue, Width, Height);
2781 end;
2782
2783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2784 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
2785 begin
2786   if fFreeDataAfterGenTexture = aValue then
2787     exit;
2788   fFreeDataAfterGenTexture := aValue;
2789 end;
2790
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 procedure TglBitmap.SetID(const aValue: Cardinal);
2793 begin
2794   if fID = aValue then
2795     exit;
2796   fID := aValue;
2797 end;
2798
2799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
2801 begin
2802   if fMipMap = aValue then
2803     exit;
2804   fMipMap := aValue;
2805 end;
2806
2807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2808 procedure TglBitmap.SetTarget(const aValue: Cardinal);
2809 begin
2810   if fTarget = aValue then
2811     exit;
2812   fTarget := aValue;
2813 end;
2814
2815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
2817 var
2818   MaxAnisotropic: Integer;
2819 begin
2820   fAnisotropic := aValue;
2821   if (ID > 0) then begin
2822     if GL_EXT_texture_filter_anisotropic then begin
2823       if fAnisotropic > 0 then begin
2824         Bind(false);
2825         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
2826         if aValue > MaxAnisotropic then
2827           fAnisotropic := MaxAnisotropic;
2828         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
2829       end;
2830     end else begin
2831       fAnisotropic := 0;
2832     end;
2833   end;
2834 end;
2835 {$ENDREGION}
2836
2837 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2838 procedure TglBitmap.CreateID;
2839 begin
2840   if (ID <> 0) then
2841     glDeleteTextures(1, @fID);
2842   glGenTextures(1, @fID);
2843   Bind(false);
2844 end;
2845
2846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2847 procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
2848 begin
2849   // Set Up Parameters
2850   SetWrap(fWrapS, fWrapT, fWrapR);
2851   SetFilter(fFilterMin, fFilterMag);
2852   SetAnisotropic(fAnisotropic);
2853   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
2854
2855   // Mip Maps Generation Mode
2856   aBuildWithGlu := false;
2857   if (MipMap = mmMipmap) then begin
2858     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
2859       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
2860     else
2861       aBuildWithGlu := true;
2862   end else if (MipMap = mmMipmapGlu) then
2863     aBuildWithGlu := true;
2864 end;
2865
2866 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2867 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
2868   const aWidth: Integer; const aHeight: Integer);
2869 var
2870   s: Single;
2871 begin
2872   if (Data <> aData) then begin
2873     if (Assigned(Data)) then
2874       FreeMem(Data);
2875     fData := aData;
2876   end;
2877
2878   FillChar(fDimension, SizeOf(fDimension), 0);
2879   if not Assigned(fData) then begin
2880     fFormat    := tfEmpty;
2881     fPixelSize := 0;
2882     fRowSize   := 0;
2883   end else begin
2884     if aWidth <> -1 then begin
2885       fDimension.Fields := fDimension.Fields + [ffX];
2886       fDimension.X := aWidth;
2887     end;
2888
2889     if aHeight <> -1 then begin
2890       fDimension.Fields := fDimension.Fields + [ffY];
2891       fDimension.Y := aHeight;
2892     end;
2893
2894     s := FORMAT_DESCRIPTORS[aFormat].GetSize;
2895     fFormat    := aFormat;
2896     fPixelSize := Ceil(s);
2897     fRowSize   := Ceil(s * aWidth);
2898   end;
2899 end;
2900
2901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2902 function TglBitmap.FlipHorz: Boolean;
2903 begin
2904   result := false;
2905 end;
2906
2907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2908 function TglBitmap.FlipVert: Boolean;
2909 begin
2910   result := false;
2911 end;
2912
2913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2916 procedure TglBitmap.AfterConstruction;
2917 begin
2918   inherited AfterConstruction;
2919
2920   fID         := 0;
2921   fTarget     := 0;
2922   fIsResident := false;
2923
2924   fFormat                  := glBitmapGetDefaultFormat;
2925   fMipMap                  := glBitmapDefaultMipmap;
2926   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
2927   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
2928
2929   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
2930   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
2931 end;
2932
2933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2934 procedure TglBitmap.BeforeDestruction;
2935 begin
2936   SetDataPointer(nil, tfEmpty);
2937   if (fID > 0) and fDeleteTextureOnFree then
2938     glDeleteTextures(1, @fID);
2939   inherited BeforeDestruction;
2940 end;
2941
2942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2943 procedure TglBitmap.LoadFromFile(const aFilename: String);
2944 var
2945   fs: TFileStream;
2946 begin
2947   fFilename := aFilename;
2948   fs := TFileStream.Create(fFilename, fmOpenRead);
2949   try
2950     fs.Position := 0;
2951     LoadFromStream(fs);
2952   finally
2953     fs.Free;
2954   end;
2955 end;
2956
2957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 procedure TglBitmap.LoadFromStream(const aStream: TStream);
2959 begin
2960   {$IFDEF GLB_SUPPORT_PNG_READ}
2961   if not LoadPNG(aStream) then
2962   {$ENDIF}
2963   {$IFDEF GLB_SUPPORT_JPEG_READ}
2964   if not LoadJPEG(aStream) then
2965   {$ENDIF}
2966   if not LoadDDS(aStream) then
2967   if not LoadTGA(aStream) then
2968   if not LoadBMP(aStream) then
2969     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
2970 end;
2971
2972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2973 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
2974   const aFormat: TglBitmapFormat; const aArgs: PtrInt);
2975 var
2976   tmpData: PByte;
2977   size: Integer;
2978 begin
2979   size := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize);
2980   GetMem(tmpData, size);
2981   try
2982     FillChar(tmpData^, size, #$FF);
2983     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
2984   except
2985     FreeMem(tmpData);
2986     raise;
2987   end;
2988   AddFunc(Self, aFunc, false, Format, aArgs);
2989 end;
2990
2991 {$IFDEF GLB_DELPHI}
2992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2993 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
2994 var
2995   rs: TResourceStream;
2996   TempPos: Integer;
2997   ResTypeStr: String;
2998   TempResType: PChar;
2999 begin
3000   if not Assigned(ResType) then begin
3001     TempPos     := Pos('.', Resource);
3002     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
3003     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
3004     TempResType := PChar(ResTypeStr);
3005   end else
3006     TempResType := ResType
3007
3008   rs := TResourceStream.Create(Instance, Resource, TempResType);
3009   try
3010     LoadFromStream(rs);
3011   finally
3012     rs.Free;
3013   end;
3014 end;
3015
3016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3017 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
3018 var
3019   rs: TResourceStream;
3020 begin
3021   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
3022   try
3023     LoadFromStream(rs);
3024   finally
3025     rs.Free;
3026   end;
3027 end;
3028 {$ENDIF}
3029
3030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3031 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
3032 var
3033   fs: TFileStream;
3034 begin
3035   fs := TFileStream.Create(aFileName, fmCreate);
3036   try
3037     fs.Position := 0;
3038     SaveToStream(fs, aFileType);
3039   finally
3040     fs.Free;
3041   end;
3042 end;
3043
3044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3045 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
3046 begin
3047   case aFileType of
3048     {$IFDEF GLB_SUPPORT_PNG_WRITE}
3049     ftPNG:  SavePng(aStream);
3050     {$ENDIF}
3051     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
3052     ftJPEG: SaveJPEG(aStream);
3053     {$ENDIF}
3054     ftDDS:  SaveDDS(aStream);
3055     ftTGA:  SaveTGA(aStream);
3056     ftBMP:  SaveBMP(aStream);
3057   end;
3058 end;
3059
3060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3061 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
3062 begin
3063   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
3064 end;
3065
3066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3067 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
3068   const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
3069 var
3070   DestData, TmpData, SourceData: pByte;
3071   TempHeight, TempWidth: Integer;
3072   SourceFD, DestFD: TglBitmapFormatDescClass;
3073
3074   FuncRec: TglBitmapFunctionRec;
3075 begin
3076   Assert(Assigned(Data));
3077   Assert(Assigned(aSource));
3078   Assert(Assigned(aSource.Data));
3079
3080   result := false;
3081   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
3082     SourceFD := FORMAT_DESCRIPTORS[aSource.Format];
3083     DestFD   := FORMAT_DESCRIPTORS[aFormat];
3084
3085     // inkompatible Formats so CreateTemp
3086     if (SourceFD.GetSize <> DestFD.GetSize) then
3087       aCreateTemp := true;
3088
3089     // Values
3090     TempHeight := Max(1, aSource.Height);
3091     TempWidth  := Max(1, aSource.Width);
3092
3093     FuncRec.Sender := Self;
3094     FuncRec.Args   := aArgs;
3095
3096     TmpData := nil;
3097     if aCreateTemp then begin
3098       GetMem(TmpData, Ceil(FORMAT_DESCRIPTORS[aFormat].GetSize * TempHeight * TempWidth));
3099       DestData := TmpData;
3100     end else
3101       DestData := Data;
3102
3103     try
3104       SourceFD.PreparePixel(FuncRec.Source);
3105       DestFD.PreparePixel  (FuncRec.Dest);
3106
3107       FuncRec.Size            := aSource.Dimension;
3108       FuncRec.Position.Fields := FuncRec.Size.Fields;
3109
3110       if {FormatIsUncompressed(Source.InternalFormat)} true then begin
3111         SourceData := aSource.Data;
3112         FuncRec.Position.Y := 0;
3113         while FuncRec.Position.Y < TempHeight do begin
3114           FuncRec.Position.X := 0;
3115           while FuncRec.Position.X < TempWidth do begin
3116             SourceFD.Unmap(SourceData, FuncRec.Source);
3117             aFunc(FuncRec);
3118             DestFD.Map(FuncRec.Dest, DestData);
3119             inc(FuncRec.Position.X);
3120           end;
3121           inc(FuncRec.Position.Y);
3122         end;
3123       end else begin
3124         (* TODO
3125         // Compressed Images
3126         FuncRec.Position.Y := 0;
3127         while FuncRec.Position.Y < TempHeight do begin
3128           FuncRec.Position.X := 0;
3129           while FuncRec.Position.X < TempWidth do begin
3130             // Get Data
3131             fGetPixelFunc(FuncRec.Position, FuncRec.Source);
3132             // Func
3133             Func(FuncRec);
3134             // Set Data
3135             MapFunc(FuncRec.Dest, dest);
3136             Inc(FuncRec.Position.X);
3137           end;
3138           Inc(FuncRec.Position.Y);
3139         end;
3140         *)
3141       end;
3142
3143       // Updating Image or InternalFormat
3144       if aCreateTemp then
3145         SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
3146       else if (aFormat <> fFormat) then
3147         Format := aFormat;
3148
3149       result := true;
3150     except
3151       if aCreateTemp then
3152         FreeMem(TmpData);
3153       raise;
3154     end;
3155   end;
3156 end;
3157
3158 {$IFDEF GLB_SDL}
3159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3160 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
3161 var
3162   Row, RowSize: Integer;
3163   SourceData, TmpData: PByte;
3164   TempDepth: Integer;
3165   Pix: TglBitmapPixelData;
3166   FormatDesc: TglBitmapFormatDescriptor;
3167
3168   function GetRowPointer(Row: Integer): pByte;
3169   begin
3170     result := Surface.pixels;
3171     Inc(result, Row * RowSize);
3172   end;
3173
3174 begin
3175   result := false;
3176
3177   (* TODO
3178   if not FormatIsUncompressed(InternalFormat) then
3179     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
3180   *)
3181
3182   FormatDesc := FORMAT_DESCRIPTORS[Format];
3183   if Assigned(Data) then begin
3184     case Trunc(FormatDesc.GetSize) of
3185       1: TempDepth :=  8;
3186       2: TempDepth := 16;
3187       3: TempDepth := 24;
3188       4: TempDepth := 32;
3189     else
3190       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
3191     end;
3192     FormatDesc.PreparePixel(Pix);
3193     with Pix.PixelDesc do
3194       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
3195         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
3196
3197     SourceData := Data;
3198     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);
3199
3200     for Row := 0 to FileHeight -1 do begin
3201       TmpData := GetRowPointer(Row);
3202       if Assigned(TmpData) then begin
3203         Move(SourceData^, TmpData^, RowSize);
3204         inc(SourceData, RowSize);
3205       end;
3206     end;
3207     result := true;
3208   end;
3209 end;
3210
3211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3212 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
3213 var
3214   pSource, pData, pTempData: PByte;
3215   Row, RowSize, TempWidth, TempHeight: Integer;
3216   IntFormat, f: TglBitmapInternalFormat;
3217   FormatDesc: TglBitmapFormatDescriptor;
3218
3219   function GetRowPointer(Row: Integer): pByte;
3220   begin
3221     result := Surface^.pixels;
3222     Inc(result, Row * RowSize);
3223   end;
3224
3225 begin
3226   result := false;
3227   if (Assigned(Surface)) then begin
3228     with Surface^.format^ do begin
3229       IntFormat := tfEmpty;
3230       for f := Low(f) to High(f) do begin
3231         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
3232           IntFormat := f;
3233           break;
3234         end;
3235       end;
3236       if (IntFormat = tfEmpty) then
3237         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
3238     end;
3239
3240     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
3241     TempWidth  := Surface^.w;
3242     TempHeight := Surface^.h;
3243     RowSize := Trunc(TempWidth * FormatDesc.GetSize);
3244     GetMem(pData, TempHeight * RowSize);
3245     try
3246       pTempData := pData;
3247       for Row := 0 to TempHeight -1 do begin
3248         pSource := GetRowPointer(Row);
3249         if (Assigned(pSource)) then begin
3250           Move(pSource^, pTempData^, RowSize);
3251           Inc(pTempData, RowSize);
3252         end;
3253       end;
3254       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
3255       result := true;
3256     except
3257       FreeMem(pData);
3258       raise;
3259     end;
3260   end;
3261 end;
3262
3263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3264 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
3265 var
3266   Row, Col, AlphaInterleave: Integer;
3267   pSource, pDest: PByte;
3268
3269   function GetRowPointer(Row: Integer): pByte;
3270   begin
3271     result := aSurface.pixels;
3272     Inc(result, Row * Width);
3273   end;
3274
3275 begin
3276   result := false;
3277   if Assigned(Data) then begin
3278     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
3279       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
3280
3281       AlphaInterleave := 0;
3282       case Format of
3283         ifLuminance8Alpha8:
3284           AlphaInterleave := 1;
3285         ifBGRA8, ifRGBA8:
3286           AlphaInterleave := 3;
3287       end;
3288
3289       pSource := Data;
3290       for Row := 0 to Height -1 do begin
3291         pDest := GetRowPointer(Row);
3292         if Assigned(pDest) then begin
3293           for Col := 0 to Width -1 do begin
3294             Inc(pSource, AlphaInterleave);
3295             pDest^ := pSource^;
3296             Inc(pDest);
3297             Inc(pSource);
3298           end;
3299         end;
3300       end;
3301       result := true;
3302     end;
3303   end;
3304 end;
3305
3306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3307 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3308 var
3309   bmp: TglBitmap2D;
3310 begin
3311   bmp := TglBitmap2D.Create;
3312   try
3313     bmp.AssignFromSurface(Surface);
3314     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
3315   finally
3316     bmp.Free;
3317   end;
3318 end;
3319 {$ENDIF}
3320
3321 {$IFDEF GLB_DELPHI}
3322 //TODO rework & test
3323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3324 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
3325 var
3326   Row: Integer;
3327   pSource, pData: PByte;
3328 begin
3329   result := false;
3330   if Assigned(Data) then begin
3331     if Assigned(aBitmap) then begin
3332       aBitmap.Width  := Width;
3333       aBitmap.Height := Height;
3334
3335       case Format of
3336         tfAlpha8, ifLuminance, ifDepth8:
3337           begin
3338             Bitmap.PixelFormat := pf8bit;
3339             Bitmap.Palette := CreateGrayPalette;
3340           end;
3341         ifRGB5A1:
3342           Bitmap.PixelFormat := pf15bit;
3343         ifR5G6B5:
3344           Bitmap.PixelFormat := pf16bit;
3345         ifRGB8, ifBGR8:
3346           Bitmap.PixelFormat := pf24bit;
3347         ifRGBA8, ifBGRA8:
3348           Bitmap.PixelFormat := pf32bit;
3349         else
3350           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
3351       end;
3352
3353       pSource := Data;
3354       for Row := 0 to FileHeight -1 do begin
3355         pData := Bitmap.Scanline[Row];
3356
3357         Move(pSource^, pData^, fRowSize);
3358         Inc(pSource, fRowSize);
3359
3360         // swap RGB(A) to BGR(A)
3361         if InternalFormat in [ifRGB8, ifRGBA8] then
3362           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
3363       end;
3364
3365       result := true;
3366     end;
3367   end;
3368 end;
3369
3370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3371 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
3372 var
3373   pSource, pData, pTempData: PByte;
3374   Row, RowSize, TempWidth, TempHeight: Integer;
3375   IntFormat: TglBitmapInternalFormat;
3376 begin
3377   result := false;
3378
3379   if (Assigned(Bitmap)) then begin
3380     case Bitmap.PixelFormat of
3381       pf8bit:
3382         IntFormat := ifLuminance;
3383       pf15bit:
3384         IntFormat := ifRGB5A1;
3385       pf16bit:
3386         IntFormat := ifR5G6B5;
3387       pf24bit:
3388         IntFormat := ifBGR8;
3389       pf32bit:
3390         IntFormat := ifBGRA8;
3391       else
3392         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
3393     end;
3394
3395     TempWidth := Bitmap.Width;
3396     TempHeight := Bitmap.Height;
3397
3398     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
3399
3400     GetMem(pData, TempHeight * RowSize);
3401     try
3402       pTempData := pData;
3403
3404       for Row := 0 to TempHeight -1 do begin
3405         pSource := Bitmap.Scanline[Row];
3406
3407         if (Assigned(pSource)) then begin
3408           Move(pSource^, pTempData^, RowSize);
3409           Inc(pTempData, RowSize);
3410         end;
3411       end;
3412
3413       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
3414
3415       result := true;
3416     except
3417       FreeMem(pData);
3418       raise;
3419     end;
3420   end;
3421 end;
3422
3423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3424 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
3425 var
3426   Row, Col, AlphaInterleave: Integer;
3427   pSource, pDest: PByte;
3428 begin
3429   result := false;
3430
3431   if Assigned(Data) then begin
3432     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
3433       if Assigned(Bitmap) then begin
3434         Bitmap.PixelFormat := pf8bit;
3435         Bitmap.Palette := CreateGrayPalette;
3436         Bitmap.Width := Width;
3437         Bitmap.Height := Height;
3438
3439         case InternalFormat of
3440           ifLuminanceAlpha:
3441             AlphaInterleave := 1;
3442           ifRGBA8, ifBGRA8:
3443             AlphaInterleave := 3;
3444           else
3445             AlphaInterleave := 0;
3446         end;
3447
3448         // Copy Data
3449         pSource := Data;
3450
3451         for Row := 0 to Height -1 do begin
3452           pDest := Bitmap.Scanline[Row];
3453
3454           if Assigned(pDest) then begin
3455             for Col := 0 to Width -1 do begin
3456               Inc(pSource, AlphaInterleave);
3457               pDest^ := pSource^;
3458               Inc(pDest);
3459               Inc(pSource);
3460             end;
3461           end;
3462         end;
3463
3464         result := true;
3465       end;
3466     end;
3467   end;
3468 end;
3469
3470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3471 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3472 var
3473   tex: TglBitmap2D;
3474 begin
3475   tex := TglBitmap2D.Create;
3476   try
3477     tex.AssignFromBitmap(Bitmap);
3478     result := AddAlphaFromglBitmap(tex, Func, CustomData);
3479   finally
3480     tex.Free;
3481   end;
3482 end;
3483
3484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3485 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
3486   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3487 var
3488   RS: TResourceStream;
3489   TempPos: Integer;
3490   ResTypeStr: String;
3491   TempResType: PChar;
3492 begin
3493   if Assigned(ResType) then
3494     TempResType := ResType
3495   else
3496     begin
3497       TempPos := Pos('.', Resource);
3498       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
3499       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
3500       TempResType := PChar(ResTypeStr);
3501     end;
3502
3503   RS := TResourceStream.Create(Instance, Resource, TempResType);
3504   try
3505     result := AddAlphaFromStream(RS, Func, CustomData);
3506   finally
3507     RS.Free;
3508   end;
3509 end;
3510
3511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3512 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
3513   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3514 var
3515   RS: TResourceStream;
3516 begin
3517   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
3518   try
3519     result := AddAlphaFromStream(RS, Func, CustomData);
3520   finally
3521     RS.Free;
3522   end;
3523 end;
3524 {$ENDIF}
3525
3526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3527 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3528 begin
3529   (* TODO
3530   if not FormatIsUncompressed(InternalFormat) then
3531     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
3532   *)
3533   result := AddFunc(Self, aFunc, false, FORMAT_DESCRIPTORS[Format].WithAlpha, aArgs);
3534 end;
3535
3536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3537 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3538 var
3539   FS: TFileStream;
3540 begin
3541   FS := TFileStream.Create(FileName, fmOpenRead);
3542   try
3543     result := AddAlphaFromStream(FS, aFunc, aArgs);
3544   finally
3545     FS.Free;
3546   end;
3547 end;
3548
3549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3550 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3551 var
3552   tex: TglBitmap2D;
3553 begin
3554   tex := TglBitmap2D.Create(aStream);
3555   try
3556     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
3557   finally
3558     tex.Free;
3559   end;
3560 end;
3561
3562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3563 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
3564 var
3565   DestData, DestData2, SourceData: pByte;
3566   TempHeight, TempWidth: Integer;
3567   SourceFD, DestFD: TglBitmapFormatDescClass;
3568
3569   FuncRec: TglBitmapFunctionRec;
3570 begin
3571   result := false;
3572
3573   Assert(Assigned(Data));
3574   Assert(Assigned(aBitmap));
3575   Assert(Assigned(aBitmap.Data));
3576
3577   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
3578     result := ConvertTo(FORMAT_DESCRIPTORS[Format].WithAlpha);
3579     if not Assigned(aFunc) then
3580       aFunc := glBitmapAlphaFunc;
3581
3582     SourceFD := FORMAT_DESCRIPTORS[aBitmap.Format];
3583     DestFD   := FORMAT_DESCRIPTORS[Format];
3584
3585     // Values
3586     TempHeight := aBitmap.FileHeight;
3587     TempWidth  := aBitmap.FileWidth;
3588
3589     FuncRec.Sender          := Self;
3590     FuncRec.Args            := aArgs;
3591     FuncRec.Size            := Dimension;
3592     FuncRec.Position.Fields := FuncRec.Size.Fields;
3593     FuncRec.Args            := PtrInt(SourceFD.HasAlpha) and 1;
3594
3595     DestData   := Data;
3596     DestData2  := Data;
3597     SourceData := aBitmap.Data;
3598
3599     // Mapping
3600     SourceFD.PreparePixel(FuncRec.Source);
3601     DestFD.PreparePixel  (FuncRec.Dest);
3602
3603     FuncRec.Position.Y := 0;
3604     while FuncRec.Position.Y < TempHeight do begin
3605       FuncRec.Position.X := 0;
3606       while FuncRec.Position.X < TempWidth do begin
3607         SourceFD.Unmap(SourceData, FuncRec.Source);
3608         DestFD.Unmap  (DestData,   FuncRec.Dest);
3609         aFunc(FuncRec);
3610         DestFD.Map(FuncRec.Dest, DestData2);
3611         inc(FuncRec.Position.X);
3612       end;
3613       inc(FuncRec.Position.Y);
3614     end;
3615   end;
3616 end;
3617
3618
3619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3620 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
3621 begin
3622   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
3623 end;
3624
3625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3626 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
3627 var
3628   PixelData: TglBitmapPixelData;
3629 begin
3630   FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
3631   result := AddAlphaFromColorKeyFloat(
3632     aRed   / PixelData.PixelDesc.RedRange,
3633     aGreen / PixelData.PixelDesc.GreenRange,
3634     aBlue  / PixelData.PixelDesc.BlueRange,
3635     aDeviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange)));
3636 end;
3637
3638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3639 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
3640 var
3641   TempR, TempG, TempB: Cardinal;
3642   PixelData: TglBitmapPixelData;
3643 begin
3644   FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
3645   with PixelData.PixelDesc do begin
3646     TempR := Trunc(RedRange   * aDeviation);
3647     TempG := Trunc(GreenRange * aDeviation);
3648     TempB := Trunc(BlueRange  * aDeviation);
3649
3650     PixelData.Red   := Min(RedRange,   Trunc(RedRange   * aRed)   + TempR);
3651     RedRange        := Max(0,          Trunc(RedRange   * aRed)   - TempR);
3652     PixelData.Green := Min(GreenRange, Trunc(GreenRange * aGreen) + TempG);
3653     GreenRange      := Max(0,          Trunc(GreenRange * aGreen) - TempG);
3654     PixelData.Blue  := Min(BlueRange,  Trunc(BlueRange  * aBlue)  + TempB);
3655     BlueRange       := Max(0,          Trunc(BlueRange  * aBlue)  - TempB);
3656     PixelData.Alpha := 0;
3657     AlphaRange      := 0;
3658   end;
3659   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
3660 end;
3661
3662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3663 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
3664 begin
3665   result := AddAlphaFromValueFloat(aAlpha / $FF);
3666 end;
3667
3668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3669 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
3670 var
3671   PixelData: TglBitmapPixelData;
3672 begin
3673   FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
3674   result := AddAlphaFromValueFloat(aAlpha / PixelData.PixelDesc.AlphaRange);
3675 end;
3676
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
3679 var
3680   PixelData: TglBitmapPixelData;
3681 begin
3682   FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
3683   with PixelData.PixelDesc do
3684     PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * aAlpha)));
3685   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData));
3686 end;
3687
3688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3689 function TglBitmap.RemoveAlpha: Boolean;
3690 var
3691   FormatDesc: TglBitmapFormatDescClass;
3692 begin
3693   result := false;
3694   FormatDesc := FORMAT_DESCRIPTORS[Format];
3695   if Assigned(Data) then begin
3696     if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
3697       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
3698     result := ConvertTo(FormatDesc.WithoutAlpha);
3699   end;
3700 end;
3701
3702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3703 function TglBitmap.Clone: TglBitmap;
3704 var
3705   Temp: TglBitmap;
3706   TempPtr: PByte;
3707   Size: Integer;
3708 begin
3709   result := nil;
3710   Temp := (ClassType.Create as TglBitmap);
3711   try
3712     // copy texture data if assigned
3713     if Assigned(Data) then begin
3714       Size := FORMAT_DESCRIPTORS[Format].GetSize(fDimension);
3715       GetMem(TempPtr, Size);
3716       try
3717         Move(Data^, TempPtr^, Size);
3718         Temp.SetDataPointer(TempPtr, Format, Width, Height);
3719       except
3720         FreeMem(TempPtr);
3721         raise;
3722       end;
3723     end else
3724       Temp.SetDataPointer(nil, Format, Width, Height);
3725
3726         // copy properties
3727     Temp.fID                      := ID;
3728     Temp.fTarget                  := Target;
3729     Temp.fFormat                  := Format;
3730     Temp.fMipMap                  := MipMap;
3731     Temp.fAnisotropic             := Anisotropic;
3732     Temp.fBorderColor             := fBorderColor;
3733     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
3734     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
3735     Temp.fFilterMin               := fFilterMin;
3736     Temp.fFilterMag               := fFilterMag;
3737     Temp.fWrapS                   := fWrapS;
3738     Temp.fWrapT                   := fWrapT;
3739     Temp.fWrapR                   := fWrapR;
3740     Temp.fFilename                := fFilename;
3741     Temp.fCustomName              := fCustomName;
3742     Temp.fCustomNameW             := fCustomNameW;
3743     Temp.fCustomData              := fCustomData;
3744
3745     result := Temp;
3746   except
3747     FreeAndNil(Temp);
3748     raise;
3749   end;
3750 end;
3751
3752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3753 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
3754 var
3755   SourceFD, DestFD: TglBitmapFormatDescClass;
3756   SourcePD, DestPD: TglBitmapPixelData;
3757   PixelDesc: TglBitmapPixelDesc;
3758
3759   function CanCopyDirect: Boolean;
3760   begin
3761     result :=
3762       ((SourcePD.PixelDesc.RedRange   = DestPD.PixelDesc.RedRange)   or (SourcePD.PixelDesc.RedRange   = 0) or (DestPD.PixelDesc.RedRange   = 0)) and
3763       ((SourcePD.PixelDesc.GreenRange = DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and
3764       ((SourcePD.PixelDesc.BlueRange  = DestPD.PixelDesc.BlueRange)  or (SourcePD.PixelDesc.BlueRange  = 0) or (DestPD.PixelDesc.BlueRange  = 0)) and
3765       ((SourcePD.PixelDesc.AlphaRange = DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0));
3766   end;
3767
3768   function CanShift: Boolean;
3769   begin
3770     result :=
3771       ((SourcePD.PixelDesc.RedRange   >= DestPD.PixelDesc.RedRange  ) or (SourcePD.PixelDesc.RedRange   = 0) or (DestPD.PixelDesc.RedRange   = 0)) and
3772       ((SourcePD.PixelDesc.GreenRange >= DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and
3773       ((SourcePD.PixelDesc.BlueRange  >= DestPD.PixelDesc.BlueRange ) or (SourcePD.PixelDesc.BlueRange  = 0) or (DestPD.PixelDesc.BlueRange  = 0)) and
3774       ((SourcePD.PixelDesc.AlphaRange >= DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0));
3775   end;
3776
3777   function GetShift(aSource, aDest: Cardinal) : ShortInt;
3778   begin
3779     result := 0;
3780     while (aSource > aDest) and (aSource > 0) do begin
3781       inc(result);
3782       aSource := aSource shr 1;
3783     end;
3784   end;
3785
3786 begin
3787   if aFormat <> fFormat then begin
3788     SourceFD := FORMAT_DESCRIPTORS[Format];
3789     DestFD   := FORMAT_DESCRIPTORS[aFormat];
3790
3791     SourceFD.PreparePixel(SourcePD);
3792     DestFD.PreparePixel  (DestPD);
3793
3794     if CanCopyDirect then
3795       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
3796     else if CanShift then begin
3797       PixelDesc.RedShift   := GetShift(SourcePD.PixelDesc.RedRange,   DestPD.PixelDesc.RedRange);
3798       PixelDesc.GreenShift := GetShift(SourcePD.PixelDesc.GreenRange, DestPD.PixelDesc.GreenRange);
3799       PixelDesc.BlueShift  := GetShift(SourcePD.PixelDesc.BlueRange,  DestPD.PixelDesc.BlueRange);
3800       PixelDesc.AlphaShift := GetShift(SourcePD.PixelDesc.AlphaRange, DestPD.PixelDesc.AlphaRange);
3801       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@PixelDesc));
3802     end else
3803       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
3804   end else
3805     result := true;
3806 end;
3807
3808 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3809 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
3810 begin
3811   if aUseRGB or aUseAlpha then
3812     AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
3813 end;
3814
3815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3816 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
3817 begin
3818   fBorderColor[0] := aRed;
3819   fBorderColor[1] := aGreen;
3820   fBorderColor[2] := aBlue;
3821   fBorderColor[3] := aAlpha;
3822   if (ID > 0) then begin
3823     Bind(false);
3824     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
3825   end;
3826 end;
3827
3828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3829 procedure TglBitmap.FreeData;
3830 begin
3831   SetDataPointer(nil, tfEmpty);
3832 end;
3833
3834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3835 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
3836   const aAlpha: Byte);
3837 begin
3838   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
3839 end;
3840
3841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3842 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
3843 var
3844   PixelData: TglBitmapPixelData;
3845 begin
3846   FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
3847   FillWithColorFloat(
3848     aRed   / PixelData.PixelDesc.RedRange,
3849     aGreen / PixelData.PixelDesc.GreenRange,
3850     aBlue  / PixelData.PixelDesc.BlueRange,
3851     aAlpha / PixelData.PixelDesc.AlphaRange);
3852 end;
3853
3854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3855 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
3856 var
3857   PixelData: TglBitmapPixelData;
3858 begin
3859   FORMAT_DESCRIPTORS[Format].PreparePixel(PixelData);
3860   PixelData.Red   := Max(0, Min(PixelData.PixelDesc.RedRange,   Trunc(PixelData.PixelDesc.RedRange   * aRed)));
3861   PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * aGreen)));
3862   PixelData.Blue  := Max(0, Min(PixelData.PixelDesc.BlueRange,  Trunc(PixelData.PixelDesc.BlueRange  * aBlue)));
3863   PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * aAlpha)));
3864   AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
3865 end;
3866
3867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3868 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
3869 begin
3870   //check MIN filter
3871   case aMin of
3872     GL_NEAREST:
3873       fFilterMin := GL_NEAREST;
3874     GL_LINEAR:
3875       fFilterMin := GL_LINEAR;
3876     GL_NEAREST_MIPMAP_NEAREST:
3877       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
3878     GL_LINEAR_MIPMAP_NEAREST:
3879       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
3880     GL_NEAREST_MIPMAP_LINEAR:
3881       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
3882     GL_LINEAR_MIPMAP_LINEAR:
3883       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
3884     else
3885       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
3886   end;
3887
3888   //check MAG filter
3889   case aMag of
3890     GL_NEAREST:
3891       fFilterMag := GL_NEAREST;
3892     GL_LINEAR:
3893       fFilterMag := GL_LINEAR;
3894     else
3895       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
3896   end;
3897
3898   //apply filter
3899   if (ID > 0) then begin
3900     Bind(false);
3901     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
3902
3903     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
3904       case fFilterMin of
3905         GL_NEAREST, GL_LINEAR:
3906           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3907         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
3908           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
3909         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
3910           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
3911       end;
3912     end else
3913       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3914   end;
3915 end;
3916
3917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3918 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
3919
3920   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
3921   begin
3922     case aValue of
3923       GL_CLAMP:
3924         aTarget := GL_CLAMP;
3925
3926       GL_REPEAT:
3927         aTarget := GL_REPEAT;
3928
3929       GL_CLAMP_TO_EDGE: begin
3930         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3931           aTarget := GL_CLAMP_TO_EDGE
3932         else
3933           aTarget := GL_CLAMP;
3934       end;
3935
3936       GL_CLAMP_TO_BORDER: begin
3937         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3938           aTarget := GL_CLAMP_TO_BORDER
3939         else
3940           aTarget := GL_CLAMP;
3941       end;
3942
3943       GL_MIRRORED_REPEAT: begin
3944         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3945           aTarget := GL_MIRRORED_REPEAT
3946         else
3947           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
3948       end;
3949     else
3950       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
3951     end;
3952   end;
3953
3954 begin
3955   CheckAndSetWrap(S, fWrapS);
3956   CheckAndSetWrap(T, fWrapT);
3957   CheckAndSetWrap(R, fWrapR);
3958
3959   if (ID > 0) then begin
3960     Bind(false);
3961     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
3962     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
3963     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
3964   end;
3965 end;
3966
3967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3968 procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
3969 begin
3970   { TODO delete?
3971   if Assigned (fGetPixelFunc) then
3972     fGetPixelFunc(aPos, aPixel);
3973     }
3974 end;
3975
3976 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3977 procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
3978 begin
3979   {TODO delete?
3980   if Assigned (fSetPixelFunc) then
3981     fSetPixelFuc(aPos, aPixel);
3982     }
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
3987 begin
3988   if aEnableTextureUnit then
3989     glEnable(Target);
3990   if (ID > 0) then
3991     glBindTexture(Target, ID);
3992 end;
3993
3994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3995 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
3996 begin
3997   if aDisableTextureUnit then
3998     glDisable(Target);
3999   glBindTexture(Target, 0);
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 constructor TglBitmap.Create;
4004 begin
4005 {$IFNDEF GLB_NO_NATIVE_GL}
4006   ReadOpenGLExtensions;
4007 {$ENDIF}
4008   if (ClassType = TglBitmap) then
4009     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
4010   inherited Create;
4011 end;
4012
4013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4014 constructor TglBitmap.Create(const aFileName: String);
4015 begin
4016   Create;
4017   LoadFromFile(FileName);
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 constructor TglBitmap.Create(const aStream: TStream);
4022 begin
4023   Create;
4024   LoadFromStream(aStream);
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
4029 var
4030   Image: PByte;
4031   ImageSize: Integer;
4032 begin
4033   Create;
4034   ImageSize := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize);
4035   GetMem(Image, ImageSize);
4036   try
4037     FillChar(Image^, ImageSize, #$FF);
4038     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
4039   except
4040     FreeMem(Image);
4041     raise;
4042   end;
4043 end;
4044
4045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4046 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
4047   const aFunc: TglBitmapFunction; const aArgs: PtrInt);
4048 begin
4049   Create;
4050   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
4051 end;
4052
4053 {$IFDEF GLB_DELPHI}
4054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4055 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
4056 begin
4057   Create;
4058   LoadFromResource(aInstance, aResource, aResType);
4059 end;
4060
4061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4062 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4063 begin
4064   Create;
4065   LoadFromResourceID(aInstance, aResourceID, aResType);
4066 end;
4067 {$ENDIF}
4068
4069 {$IFDEF GLB_SUPPORT_PNG_READ}
4070 {$IF DEFINED(GLB_SDL_IMAGE)}
4071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4072 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4074 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
4075 var
4076   Surface: PSDL_Surface;
4077   RWops: PSDL_RWops;
4078 begin
4079   result := false;
4080   RWops := glBitmapCreateRWops(aStream);
4081   try
4082     if IMG_isPNG(RWops) > 0 then begin
4083       Surface := IMG_LoadPNG_RW(RWops);
4084       try
4085         AssignFromSurface(Surface);
4086         Rresult := true;
4087       finally
4088         SDL_FreeSurface(Surface);
4089       end;
4090     end;
4091   finally
4092     SDL_FreeRW(RWops);
4093   end;
4094 end;
4095
4096 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4099 begin
4100   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4101 end;
4102
4103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4104 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
4105 var
4106   StreamPos: Int64;
4107   signature: array [0..7] of byte;
4108   png: png_structp;
4109   png_info: png_infop;
4110
4111   TempHeight, TempWidth: Integer;
4112   Format: TglBitmapInternalFormat;
4113
4114   png_data: pByte;
4115   png_rows: array of pByte;
4116   Row, LineSize: Integer;
4117 begin
4118   result := false;
4119
4120   if not init_libPNG then
4121     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4122
4123   try
4124     // signature
4125     StreamPos := Stream.Position;
4126     Stream.Read(signature, 8);
4127     Stream.Position := StreamPos;
4128
4129     if png_check_sig(@signature, 8) <> 0 then begin
4130       // png read struct
4131       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4132       if png = nil then
4133         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4134
4135       // png info
4136       png_info := png_create_info_struct(png);
4137       if png_info = nil then begin
4138         png_destroy_read_struct(@png, nil, nil);
4139         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4140       end;
4141
4142       // set read callback
4143       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
4144
4145       // read informations
4146       png_read_info(png, png_info);
4147
4148       // size
4149       TempHeight := png_get_image_height(png, png_info);
4150       TempWidth := png_get_image_width(png, png_info);
4151
4152       // format
4153       case png_get_color_type(png, png_info) of
4154         PNG_COLOR_TYPE_GRAY:
4155           Format := tfLuminance8;
4156         PNG_COLOR_TYPE_GRAY_ALPHA:
4157           Format := tfLuminance8Alpha8;
4158         PNG_COLOR_TYPE_RGB:
4159           Format := tfRGB8;
4160         PNG_COLOR_TYPE_RGB_ALPHA:
4161           Format := tfRGBA8;
4162         else
4163           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4164       end;
4165
4166       // cut upper 8 bit from 16 bit formats
4167       if png_get_bit_depth(png, png_info) > 8 then
4168         png_set_strip_16(png);
4169
4170       // expand bitdepth smaller than 8
4171       if png_get_bit_depth(png, png_info) < 8 then
4172         png_set_expand(png);
4173
4174       // allocating mem for scanlines
4175       LineSize := png_get_rowbytes(png, png_info);
4176       GetMem(png_data, TempHeight * LineSize);
4177       try
4178         SetLength(png_rows, TempHeight);
4179         for Row := Low(png_rows) to High(png_rows) do begin
4180           png_rows[Row] := png_data;
4181           Inc(png_rows[Row], Row * LineSize);
4182         end;
4183
4184         // read complete image into scanlines
4185         png_read_image(png, @png_rows[0]);
4186
4187         // read end
4188         png_read_end(png, png_info);
4189
4190         // destroy read struct
4191         png_destroy_read_struct(@png, @png_info, nil);
4192
4193         SetLength(png_rows, 0);
4194
4195         // set new data
4196         SetDataPointer(png_data, Format, TempWidth, TempHeight);
4197
4198         result := true;
4199       except
4200         FreeMem(png_data);
4201         raise;
4202       end;
4203     end;
4204   finally
4205     quit_libPNG;
4206   end;
4207 end;
4208
4209 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4211 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
4212 var
4213   StreamPos: Int64;
4214   Png: TPNGObject;
4215   Header: Array[0..7] of Byte;
4216   Row, Col, PixSize, LineSize: Integer;
4217   NewImage, pSource, pDest, pAlpha: pByte;
4218   Format: TglBitmapInternalFormat;
4219
4220 const
4221   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
4222
4223 begin
4224   result := false;
4225
4226   StreamPos := Stream.Position;
4227   Stream.Read(Header[0], SizeOf(Header));
4228   Stream.Position := StreamPos;
4229
4230   {Test if the header matches}
4231   if Header = PngHeader then begin
4232     Png := TPNGObject.Create;
4233     try
4234       Png.LoadFromStream(Stream);
4235
4236       case Png.Header.ColorType of
4237         COLOR_GRAYSCALE:
4238           Format := ifLuminance;
4239         COLOR_GRAYSCALEALPHA:
4240           Format := ifLuminanceAlpha;
4241         COLOR_RGB:
4242           Format := ifBGR8;
4243         COLOR_RGBALPHA:
4244           Format := ifBGRA8;
4245         else
4246           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4247       end;
4248
4249       PixSize := Trunc(FormatGetSize(Format));
4250       LineSize := Integer(Png.Header.Width) * PixSize;
4251
4252       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4253       try
4254         pDest := NewImage;
4255
4256         case Png.Header.ColorType of
4257           COLOR_RGB, COLOR_GRAYSCALE:
4258             begin
4259               for Row := 0 to Png.Height -1 do begin
4260                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4261                 Inc(pDest, LineSize);
4262               end;
4263             end;
4264           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4265             begin
4266               PixSize := PixSize -1;
4267
4268               for Row := 0 to Png.Height -1 do begin
4269                 pSource := Png.Scanline[Row];
4270                 pAlpha := pByte(Png.AlphaScanline[Row]);
4271
4272                 for Col := 0 to Png.Width -1 do begin
4273                   Move (pSource^, pDest^, PixSize);
4274                   Inc(pSource, PixSize);
4275                   Inc(pDest, PixSize);
4276
4277                   pDest^ := pAlpha^;
4278                   inc(pAlpha);
4279                   Inc(pDest);
4280                 end;
4281               end;
4282             end;
4283           else
4284             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4285         end;
4286
4287         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
4288
4289         result := true;
4290       except
4291         FreeMem(NewImage);
4292         raise;
4293       end;
4294     finally
4295       Png.Free;
4296     end;
4297   end;
4298 end;
4299 {$IFEND}
4300 {$ENDIF}
4301
4302 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4303 {$IFDEF GLB_LIB_PNG}
4304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4305 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4306 begin
4307   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4308 end;
4309 {$ENDIF}
4310
4311 {$IF DEFINED(GLB_LIB_PNG)}
4312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 procedure TglBitmap.SavePNG(const aStream: TStream);
4314 var
4315   png: png_structp;
4316   png_info: png_infop;
4317   png_rows: array of pByte;
4318   LineSize: Integer;
4319   ColorType: Integer;
4320   Row: Integer;
4321 begin
4322   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4323     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4324
4325   if not init_libPNG then
4326     raise Exception.Create('SavePNG - unable to initialize libPNG.');
4327
4328   try
4329     case FInternalFormat of
4330       ifAlpha, ifLuminance, ifDepth8:
4331         ColorType := PNG_COLOR_TYPE_GRAY;
4332       ifLuminanceAlpha:
4333         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4334       ifBGR8, ifRGB8:
4335         ColorType := PNG_COLOR_TYPE_RGB;
4336       ifBGRA8, ifRGBA8:
4337         ColorType := PNG_COLOR_TYPE_RGBA;
4338       else
4339         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4340     end;
4341     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
4342
4343     // creating array for scanline
4344     SetLength(png_rows, Height);
4345     try
4346       for Row := 0 to Height - 1 do begin
4347         png_rows[Row] := Data;
4348         Inc(png_rows[Row], Row * LineSize)
4349       end;
4350
4351       // write struct
4352       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4353       if png = nil then
4354         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4355
4356       // create png info
4357       png_info := png_create_info_struct(png);
4358       if png_info = nil then begin
4359         png_destroy_write_struct(@png, nil);
4360         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4361       end;
4362
4363       // set read callback
4364       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
4365
4366       // set compression
4367       png_set_compression_level(png, 6);
4368
4369       if InternalFormat in [ifBGR8, ifBGRA8] then
4370         png_set_bgr(png);
4371
4372       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4373       png_write_info(png, png_info);
4374       png_write_image(png, @png_rows[0]);
4375       png_write_end(png, png_info);
4376       png_destroy_write_struct(@png, @png_info);
4377     finally
4378       SetLength(png_rows, 0);
4379     end;
4380   finally
4381     quit_libPNG;
4382   end;
4383 end;
4384
4385 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4387 procedure TglBitmap.SavePNG(const aStream: TStream);
4388 var
4389   Png: TPNGObject;
4390
4391   pSource, pDest: pByte;
4392   X, Y, PixSize: Integer;
4393   ColorType: Cardinal;
4394   Alpha: Boolean;
4395
4396   pTemp: pByte;
4397   Temp: Byte;
4398 begin
4399   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4400     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4401
4402   case FInternalFormat of
4403     ifAlpha, ifLuminance, ifDepth8: begin
4404       ColorType := COLOR_GRAYSCALE;
4405       PixSize := 1;
4406       Alpha := false;
4407     end;
4408     ifLuminanceAlpha: begin
4409       ColorType := COLOR_GRAYSCALEALPHA;
4410       PixSize := 1;
4411       Alpha := true;
4412     end;
4413     ifBGR8, ifRGB8: begin
4414       ColorType := COLOR_RGB;
4415       PixSize := 3;
4416       Alpha := false;
4417     end;
4418     ifBGRA8, ifRGBA8: begin
4419       ColorType := COLOR_RGBALPHA;
4420       PixSize := 3;
4421       Alpha := true
4422     end;
4423   else
4424     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4425   end;
4426
4427   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4428   try
4429     // Copy ImageData
4430     pSource := Data;
4431     for Y := 0 to Height -1 do begin
4432       pDest := png.ScanLine[Y];
4433       for X := 0 to Width -1 do begin
4434         Move(pSource^, pDest^, PixSize);
4435         Inc(pDest, PixSize);
4436         Inc(pSource, PixSize);
4437         if Alpha then begin
4438           png.AlphaScanline[Y]^[X] := pSource^;
4439           Inc(pSource);
4440         end;
4441       end;
4442
4443       // convert RGB line to BGR
4444       if InternalFormat in [ifRGB8, ifRGBA8] then begin
4445         pTemp := png.ScanLine[Y];
4446         for X := 0 to Width -1 do begin
4447           Temp := pByteArray(pTemp)^[0];
4448           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4449           pByteArray(pTemp)^[2] := Temp;
4450           Inc(pTemp, 3);
4451         end;
4452       end;
4453     end;
4454
4455     // Save to Stream
4456     Png.CompressionLevel := 6;
4457     Png.SaveToStream(Stream);
4458   finally
4459     FreeAndNil(Png);
4460   end;
4461 end;
4462 {$IFEND}
4463 {$ENDIF}
4464
4465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4466 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4468 {$IFDEF GLB_LIB_JPEG}
4469 type
4470   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4471   glBitmap_libJPEG_source_mgr = record
4472     pub: jpeg_source_mgr;
4473
4474     SrcStream: TStream;
4475     SrcBuffer: array [1..4096] of byte;
4476   end;
4477
4478   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4479   glBitmap_libJPEG_dest_mgr = record
4480     pub: jpeg_destination_mgr;
4481
4482     DestStream: TStream;
4483     DestBuffer: array [1..4096] of byte;
4484   end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 {
4488 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4489 var
4490   Msg: String;
4491 begin
4492   SetLength(Msg, 256);
4493   cinfo^.err^.format_message(cinfo, pChar(Msg));
4494   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
4495   cinfo^.global_state := 0;
4496   jpeg_abort(cinfo);
4497 end;
4498 }
4499
4500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4501 {
4502 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4503 var
4504   Msg: String;
4505 begin
4506   SetLength(Msg, 256);
4507   cinfo^.err^.format_message(cinfo, pChar(Msg));
4508   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
4509   cinfo^.global_state := 0;
4510 end;
4511 }
4512
4513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4514 {
4515 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4516 begin
4517 end;
4518 }
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4522 var
4523   src: glBitmap_libJPEG_source_mgr_ptr;
4524   bytes: integer;
4525 begin
4526   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4527
4528   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4529         if (bytes <= 0) then begin
4530                 src^.SrcBuffer[1] := $FF;
4531                 src^.SrcBuffer[2] := JPEG_EOI;
4532                 bytes := 2;
4533         end;
4534
4535         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4536         src^.pub.bytes_in_buffer := bytes;
4537
4538   result := true;
4539 end;
4540
4541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4542 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4543 var
4544   src: glBitmap_libJPEG_source_mgr_ptr;
4545 begin
4546   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4547
4548   if num_bytes > 0 then begin
4549     // wanted byte isn't in buffer so set stream position and read buffer
4550     if num_bytes > src^.pub.bytes_in_buffer then begin
4551       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
4552       src^.pub.fill_input_buffer(cinfo);
4553     end else begin
4554       // wanted byte is in buffer so only skip
4555                 inc(src^.pub.next_input_byte, num_bytes);
4556                 dec(src^.pub.bytes_in_buffer, num_bytes);
4557     end;
4558   end;
4559 end;
4560
4561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4562 {
4563 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4564 begin
4565 end;
4566 }
4567
4568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4569 {
4570 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4571 begin
4572 end;
4573 }
4574
4575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4576 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
4577 var
4578   dest: glBitmap_libJPEG_dest_mgr_ptr;
4579 begin
4580   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
4581
4582   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
4583     // write complete buffer
4584     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
4585
4586     // reset buffer
4587     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
4588     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
4589   end;
4590
4591   result := true;
4592 end;
4593
4594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4595 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
4596 var
4597   Idx: Integer;
4598   dest: glBitmap_libJPEG_dest_mgr_ptr;
4599 begin
4600   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
4601
4602   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
4603     // check for endblock
4604     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
4605       // write endblock
4606       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
4607
4608       // leave
4609       break;
4610     end else
4611       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
4612   end;
4613 end;
4614 {$ENDIF}
4615
4616 {$IFDEF GLB_SUPPORT_JPEG_READ}
4617 {$IF DEFINED(GLB_SDL_IMAGE)}
4618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4619 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
4620 var
4621   Surface: PSDL_Surface;
4622   RWops: PSDL_RWops;
4623 begin
4624   result := false;
4625
4626   RWops := glBitmapCreateRWops(Stream);
4627   try
4628     if IMG_isJPG(RWops) > 0 then begin
4629       Surface := IMG_LoadJPG_RW(RWops);
4630       try
4631         AssignFromSurface(Surface);
4632         result := true;
4633       finally
4634         SDL_FreeSurface(Surface);
4635       end;
4636     end;
4637   finally
4638     SDL_FreeRW(RWops);
4639   end;
4640 end;
4641
4642 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
4643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4644 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
4645 var
4646   StreamPos: Int64;
4647   Temp: array[0..1]of Byte;
4648
4649   jpeg: jpeg_decompress_struct;
4650   jpeg_err: jpeg_error_mgr;
4651
4652   IntFormat: TglBitmapInternalFormat;
4653   pImage: pByte;
4654   TempHeight, TempWidth: Integer;
4655
4656   pTemp: pByte;
4657   Row: Integer;
4658 begin
4659   result := false;
4660
4661   if not init_libJPEG then
4662     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
4663
4664   try
4665     // reading first two bytes to test file and set cursor back to begin
4666     StreamPos := Stream.Position;
4667     Stream.Read(Temp[0], 2);
4668     Stream.Position := StreamPos;
4669
4670     // if Bitmap then read file.
4671     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
4672       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
4673       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
4674
4675       // error managment
4676       jpeg.err := jpeg_std_error(@jpeg_err);
4677       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
4678       jpeg_err.output_message := glBitmap_libJPEG_output_message;
4679
4680       // decompression struct
4681       jpeg_create_decompress(@jpeg);
4682
4683       // allocation space for streaming methods
4684       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
4685
4686       // seeting up custom functions
4687       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
4688         pub.init_source       := glBitmap_libJPEG_init_source;
4689         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
4690         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
4691         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
4692         pub.term_source       := glBitmap_libJPEG_term_source;
4693
4694         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
4695         pub.next_input_byte := nil;   // until buffer loaded
4696
4697         SrcStream := Stream;
4698       end;
4699
4700       // set global decoding state
4701       jpeg.global_state := DSTATE_START;
4702
4703       // read header of jpeg
4704       jpeg_read_header(@jpeg, false);
4705
4706       // setting output parameter
4707       case jpeg.jpeg_color_space of
4708         JCS_GRAYSCALE:
4709           begin
4710             jpeg.out_color_space := JCS_GRAYSCALE;
4711             IntFormat := ifLuminance;
4712           end;
4713         else
4714           jpeg.out_color_space := JCS_RGB;
4715           IntFormat := ifRGB8;
4716       end;
4717
4718       // reading image
4719       jpeg_start_decompress(@jpeg);
4720
4721       TempHeight := jpeg.output_height;
4722       TempWidth := jpeg.output_width;
4723
4724       // creating new image
4725       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
4726       try
4727         pTemp := pImage;
4728
4729         for Row := 0 to TempHeight -1 do begin
4730           jpeg_read_scanlines(@jpeg, @pTemp, 1);
4731           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
4732         end;
4733
4734         // finish decompression
4735         jpeg_finish_decompress(@jpeg);
4736
4737         // destroy decompression
4738         jpeg_destroy_decompress(@jpeg);
4739
4740         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
4741
4742         result := true;
4743       except
4744         FreeMem(pImage);
4745         raise;
4746       end;
4747     end;
4748   finally
4749     quit_libJPEG;
4750   end;
4751 end;
4752
4753 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
4754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4755 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
4756 var
4757   bmp: TBitmap;
4758   jpg: TJPEGImage;
4759   StreamPos: Int64;
4760   Temp: array[0..1]of Byte;
4761 begin
4762   result := false;
4763
4764   // reading first two bytes to test file and set cursor back to begin
4765   StreamPos := Stream.Position;
4766   Stream.Read(Temp[0], 2);
4767   Stream.Position := StreamPos;
4768
4769   // if Bitmap then read file.
4770   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
4771     bmp := TBitmap.Create;
4772     try
4773       jpg := TJPEGImage.Create;
4774       try
4775         jpg.LoadFromStream(Stream);
4776         bmp.Assign(jpg);
4777         result := AssignFromBitmap(bmp);
4778       finally
4779         jpg.Free;
4780       end;
4781     finally
4782       bmp.Free;
4783     end;
4784   end;
4785 end;
4786 {$IFEND}
4787 {$ENDIF}
4788
4789 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4790 {$IF DEFEFINED(GLB_LIB_JPEG)}
4791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4792 procedure TglBitmap.SaveJPEG(Stream: TStream);
4793 var
4794   jpeg: jpeg_compress_struct;
4795   jpeg_err: jpeg_error_mgr;
4796   Row: Integer;
4797   pTemp, pTemp2: pByte;
4798
4799   procedure CopyRow(pDest, pSource: pByte);
4800   var
4801     X: Integer;
4802   begin
4803     for X := 0 to Width - 1 do begin
4804       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
4805       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
4806       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
4807       Inc(pDest, 3);
4808       Inc(pSource, 3);
4809     end;
4810   end;
4811
4812 begin
4813   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
4814     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
4815
4816   if not init_libJPEG then
4817     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
4818
4819   try
4820     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
4821     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
4822
4823     // error managment
4824     jpeg.err := jpeg_std_error(@jpeg_err);
4825     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
4826     jpeg_err.output_message := glBitmap_libJPEG_output_message;
4827
4828     // compression struct
4829     jpeg_create_compress(@jpeg);
4830
4831     // allocation space for streaming methods
4832     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
4833
4834     // seeting up custom functions
4835     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
4836       pub.init_destination    := glBitmap_libJPEG_init_destination;
4837       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
4838       pub.term_destination    := glBitmap_libJPEG_term_destination;
4839
4840       pub.next_output_byte  := @DestBuffer[1];
4841       pub.free_in_buffer    := Length(DestBuffer);
4842
4843       DestStream := Stream;
4844     end;
4845
4846     // very important state
4847     jpeg.global_state := CSTATE_START;
4848     jpeg.image_width  := Width;
4849     jpeg.image_height := Height;
4850     case InternalFormat of
4851       ifAlpha, ifLuminance, ifDepth8: begin
4852         jpeg.input_components := 1;
4853         jpeg.in_color_space := JCS_GRAYSCALE;
4854       end;
4855       ifRGB8, ifBGR8: begin
4856         jpeg.input_components := 3;
4857         jpeg.in_color_space := JCS_RGB;
4858       end;
4859     end;
4860
4861     jpeg_set_defaults(@jpeg);
4862     jpeg_set_quality(@jpeg, 95, true);
4863     jpeg_start_compress(@jpeg, true);
4864     pTemp := Data;
4865
4866     if InternalFormat = ifBGR8 then
4867       GetMem(pTemp2, fRowSize)
4868     else
4869       pTemp2 := pTemp;
4870
4871     try
4872       for Row := 0 to jpeg.image_height -1 do begin
4873         // prepare row
4874         if InternalFormat = ifBGR8 then
4875           CopyRow(pTemp2, pTemp)
4876         else
4877           pTemp2 := pTemp;
4878
4879         // write row
4880         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
4881         inc(pTemp, fRowSize);
4882       end;
4883     finally
4884       // free memory
4885       if InternalFormat = ifBGR8 then
4886         FreeMem(pTemp2);
4887     end;
4888     jpeg_finish_compress(@jpeg);
4889     jpeg_destroy_compress(@jpeg);
4890   finally
4891     quit_libJPEG;
4892   end;
4893 end;
4894
4895 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
4896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4897 procedure TglBitmap.SaveJPEG(Stream: TStream);
4898 var
4899   Bmp: TBitmap;
4900   Jpg: TJPEGImage;
4901 begin
4902   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
4903     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
4904
4905   Bmp := TBitmap.Create;
4906   try
4907     Jpg := TJPEGImage.Create;
4908     try
4909       AssignToBitmap(Bmp);
4910       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
4911         Jpg.Grayscale := true;
4912         Jpg.PixelFormat := jf8Bit;
4913       end;
4914       Jpg.Assign(Bmp);
4915       Jpg.SaveToStream(Stream);
4916     finally
4917       FreeAndNil(Jpg);
4918     end;
4919   finally
4920     FreeAndNil(Bmp);
4921   end;
4922 end;
4923 {$ENDIF}
4924 {$ENDIF}
4925
4926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4927 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4929 const
4930   BMP_MAGIC          = $4D42;
4931
4932   BMP_COMP_RGB       = 0;
4933   BMP_COMP_RLE8      = 1;
4934   BMP_COMP_RLE4      = 2;
4935   BMP_COMP_BITFIELDS = 3;
4936
4937 type
4938   TBMPHeader = packed record
4939     bfType: Word;
4940     bfSize: Cardinal;
4941     bfReserved1: Word;
4942     bfReserved2: Word;
4943     bfOffBits: Cardinal;
4944   end;
4945
4946   TBMPInfo = packed record
4947     biSize: Cardinal;
4948     biWidth: Longint;
4949     biHeight: Longint;
4950     biPlanes: Word;
4951     biBitCount: Word;
4952     biCompression: Cardinal;
4953     biSizeImage: Cardinal;
4954     biXPelsPerMeter: Longint;
4955     biYPelsPerMeter: Longint;
4956     biClrUsed: Cardinal;
4957     biClrImportant: Cardinal;
4958   end;
4959
4960   TBMPInfoOS = packed record
4961     biSize: Cardinal;
4962     biWidth: Longint;
4963     biHeight: Longint;
4964     biPlanes: Word;
4965     biBitCount: Word;
4966   end;
4967
4968 //  TBMPPalette = record
4969 //    case Boolean of
4970 //      true : (Colors: array[Byte] of TRGBQUAD);
4971 //      false: (redMask, greenMask, blueMask: Cardinal);
4972 //  end;
4973
4974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4975 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
4976 type
4977   TMaskValues = packed record
4978     Red: Cardinal;
4979     Green: Cardinal;
4980     Blue: Cardinal;
4981     Alpha: Cardinal;
4982   end;
4983
4984 var
4985   StartPos: Int64;
4986
4987   //////////////////////////////////////////////////////////////////////////////////////////////////
4988   function ReadInfo(var aInfo: TBMPInfo; var aMask: TMaskValues): TglBitmapFormat;
4989   begin
4990     result := tfEmpty;
4991     aStream.Read(aInfo, SizeOf(aInfo));
4992     FillChar(aMask, SizeOf(aMask), 0);
4993
4994     //Read Compression
4995     if aInfo.biCompression <> BMP_COMP_RGB then begin
4996       if aInfo.biCompression = BMP_COMP_BITFIELDS then begin
4997         // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!)
4998         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
4999           aStream.Read(aMask.Red,   SizeOf(Cardinal));
5000           aStream.Read(aMask.Green, SizeOf(Cardinal));
5001           aStream.Read(aMask.Blue,  SizeOf(Cardinal));
5002           aStream.Read(aMask.Alpha, SizeOf(Cardinal));
5003         end else
5004           raise EglBitmapException.Create('Bitmask is not supported for 24bit formats');
5005       end else begin
5006         aStream.Position := StartPos;
5007         raise EglBitmapException.Create('RLE compression is not supported');
5008       end;
5009     end;
5010
5011     //get suitable format
5012     case aInfo.biBitCount of
5013        8: result := tfLuminance8;
5014       16: result := tfRGB5A1;
5015       24: result := tfBGR8;
5016       32: result := tfBGRA8;
5017     end;
5018   end;
5019
5020   //////////////////////////////////////////////////////////////////////////////////////////////////
5021   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TMaskValues): TBitfieldFormat;
5022   var
5023     TmpFormat: TglBitmapFormat;
5024     FormatDesc: TglBitmapFormatDescClass;
5025   begin
5026     result := nil;
5027     if (aMask.Red <> 0) or (aMask.Green <> 0) or (aMask.Blue <> 0) or (aMask.Alpha <> 0) then begin
5028       for TmpFormat := High(FORMAT_DESCRIPTORS) downto Low(FORMAT_DESCRIPTORS) do begin
5029         FormatDesc := FORMAT_DESCRIPTORS[TmpFormat];
5030         if FormatDesc.MaskMatch(aMask.Red, aMask.Green, aMask.Blue, aMask.Alpha) then begin
5031           aFormat := FormatDesc.GetFormat;
5032           exit;
5033         end;
5034       end;
5035
5036       if (aMask.Alpha = 0) then
5037         aFormat := FORMAT_DESCRIPTORS[aFormat].WithoutAlpha;
5038
5039       result := TBitfieldFormat.Create;
5040       result.RedMask   := aMask.Red;
5041       result.GreenMask := aMask.Green;
5042       result.BlueMask  := aMask.Blue;
5043       result.AlphaMask := aMask.Alpha;
5044     end;
5045   end;
5046
5047 var
5048   //simple types
5049   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5050   PaddingBuff: Cardinal;
5051   LineBuf, ImageData, TmpData: PByte;
5052   BmpFormat: TglBitmapFormat;
5053
5054   //records
5055   Mask: TMaskValues;
5056   Header: TBMPHeader;
5057   Info: TBMPInfo;
5058
5059   //classes
5060   BitfieldFormat: TBitfieldFormat;
5061   FormatDesc: TglBitmapFormatDescClass;
5062
5063
5064   Tick: QWord;
5065 {
5066
5067
5068   ImageData, pData, pTmp, LineBuf, TmpData: PByte;
5069   BitOffset: Byte;
5070   BmpFormat: TglBitmapFormat;
5071   LineSize, Padding, LineIdx, PixelIdx: Integer;
5072   RedMask, GreenMask, BlueMask, AlphaMask, FormatSize: Cardinal;
5073
5074
5075   Pixel: TglBitmapPixelData;
5076   PaddingBuff: Cardinal;
5077
5078
5079
5080   }
5081
5082   //////////////////////////////////////////////////////////////////////////////////////////////////
5083   procedure ReadBitfieldLine(aData: PByte; aLineBuf: PByte);
5084   var
5085     i: Integer;
5086     Pixel: TglBitmapPixelData;
5087
5088     ////////////////////////////////////////////////////////////////////////////////////////////////
5089     procedure ChangeRange(var aValue: Cardinal; const aOldRange, aNewRange: Cardinal);
5090     begin
5091       if (aOldRange = aNewRange) then
5092         exit;
5093       if (aOldRange > 0) then
5094         aValue := Round(aValue / aOldRange * aNewRange)
5095       else
5096         aValue := 0;
5097     end;
5098
5099   begin
5100     aStream.Read(aLineBuf^, rbLineSize);
5101     for i := 0 to Info.biWidth-1 do begin
5102       BitfieldFormat.Unmap(PCardinal(aLineBuf)^, Pixel); //if is 16bit Bitfield only 2 last significant Bytes are taken from Cardinal
5103       inc(aLineBuf, Info.biBitCount shr 3);
5104       with FormatDesc.GetPixelDesc do begin
5105         ChangeRange(Pixel.Red,   BitfieldFormat.RedRange,   RedRange);
5106         ChangeRange(Pixel.Green, BitfieldFormat.GreenRange, GreenRange);
5107         ChangeRange(Pixel.Blue,  BitfieldFormat.BlueRange,  BlueRange);
5108         ChangeRange(Pixel.Alpha, BitfieldFormat.AlphaRange, AlphaRange);
5109       end;
5110       FormatDesc.Map(Pixel, aData);
5111     end;
5112   end;
5113
5114 begin
5115   result         := false;
5116   BmpFormat      := tfEmpty;
5117   BitfieldFormat := nil;
5118   LineBuf        := nil;
5119
5120   // Header
5121   StartPos := aStream.Position;
5122   aStream.Read(Header, SizeOf(Header));
5123
5124   if Header.bfType = BMP_MAGIC then begin
5125     BmpFormat      := ReadInfo(Info, Mask);
5126     BitfieldFormat := CheckBitfields(BmpFormat, Mask);
5127     try
5128       if (Info.biBitCount < 16) then
5129         aStream.Position := aStream.Position + Info.biClrUsed * 4;
5130       aStream.Position := StartPos + Header.bfOffBits;
5131
5132       if (BmpFormat <> tfEmpty) then begin
5133         FormatDesc := FORMAT_DESCRIPTORS[BmpFormat];
5134         rbLineSize := Info.biWidth * (Info.biBitCount shr 3); //ReadBuffer LineSize
5135         wbLineSize := Trunc(Info.biWidth * FormatDesc.GetSize);
5136         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5137
5138         //get Memory
5139         ImageSize := FormatDesc.GetSize(glBitmapPosition(Info.biWidth, Info.biHeight));
5140         GetMem(ImageData, ImageSize);
5141         if Assigned(BitfieldFormat) then
5142           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5143
5144         //read Data
5145         try try
5146           FillChar(ImageData^, ImageSize, $FF);
5147           TmpData := ImageData;
5148           Inc(TmpData, wbLineSize * (Info.biHeight -1));
5149           for i := 0 to Info.biHeight-1 do begin
5150             if Assigned(BitfieldFormat) then
5151               ReadBitfieldLine(TmpData, LineBuf)  //if is bitfield format read and convert data
5152             else
5153               aStream.Read(TmpData^, wbLineSize);   //else only read data
5154             Dec(TmpData, wbLineSize);
5155             aStream.Read(PaddingBuff, Padding);
5156           end;
5157           SetDataPointer(ImageData, BmpFormat, Info.biWidth, Info.biHeight);
5158           result := true;
5159         finally
5160           if Assigned(LineBuf) then
5161             FreeMem(LineBuf);
5162         end;
5163         except
5164           FreeMem(ImageData);
5165           raise;
5166         end;
5167       end else
5168         raise EglBitmapException.Create('LoadBMP - No suitable format found');
5169     finally
5170       FreeAndNil(BitfieldFormat);
5171     end;
5172   end
5173     else aStream.Position := StartPos;
5174 end;
5175
5176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5177 procedure TglBitmap.SaveBMP(const aStream: TStream);
5178 var
5179   Header: TBMPHeader;
5180   Info: TBMPInfo;
5181   pData, pTemp: pByte;
5182
5183   PixelFormat: TglBitmapPixelData;
5184   ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
5185   Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5186
5187   PaddingBuff: Cardinal;
5188
5189   function GetLineWidth : Integer;
5190   begin
5191     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5192   end;
5193
5194 begin
5195   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5196     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
5197
5198   ImageSize := FORMAT_DESCRIPTORS[Format].GetSize(Dimension);
5199
5200   Header.bfType      := BMP_MAGIC;
5201   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5202   Header.bfReserved1 := 0;
5203   Header.bfReserved2 := 0;
5204   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5205
5206   FillChar(Info, SizeOf(Info), 0);
5207   Info.biSize        := SizeOf(Info);
5208   Info.biWidth       := Width;
5209   Info.biHeight      := Height;
5210   Info.biPlanes      := 1;
5211   Info.biCompression := BMP_COMP_RGB;
5212   Info.biSizeImage   := ImageSize;
5213   case Format of
5214     //TODO tfAlpha8, ifLuminance8, ifDepth8:
5215     tfLuminance8:
5216       begin
5217         Info.biBitCount :=  8;
5218
5219         Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
5220         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
5221
5222         Info.biClrUsed := 256;
5223         Info.biClrImportant := 256;
5224       end;
5225     //TODO ifLuminance8Alpha8, tfRGBA4, ifR5G6B5, tfRGB5A1:
5226     tfLuminance8Alpha8, tfRGB5A1:
5227       begin
5228         Info.biBitCount := 16;
5229         Info.biCompression := BMP_COMP_BITFIELDS;
5230       end;
5231     tfBGR8, tfRGB8:
5232       Info.biBitCount := 24;
5233     //TODO tfBGRA8, tfRGBA8, tfRGB10A2:
5234     tfBGRA8, tfRGBA8:
5235       begin
5236         Info.biBitCount := 32;
5237         Info.biCompression := BMP_COMP_BITFIELDS;
5238       end;
5239     else
5240       raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
5241   end;
5242   Info.biXPelsPerMeter := 2835;
5243   Info.biYPelsPerMeter := 2835;
5244
5245   // prepare bitmasks
5246   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5247     Info.biSize      := Info.biSize      + 4 * SizeOf(Cardinal);
5248     Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5249     Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5250
5251     FORMAT_DESCRIPTORS[Format].PreparePixel(PixelFormat);
5252     with PixelFormat.PixelDesc do begin
5253       RedMask   := RedRange   shl RedShift;
5254       GreenMask := GreenRange shl GreenShift;
5255       BlueMask  := BlueRange  shl BlueShift;
5256       AlphaMask := AlphaRange shl AlphaShift;
5257     end;
5258   end;
5259
5260   // headers
5261   aStream.Write(Header, SizeOf(Header));
5262   aStream.Write(Info, SizeOf(Info));
5263
5264   // colortable
5265   if Info.biBitCount = 8 then begin
5266     Temp := 0;
5267     for ColorIdx := Low(Byte) to High(Byte) do begin
5268       aStream.Write(Temp, 4);
5269       Temp := Temp + $00010101;
5270     end;
5271   end;
5272
5273   // bitmasks
5274   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5275     aStream.Write(RedMask,   SizeOf(Cardinal));
5276     aStream.Write(GreenMask, SizeOf(Cardinal));
5277     aStream.Write(BlueMask,  SizeOf(Cardinal));
5278     aStream.Write(AlphaMask, SizeOf(Cardinal));
5279   end;
5280
5281   // image data
5282   LineSize := Trunc(Width * FORMAT_DESCRIPTORS[Format].GetSize);
5283   Padding := GetLineWidth - LineSize;
5284   PaddingBuff := 0;
5285
5286   pData := Data;
5287   Inc(pData, (Height -1) * LineSize);
5288
5289   // prepare row buffer. But only for RGB because RGBA supports color masks
5290   // so it's possible to change color within the image.
5291   if (Format = tfRGB8) then
5292     GetMem(pTemp, fRowSize)
5293   else
5294     pTemp := nil;
5295
5296   try
5297     // write image data
5298     for LineIdx := 0 to Height - 1 do begin
5299       // preparing row
5300       if Format = tfRGB8 then begin
5301         Move(pData^, pTemp^, fRowSize);
5302         SwapRGB(pTemp, Width, false);
5303       end else
5304         pTemp := pData;
5305       aStream.Write(pTemp^, LineSize);
5306       Dec(pData, LineSize);
5307       if Padding > 0 then
5308         aStream.Write(PaddingBuff, Padding);
5309     end;
5310   finally
5311     // destroy row buffer
5312     if Format = tfRGB8 then
5313       FreeMem(pTemp);
5314   end;
5315 end;
5316
5317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5318 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5320 type
5321   TTGAHeader = packed record
5322     ImageID: Byte;
5323     ColorMapType: Byte;
5324     ImageType: Byte;
5325     ColorMapSpec: Array[0..4] of Byte;
5326     OrigX: Word;
5327     OrigY: Word;
5328     Width: Word;
5329     Height: Word;
5330     Bpp: Byte;
5331     ImageDes: Byte;
5332   end;
5333
5334 const
5335   TGA_UNCOMPRESSED_RGB = 2;
5336   TGA_UNCOMPRESSED_GRAY = 3;
5337   TGA_COMPRESSED_RGB = 10;
5338   TGA_COMPRESSED_GRAY = 11;
5339
5340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5341 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
5342 var
5343   Header: TTGAHeader;
5344   NewImage, pData: PByte;
5345   StreamPos: Int64;
5346   PixelSize, LineSize, YStart, YEnd, YInc: Integer;
5347   Format: TglBitmapFormat;
5348
5349 const
5350   CACHE_SIZE = $4000;
5351
5352   ////////////////////////////////////////////////////////////////////////////////////////
5353   procedure ReadUncompressed;
5354   var
5355     RowSize: Integer;
5356   begin
5357     RowSize := Header.Width * PixelSize;
5358     // copy line by line
5359     while YStart <> YEnd + YInc do begin
5360       pData := NewImage;
5361       Inc(pData, YStart * LineSize);
5362       aStream.Read(pData^, RowSize);
5363       Inc(YStart, YInc);
5364     end;
5365   end;
5366
5367   ////////////////////////////////////////////////////////////////////////////////////////
5368   procedure ReadCompressed;
5369   var
5370     HeaderWidth, HeaderHeight: Integer;
5371     LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
5372
5373     Cache: PByte;
5374     CacheSize, CachePos: Integer;
5375
5376     Temp: Byte;
5377     TempBuf: Array [0..15] of Byte;
5378
5379     PixelRepeat: Boolean;
5380     PixelToRead, TempPixels: Integer;
5381
5382     /////////////////////////////////////////////////////////////////
5383     procedure CheckLine;
5384     begin
5385       if LinePixelsRead >= HeaderWidth then begin
5386         LinePixelsRead := 0;
5387         pData := NewImage;
5388         Inc(YStart, YInc);
5389         Inc(pData, YStart * LineSize);
5390       end;
5391     end;
5392
5393     /////////////////////////////////////////////////////////////////
5394     procedure CachedRead(out Buffer; Count: Integer);
5395     var
5396       BytesRead: Integer;
5397     begin
5398       if (CachePos + Count) > CacheSize then begin
5399         BytesRead := 0;
5400
5401         // Read Data
5402         if CacheSize - CachePos > 0 then begin
5403           BytesRead := CacheSize - CachePos;
5404           Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
5405           Inc(CachePos, BytesRead);
5406         end;
5407
5408         // Reload Data
5409         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
5410         aStream.Read(Cache^, CacheSize);
5411         CachePos := 0;
5412
5413         // Read else
5414         if Count - BytesRead > 0 then begin
5415           Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
5416           Inc(CachePos, Count - BytesRead);
5417         end;
5418       end else begin
5419         Move(pByteArray(Cache)^[CachePos], Buffer, Count);
5420         Inc(CachePos, Count);
5421       end;
5422     end;
5423
5424   begin
5425     CacheSize := 0;
5426     CachePos := 0;
5427
5428     HeaderWidth := Header.Width;
5429     HeaderHeight := Header.Height;
5430
5431     GetMem(Cache, CACHE_SIZE); // 16K Buffer
5432     try
5433       ImgPixelsToRead := HeaderWidth * HeaderHeight;
5434       ImgPixelsRead := 0;
5435       LinePixelsRead := 0;
5436
5437       pData := NewImage;
5438       Inc(pData, YStart * LineSize);
5439
5440       // Read until all Pixels
5441       repeat
5442         CachedRead(Temp, 1);
5443
5444         PixelRepeat := Temp and $80 > 0;
5445         PixelToRead := (Temp and $7F) + 1;
5446
5447         Inc(ImgPixelsRead, PixelToRead);
5448
5449         if PixelRepeat then begin
5450           // repeat one pixel x times
5451           CachedRead(TempBuf[0], PixelSize);
5452
5453           // repeat Pixel
5454           while PixelToRead > 0 do begin
5455             CheckLine;
5456
5457             TempPixels := HeaderWidth - LinePixelsRead;
5458             if PixelToRead < TempPixels then
5459               TempPixels := PixelToRead;
5460
5461             Inc(LinePixelsRead, TempPixels);
5462             Dec(PixelToRead, TempPixels);
5463
5464             while TempPixels > 0 do begin
5465               case PixelSize of
5466                 1: begin
5467                   pData^ := TempBuf[0];
5468                   Inc(pData);
5469                 end;
5470                 2: begin
5471                   pWord(pData)^ := pWord(@TempBuf[0])^;
5472                   Inc(pData, 2);
5473                 end;
5474                 3: begin
5475                   pWord(pData)^ := pWord(@TempBuf[0])^;
5476                   Inc(pData, 2);
5477                   pData^ := TempBuf[2];
5478                   Inc(pData);
5479                 end;
5480                 4: begin
5481                   pDWord(pData)^ := pDWord(@TempBuf[0])^;
5482                   Inc(pData, 4);
5483                 end;
5484               end;
5485               Dec(TempPixels);
5486             end;
5487           end;
5488         end else begin
5489           // copy x pixels
5490           while PixelToRead > 0 do begin
5491             CheckLine;
5492             TempPixels := HeaderWidth - LinePixelsRead;
5493             if PixelToRead < TempPixels then
5494               TempPixels := PixelToRead;
5495             CachedRead(pData^, PixelSize * TempPixels);
5496             Inc(pData, PixelSize * TempPixels);
5497             Inc(LinePixelsRead, TempPixels);
5498             Dec(PixelToRead, TempPixels);
5499           end;
5500         end;
5501       until ImgPixelsRead >= ImgPixelsToRead;
5502     finally
5503       FreeMem(Cache)
5504     end;
5505   end;
5506
5507 begin
5508   result := false;
5509
5510   // reading header to test file and set cursor back to begin
5511   StreamPos := aStream.Position;
5512   aStream.Read(Header, SizeOf(Header));
5513
5514   // no colormapped files
5515   if (Header.ColorMapType = 0) then begin
5516     if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
5517       case Header.Bpp of
5518         //TODO 8: Format := tfAlpha8;
5519         16: Format := tfLuminance8Alpha8;
5520         24: Format := tfBGR8;
5521         32: Format := tfBGRA8;
5522       else
5523         raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
5524       end;
5525
5526       // skip image ID
5527       if Header.ImageID <> 0 then
5528         aStream.Position := aStream.Position + Header.ImageID;
5529
5530       PixelSize := Trunc(FORMAT_DESCRIPTORS[Format].GetSize);
5531       LineSize  := Trunc(Header.Width * PixelSize);
5532
5533       GetMem(NewImage, LineSize * Header.Height);
5534       try
5535         // Row direction
5536         if (Header.ImageDes and $20 > 0) then begin
5537           YStart := 0;
5538           YEnd := Header.Height -1;
5539           YInc := 1;
5540         end else begin
5541           YStart := Header.Height -1;
5542           YEnd := 0;
5543           YInc := -1;
5544         end;
5545
5546         // Read Image
5547         case Header.ImageType of
5548           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
5549             ReadUncompressed;
5550           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
5551             ReadCompressed;
5552         end;
5553
5554         SetDataPointer(NewImage, Format, Header.Width, Header.Height);
5555         result := true;
5556       except
5557         FreeMem(NewImage);
5558         raise;
5559       end;
5560     end
5561       else aStream.Position := StreamPos;
5562   end
5563     else aStream.Position := StreamPos;
5564 end;
5565
5566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5567 procedure TglBitmap.SaveTGA(const aStream: TStream);
5568 var
5569   Header: TTGAHeader;
5570   Size: Integer;
5571   pTemp: pByte;
5572   FormatDesc: TglBitmapFormatDescClass;
5573
5574   procedure ConvertData(pTemp: pByte);
5575   var
5576     Idx, PixelSize: Integer;
5577     Temp: byte;
5578   begin
5579     PixelSize := fPixelSize;
5580     for Idx := 1 to Height * Width do begin
5581       Temp := pByteArray(pTemp)^[2];
5582       pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
5583       pByteArray(pTemp)^[0] := Temp;
5584       Inc(pTemp, PixelSize);
5585     end;
5586   end;
5587
5588 begin
5589   if not (ftTGA in FormatGetSupportedFiles(Format)) then
5590     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
5591
5592   FillChar(Header, SizeOf(Header), 0);
5593   case Format of
5594     //TODO ifAlpha8, ifLuminance8, ifDepth8: begin
5595     tfLuminance8: begin
5596       Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5597       Header.Bpp := 8;
5598     end;
5599     tfLuminance8Alpha8: begin
5600       Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5601       Header.Bpp := 16;
5602     end;
5603     tfRGB8, tfBGR8: begin
5604       Header.ImageType := TGA_UNCOMPRESSED_RGB;
5605       Header.Bpp := 24;
5606     end;
5607     tfRGBA8, tfBGRA8: begin
5608       Header.ImageType := TGA_UNCOMPRESSED_RGB;
5609       Header.Bpp := 32;
5610     end;
5611   else
5612     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
5613   end;
5614
5615   Header.Width    := Width;
5616   Header.Height   := Height;
5617   Header.ImageDes := $20;
5618   FormatDesc      := FORMAT_DESCRIPTORS[Format];
5619
5620   if FormatDesc.HasAlpha then
5621     Header.ImageDes := Header.ImageDes or $08;
5622   aStream.Write(Header, SizeOf(Header));
5623
5624   // convert RGB(A) to BGR(A)
5625   Size := FormatDesc.GetSize(Dimension);
5626   if Format in [tfRGB8, tfRGBA8] then begin
5627     GetMem(pTemp, Size);
5628   end else
5629     pTemp := Data;
5630
5631   try
5632     // convert data
5633     if Format in [tfRGB8, tfRGBA8] then begin
5634       Move(Data^, pTemp^, Size);
5635       ConvertData(pTemp);
5636     end;
5637
5638     // write data
5639     aStream.Write(pTemp^, Size);
5640   finally
5641     // free tempdata
5642     if Format in [tfRGB8, tfRGBA8] then
5643       FreeMem(pTemp);
5644   end;
5645 end;
5646
5647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5648 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5650 const
5651   DDS_MAGIC                   = $20534444;
5652
5653   // DDS_header.dwFlags
5654   DDSD_CAPS                   = $00000001;
5655   DDSD_HEIGHT                 = $00000002;
5656   DDSD_WIDTH                  = $00000004;
5657   DDSD_PITCH                  = $00000008;
5658   DDSD_PIXELFORMAT            = $00001000;
5659   DDSD_MIPMAPCOUNT            = $00020000;
5660   DDSD_LINEARSIZE             = $00080000;
5661   DDSD_DEPTH                  = $00800000;
5662
5663   // DDS_header.sPixelFormat.dwFlags
5664   DDPF_ALPHAPIXELS            = $00000001;
5665   DDPF_FOURCC                 = $00000004;
5666   DDPF_INDEXED                = $00000020;
5667   DDPF_RGB                    = $00000040;
5668
5669   // DDS_header.sCaps.dwCaps1
5670   DDSCAPS_COMPLEX             = $00000008;
5671   DDSCAPS_TEXTURE             = $00001000;
5672   DDSCAPS_MIPMAP              = $00400000;
5673
5674   // DDS_header.sCaps.dwCaps2
5675   DDSCAPS2_CUBEMAP            = $00000200;
5676   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;
5677   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;
5678   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;
5679   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;
5680   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;
5681   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;
5682   DDSCAPS2_VOLUME             = $00200000;
5683
5684   D3DFMT_DXT1                 = $31545844;
5685   D3DFMT_DXT3                 = $33545844;
5686   D3DFMT_DXT5                 = $35545844;
5687
5688 type
5689   TDDSPixelFormat = packed record
5690     dwSize: Cardinal;
5691     dwFlags: Cardinal;
5692     dwFourCC: Cardinal;
5693     dwRGBBitCount: Cardinal;
5694     dwRBitMask: Cardinal;
5695     dwGBitMask: Cardinal;
5696     dwBBitMask: Cardinal;
5697     dwAlphaBitMask: Cardinal;
5698   end;
5699
5700   TDDSCaps = packed record
5701     dwCaps1: Cardinal;
5702     dwCaps2: Cardinal;
5703     dwDDSX: Cardinal;
5704     dwReserved: Cardinal;
5705   end;
5706
5707   TDDSHeader = packed record
5708     dwMagic: Cardinal;
5709     dwSize: Cardinal;
5710     dwFlags: Cardinal;
5711     dwHeight: Cardinal;
5712     dwWidth: Cardinal;
5713     dwPitchOrLinearSize: Cardinal;
5714     dwDepth: Cardinal;
5715     dwMipMapCount: Cardinal;
5716     dwReserved: array[0..10] of Cardinal;
5717     PixelFormat: TDDSPixelFormat;
5718     Caps: TDDSCaps;
5719     dwReserved2: Cardinal;
5720   end;
5721
5722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5723 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
5724 var
5725   Header: TDDSHeader;
5726   StreamPos: Int64;
5727   Y, LineSize: Cardinal;
5728   RowSize: Cardinal;
5729   NewImage, pData: pByte;
5730   ddsFormat: TglBitmapFormat;
5731
5732   function RaiseEx : Exception;
5733   begin
5734     result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
5735   end;
5736
5737   function GetDDSFormat: TglBitmapFormat;
5738   begin
5739     with Header.PixelFormat do begin
5740       // Compresses
5741       if (dwFlags and DDPF_FOURCC) > 0 then begin
5742         (* TODO
5743         case Header.PixelFormat.dwFourCC of
5744           D3DFMT_DXT1: result := ifDXT1;
5745           D3DFMT_DXT3: result := ifDXT3;
5746           D3DFMT_DXT5: result := ifDXT5;
5747         else
5748           raise RaiseEx;
5749         end;
5750         *)
5751         raise RaiseEx;
5752       end else
5753
5754       // RGB
5755       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
5756         case dwRGBBitCount of
5757           8: begin
5758             (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then
5759               result := tfAlpha
5760             else
5761             *)
5762               result := tfLuminance8;
5763           end;
5764           16: begin
5765             if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
5766               // Alpha
5767               case CountSetBits(dwRBitMask) of
5768                 5: result := tfRGB5A1;
5769                 //TODO 4: result := tfRGBA4;
5770               else
5771                 result := tfLuminance8Alpha8;
5772               end;
5773             end else begin
5774               // no Alpha
5775               //TODO result := ifR5G6B5;
5776               raise RaiseEx;
5777             end;
5778           end;
5779           24: begin
5780             if dwRBitMask > dwBBitMask then
5781               result := tfBGR8
5782             else
5783               result := tfRGB8;
5784           end;
5785         32: begin
5786             if CountSetBits(dwRBitMask) = 10 then
5787               //TODO result := tfRGB10A2
5788               raise RaiseEx
5789             else
5790
5791             if dwRBitMask > dwBBitMask then
5792               result := tfBGRA8
5793             else
5794               result := tfRGBA8;
5795           end;
5796         else
5797           raise RaiseEx;
5798         end;
5799       end else
5800         raise RaiseEx;
5801     end;
5802   end;
5803
5804 begin
5805   result := false;
5806
5807   // Header
5808   StreamPos := aStream.Position;
5809   aStream.Read(Header, sizeof(Header));
5810
5811   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
5812      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
5813     aStream.Position := StreamPos;
5814     exit;
5815   end;
5816
5817   ddsFormat := GetDDSFormat;
5818   LineSize  := Trunc(Header.dwWidth * FORMAT_DESCRIPTORS[ddsFormat].GetSize);
5819   GetMem(NewImage, Header.dwHeight * LineSize);
5820   try
5821     pData := NewImage;
5822
5823     // Compressed
5824     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
5825       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
5826       for Y := 0 to Header.dwHeight -1 do begin
5827         aStream.Read(pData^, RowSize);
5828         Inc(pData, LineSize);
5829       end;
5830     end else
5831
5832     // RGB(A)
5833     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
5834       RowSize := Header.dwPitchOrLinearSize;
5835
5836       for Y := 0 to Header.dwHeight -1 do begin
5837         aStream.Read(pData^, RowSize);
5838         Inc(pData, LineSize);
5839       end;
5840     end else
5841       raise RaiseEx;
5842
5843     SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
5844     result := true;
5845   except
5846     FreeMem(NewImage);
5847     raise;
5848   end;
5849 end;
5850
5851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5852 procedure TglBitmap.SaveDDS(const aStream: TStream);
5853 var
5854   Header: TDDSHeader;
5855   Pix: TglBitmapPixelData;
5856 begin
5857   //if not FormatIsUncompressed(InternalFormat) then
5858   //  raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
5859
5860   (* TODO if Format = tfAlpha8 then
5861     FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
5862   else    *)
5863     FORMAT_DESCRIPTORS[Format].PreparePixel(Pix);
5864
5865   // Generell
5866   FillChar(Header, SizeOf(Header), 0);
5867   Header.dwMagic := DDS_MAGIC;
5868   Header.dwSize  := 124;
5869   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
5870
5871   if Width > 0 then begin
5872     Header.dwWidth := Width;
5873     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
5874   end;
5875
5876   if Height > 0 then begin
5877     Header.dwHeight := Height;
5878     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
5879   end;
5880
5881   Header.dwPitchOrLinearSize := fRowSize;
5882   Header.dwMipMapCount := 1;
5883
5884   // Caps
5885   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
5886
5887   // Pixelformat
5888   Header.PixelFormat.dwSize  := Sizeof(Header.PixelFormat);
5889   Header.PixelFormat.dwFlags := DDPF_RGB;
5890
5891   (* TODO tfAlpha8
5892   if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
5893     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
5894   *)
5895
5896   Header.PixelFormat.dwRGBBitCount  := Trunc(FORMAT_DESCRIPTORS[Format].GetSize * 8);
5897   Header.PixelFormat.dwRBitMask     := Pix.PixelDesc.RedRange   shl Pix.PixelDesc.RedShift;
5898   Header.PixelFormat.dwGBitMask     := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift;
5899   Header.PixelFormat.dwBBitMask     := Pix.PixelDesc.BlueRange  shl Pix.PixelDesc.BlueShift;
5900   Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift;
5901
5902   aStream.Write(Header, SizeOf(Header));
5903   aStream.Write(Data^, FORMAT_DESCRIPTORS[Format].GetSize(Dimension));
5904 end;
5905 {$ENDREGION}
5906
5907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5908 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5910 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
5911 begin
5912   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
5913     result := fLines[aIndex]
5914   else
5915     result := nil;
5916 end;
5917
5918 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5919 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
5920   const aWidth: Integer; const aHeight: Integer);
5921 var
5922   Idx, LineWidth: Integer;
5923 begin
5924   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
5925
5926   //TODO compression
5927   if {FormatIsUncompressed(Format)} true then begin
5928     (* TODO PixelFuncs
5929     fGetPixelFunc := GetPixel2DUnmap;
5930     fSetPixelFunc := SetPixel2DUnmap;
5931     *)
5932     // Assigning Data
5933     if Assigned(Data) then begin
5934       SetLength(fLines, GetHeight);
5935       LineWidth := Trunc(GetWidth * FORMAT_DESCRIPTORS[Format].GetSize);
5936
5937       for Idx := 0 to GetHeight -1 do begin
5938         fLines[Idx] := Data;
5939         Inc(fLines[Idx], Idx * LineWidth);
5940       end;
5941     end
5942       else SetLength(fLines, 0);
5943   end else begin
5944     (*
5945     SetLength(fLines, 0);
5946
5947     fSetPixelFunc := nil;
5948
5949     case Format of
5950       ifDXT1:
5951         fGetPixelFunc := GetPixel2DDXT1;
5952       ifDXT3:
5953         fGetPixelFunc := GetPixel2DDXT3;
5954       ifDXT5:
5955         fGetPixelFunc := GetPixel2DDXT5;
5956       else
5957         fGetPixelFunc := nil;
5958     end;
5959     *)
5960   end;
5961 end;
5962
5963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5964 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
5965 var
5966   FormatDescriptor: TglBitmapFormatDescClass;
5967   FormatDesc: TglBitmapFormatDesc;
5968 begin
5969   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
5970
5971   (* TODO compression
5972   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
5973     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
5974   else
5975   *)
5976
5977   FormatDescriptor := FORMAT_DESCRIPTORS[Format];
5978   FormatDesc       := FormatDescriptor.GetFormatDesc;
5979   if aBuildWithGlu then
5980     gluBuild2DMipmaps(aTarget, FormatDescriptor.GetColorCompCount, Width, Height,
5981       FormatDesc.Format, FormatDesc.DataType, Data)
5982   else
5983     glTexImage2D(aTarget, 0, FormatDesc.InternalFormat, Width, Height, 0,
5984       FormatDesc.Format, FormatDesc.DataType, Data);
5985
5986   // Freigeben
5987   if (FreeDataAfterGenTexture) then
5988     FreeData;
5989 end;
5990
5991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5992 procedure TglBitmap2D.AfterConstruction;
5993 begin
5994   inherited;
5995   Target := GL_TEXTURE_2D;
5996 end;
5997
5998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5999 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
6000 var
6001   Temp: pByte;
6002   Size, w, h: Integer;
6003   FormatDesc: TglBitmapFormatDescClass;
6004   glFormatDesc: TglBitmapFormatDesc;
6005 begin
6006   (* TODO compression
6007   if not FormatIsUncompressed(Format) then
6008     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
6009   *)
6010
6011   w := aRight  - aLeft;
6012   h := aBottom - aTop;
6013   FormatDesc   := FORMAT_DESCRIPTORS[Format];
6014   glFormatDesc := FormatDesc.GetFormatDesc;
6015   Size         := FormatDesc.GetSize(glBitmapPosition(w, h));
6016   GetMem(Temp, Size);
6017   try
6018     glPixelStorei(GL_PACK_ALIGNMENT, 1);
6019     glReadPixels(aLeft, aTop, w, h, glFormatDesc.Format, glFormatDesc.DataType, Temp);
6020     SetDataPointer(Temp, Format, w, h);
6021     FlipVert;
6022   except
6023     FreeMem(Temp);
6024     raise;
6025   end;
6026 end;
6027
6028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6029 procedure TglBitmap2D.GetDataFromTexture;
6030 var
6031   Temp: PByte;
6032   TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer;
6033   TempType, TempIntFormat: Cardinal;
6034   IntFormat: TglBitmapFormat;
6035   FormatDesc: TglBitmapFormatDescClass;
6036 begin
6037   Bind;
6038
6039   // Request Data
6040   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
6041   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
6042   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
6043
6044   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE,       @RedSize);
6045   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE,     @GreenSize);
6046   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE,      @BlueSize);
6047   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE,     @AlphaSize);
6048   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize);
6049
6050   IntFormat := tfEmpty;
6051   for FormatDesc in FORMAT_DESCRIPTORS do
6052     if (FormatDesc.GetFormatDesc.InternalFormat = TempIntFormat) then begin
6053       IntFormat := FormatDesc.GetFormat;
6054       break;
6055     end;
6056
6057   // Getting data from OpenGL
6058   GetMem(Temp, FormatDesc.GetSize(glBitmapPosition(TempWidth, TempHeight)));
6059   try
6060     (* TODO Compression
6061     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
6062       glGetCompressedTexImage(Target, 0, Temp)
6063     else
6064     *)
6065     with FormatDesc.GetFormatDesc do
6066       glGetTexImage(Target, 0, InternalFormat, DataType, Temp);
6067     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
6068   except
6069     FreeMem(Temp);
6070     raise;
6071   end;
6072 end;
6073
6074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6075 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
6076 var
6077   BuildWithGlu, PotTex, TexRec: Boolean;
6078   TexSize: Integer;
6079 begin
6080   if Assigned(Data) then begin
6081     // Check Texture Size
6082     if (aTestTextureSize) then begin
6083       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6084
6085       if ((Height > TexSize) or (Width > TexSize)) then
6086         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6087
6088       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
6089       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
6090
6091       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6092         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6093     end;
6094
6095     CreateId;
6096     SetupParameters(BuildWithGlu);
6097     UploadData(Target, BuildWithGlu);
6098     glAreTexturesResident(1, @fID, @fIsResident);
6099   end;
6100 end;
6101
6102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6103 function TglBitmap2D.FlipHorz: Boolean;
6104 var
6105   Col, Row: Integer;
6106   TempDestData, DestData, SourceData: PByte;
6107   ImgSize: Integer;
6108 begin
6109   result := inherited FlipHorz;
6110   if Assigned(Data) then begin
6111     SourceData := Data;
6112     ImgSize := Height * fRowSize;
6113     GetMem(DestData, ImgSize);
6114     try
6115       TempDestData := DestData;
6116       Dec(TempDestData, fRowSize + fPixelSize);
6117       for Row := 0 to Height -1 do begin
6118         Inc(TempDestData, fRowSize * 2);
6119         for Col := 0 to Width -1 do begin
6120           Move(SourceData^, TempDestData^, fPixelSize);
6121           Inc(SourceData, fPixelSize);
6122           Dec(TempDestData, fPixelSize);
6123         end;
6124       end;
6125       SetDataPointer(DestData, Format);
6126       result := true;
6127     except
6128       FreeMem(DestData);
6129       raise;
6130     end;
6131   end;
6132 end;
6133
6134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6135 function TglBitmap2D.FlipVert: Boolean;
6136 var
6137   Row: Integer;
6138   TempDestData, DestData, SourceData: PByte;
6139 begin
6140   result := inherited FlipVert;
6141   if Assigned(Data) then begin
6142     SourceData := Data;
6143     GetMem(DestData, Height * fRowSize);
6144     try
6145       TempDestData := DestData;
6146       Inc(TempDestData, Width * (Height -1) * fPixelSize);
6147       for Row := 0 to Height -1 do begin
6148         Move(SourceData^, TempDestData^, fRowSize);
6149         Dec(TempDestData, fRowSize);
6150         Inc(SourceData, fRowSize);
6151       end;
6152       SetDataPointer(DestData, Format);
6153       result := true;
6154     except
6155       FreeMem(DestData);
6156       raise;
6157     end;
6158   end;
6159 end;
6160
6161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6162 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6164 type
6165   TMatrixItem = record
6166     X, Y: Integer;
6167     W: Single;
6168   end;
6169
6170   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
6171   TglBitmapToNormalMapRec = Record
6172     Scale: Single;
6173     Heights: array of Single;
6174     MatrixU : array of TMatrixItem;
6175     MatrixV : array of TMatrixItem;
6176   end;
6177
6178 const
6179   oneover255 = 1 / 255;
6180
6181   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6182 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
6183 var
6184   Val: Single;
6185 begin
6186   with FuncRec do begin
6187     Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue *  0.11;
6188     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255;
6189   end;
6190 end;
6191
6192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6193 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
6194 begin
6195   with FuncRec do
6196     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255;
6197 end;
6198
6199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6200 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
6201 type
6202   TVec = Array[0..2] of Single;
6203 var
6204   Idx: Integer;
6205   du, dv: Double;
6206   Len: Single;
6207   Vec: TVec;
6208
6209   function GetHeight(X, Y: Integer): Single;
6210   begin
6211     with FuncRec do begin
6212       X := Max(0, Min(Size.X -1, X));
6213       Y := Max(0, Min(Size.Y -1, Y));
6214       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
6215     end;
6216   end;
6217
6218 begin
6219   with FuncRec do begin
6220     with PglBitmapToNormalMapRec(Args)^ do begin
6221       du := 0;
6222       for Idx := Low(MatrixU) to High(MatrixU) do
6223         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
6224
6225       dv := 0;
6226       for Idx := Low(MatrixU) to High(MatrixU) do
6227         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
6228
6229       Vec[0] := -du * Scale;
6230       Vec[1] := -dv * Scale;
6231       Vec[2] := 1;
6232     end;
6233
6234     // Normalize
6235     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6236     if Len <> 0 then begin
6237       Vec[0] := Vec[0] * Len;
6238       Vec[1] := Vec[1] * Len;
6239       Vec[2] := Vec[2] * Len;
6240     end;
6241
6242     // Farbe zuweisem
6243     Dest.Red   := Trunc((Vec[0] + 1) * 127.5);
6244     Dest.Green := Trunc((Vec[1] + 1) * 127.5);
6245     Dest.Blue  := Trunc((Vec[2] + 1) * 127.5);
6246   end;
6247 end;
6248
6249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6250 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
6251 var
6252   Rec: TglBitmapToNormalMapRec;
6253
6254   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
6255   begin
6256     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
6257       Matrix[Index].X := X;
6258       Matrix[Index].Y := Y;
6259       Matrix[Index].W := W;
6260     end;
6261   end;
6262
6263 begin
6264   (* TODO Compression
6265   if not FormatIsUncompressed(InternalFormat) then
6266     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
6267     *)
6268
6269   if aScale > 100 then
6270     Rec.Scale := 100
6271   else if aScale < -100 then
6272     Rec.Scale := -100
6273   else
6274     Rec.Scale := aScale;
6275
6276   SetLength(Rec.Heights, Width * Height);
6277   try
6278     case aFunc of
6279       nm4Samples: begin
6280         SetLength(Rec.MatrixU, 2);
6281         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
6282         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
6283
6284         SetLength(Rec.MatrixV, 2);
6285         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
6286         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
6287       end;
6288
6289       nmSobel: begin
6290         SetLength(Rec.MatrixU, 6);
6291         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
6292         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
6293         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
6294         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
6295         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
6296         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
6297
6298         SetLength(Rec.MatrixV, 6);
6299         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
6300         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
6301         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
6302         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
6303         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
6304         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
6305       end;
6306
6307       nm3x3: begin
6308         SetLength(Rec.MatrixU, 6);
6309         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
6310         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
6311         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
6312         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
6313         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
6314         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
6315
6316         SetLength(Rec.MatrixV, 6);
6317         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
6318         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
6319         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
6320         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
6321         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
6322         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
6323       end;
6324
6325       nm5x5: begin
6326         SetLength(Rec.MatrixU, 20);
6327         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
6328         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
6329         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
6330         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
6331         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
6332         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
6333         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
6334         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
6335         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
6336         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
6337         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
6338         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
6339         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
6340         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
6341         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
6342         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
6343         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
6344         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
6345         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
6346         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
6347
6348         SetLength(Rec.MatrixV, 20);
6349         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
6350         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
6351         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
6352         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
6353         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
6354         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
6355         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
6356         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
6357         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
6358         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
6359         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
6360         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
6361         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
6362         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
6363         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
6364         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
6365         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
6366         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
6367         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
6368         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
6369       end;
6370     end;
6371
6372     // Daten Sammeln
6373     if aUseAlpha and FORMAT_DESCRIPTORS[Format].HasAlpha then
6374       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
6375     else
6376       AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
6377     AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
6378   finally
6379     SetLength(Rec.Heights, 0);
6380   end;
6381 end;
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391 (*
6392 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
6393 var
6394   pTemp: pByte;
6395   Size: Integer;
6396 begin
6397   if Height > 1 then begin
6398     // extract first line of the data
6399     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
6400     GetMem(pTemp, Size);
6401
6402     Move(Data^, pTemp^, Size);
6403
6404     FreeMem(Data);
6405   end else
6406     pTemp := Data;
6407
6408   // set data pointer
6409   inherited SetDataPointer(pTemp, Format, Width);
6410
6411   if FormatIsUncompressed(Format) then begin
6412     fUnmapFunc := FormatGetUnMapFunc(Format);
6413     fGetPixelFunc := GetPixel1DUnmap;
6414   end;
6415 end;
6416
6417
6418 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6419 var
6420   pTemp: pByte;
6421 begin
6422   pTemp := Data;
6423   Inc(pTemp, Pos.X * fPixelSize);
6424
6425   fUnmapFunc(pTemp, Pixel);
6426 end;
6427
6428
6429 function TglBitmap1D.FlipHorz: Boolean;
6430 var
6431   Col: Integer;
6432   pTempDest, pDest, pSource: pByte;
6433 begin
6434   result := inherited FlipHorz;
6435
6436   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
6437     pSource := Data;
6438
6439     GetMem(pDest, fRowSize);
6440     try
6441       pTempDest := pDest;
6442
6443       Inc(pTempDest, fRowSize);
6444       for Col := 0 to Width -1 do begin
6445         Move(pSource^, pTempDest^, fPixelSize);
6446
6447         Inc(pSource, fPixelSize);
6448         Dec(pTempDest, fPixelSize);
6449       end;
6450
6451       SetDataPointer(pDest, InternalFormat);
6452
6453       result := true;
6454     finally
6455       FreeMem(pDest);
6456     end;
6457   end;
6458 end;
6459
6460
6461 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6462 begin
6463   // Upload data
6464   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6465     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
6466   else
6467
6468   // Upload data
6469   if BuildWithGlu then
6470     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
6471   else
6472     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
6473
6474   // Freigeben
6475   if (FreeDataAfterGenTexture) then
6476     FreeData;
6477 end;
6478
6479
6480 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
6481 var
6482   BuildWithGlu, TexRec: Boolean;
6483   glFormat, glInternalFormat, glType: Cardinal;
6484   TexSize: Integer;
6485 begin
6486   if Assigned(Data) then begin
6487     // Check Texture Size
6488     if (TestTextureSize) then begin
6489       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6490
6491       if (Width > TexSize) then
6492         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6493
6494       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6495                 (Target = GL_TEXTURE_RECTANGLE_ARB);
6496
6497       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6498         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6499     end;
6500
6501     CreateId;
6502
6503     SetupParameters(BuildWithGlu);
6504     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6505
6506     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6507
6508     // Infos sammeln
6509     glAreTexturesResident(1, @fID, @fIsResident);
6510   end;
6511 end;
6512
6513
6514 procedure TglBitmap1D.AfterConstruction;
6515 begin
6516   inherited;
6517
6518   Target := GL_TEXTURE_1D;
6519 end;
6520
6521
6522 { TglBitmapCubeMap }
6523
6524 procedure TglBitmapCubeMap.AfterConstruction;
6525 begin
6526   inherited;
6527
6528   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
6529     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
6530
6531   SetWrap; // set all to GL_CLAMP_TO_EDGE
6532   Target := GL_TEXTURE_CUBE_MAP;
6533   fGenMode := GL_REFLECTION_MAP;
6534 end;
6535
6536
6537 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
6538 begin
6539   inherited Bind (EnableTextureUnit);
6540
6541   if EnableTexCoordsGen then begin
6542     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
6543     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
6544     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
6545     glEnable(GL_TEXTURE_GEN_S);
6546     glEnable(GL_TEXTURE_GEN_T);
6547     glEnable(GL_TEXTURE_GEN_R);
6548   end;
6549 end;
6550
6551
6552 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
6553 var
6554   glFormat, glInternalFormat, glType: Cardinal;
6555   BuildWithGlu: Boolean;
6556   TexSize: Integer;
6557 begin
6558   // Check Texture Size
6559   if (TestTextureSize) then begin
6560     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
6561
6562     if ((Height > TexSize) or (Width > TexSize)) then
6563       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
6564
6565     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
6566       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
6567   end;
6568
6569   // create Texture
6570   if ID = 0 then begin
6571     CreateID;
6572     SetupParameters(BuildWithGlu);
6573   end;
6574
6575   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6576
6577   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
6578 end;
6579
6580
6581 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
6582 begin
6583   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
6584 end;
6585
6586
6587 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
6588   DisableTextureUnit: Boolean);
6589 begin
6590   inherited Unbind (DisableTextureUnit);
6591
6592   if DisableTexCoordsGen then begin
6593     glDisable(GL_TEXTURE_GEN_S);
6594     glDisable(GL_TEXTURE_GEN_T);
6595     glDisable(GL_TEXTURE_GEN_R);
6596   end;
6597 end;
6598
6599
6600 { TglBitmapNormalMap }
6601
6602 type
6603   TVec = Array[0..2] of Single;
6604   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6605
6606   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
6607   TglBitmapNormalMapRec = record
6608     HalfSize : Integer;
6609     Func: TglBitmapNormalMapGetVectorFunc;
6610   end;
6611
6612
6613 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6614 begin
6615   Vec[0] := HalfSize;
6616   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6617   Vec[2] := - (Position.X + 0.5 - HalfSize);
6618 end;
6619
6620
6621 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6622 begin
6623   Vec[0] := - HalfSize;
6624   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6625   Vec[2] := Position.X + 0.5 - HalfSize;
6626 end;
6627
6628
6629 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6630 begin
6631   Vec[0] := Position.X + 0.5 - HalfSize;
6632   Vec[1] := HalfSize;
6633   Vec[2] := Position.Y + 0.5 - HalfSize;
6634 end;
6635
6636
6637 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6638 begin
6639   Vec[0] := Position.X + 0.5 - HalfSize;
6640   Vec[1] := - HalfSize;
6641   Vec[2] := - (Position.Y + 0.5 - HalfSize);
6642 end;
6643
6644
6645 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6646 begin
6647   Vec[0] := Position.X + 0.5 - HalfSize;
6648   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6649   Vec[2] := HalfSize;
6650 end;
6651
6652
6653 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6654 begin
6655   Vec[0] := - (Position.X + 0.5 - HalfSize);
6656   Vec[1] := - (Position.Y + 0.5 - HalfSize);
6657   Vec[2] := - HalfSize;
6658 end;
6659
6660
6661 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
6662 var
6663   Vec : TVec;
6664   Len: Single;
6665 begin
6666   with FuncRec do begin
6667     with PglBitmapNormalMapRec (CustomData)^ do begin
6668       Func(Vec, Position, HalfSize);
6669
6670       // Normalize
6671       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6672       if Len <> 0 then begin
6673         Vec[0] := Vec[0] * Len;
6674         Vec[1] := Vec[1] * Len;
6675         Vec[2] := Vec[2] * Len;
6676       end;
6677
6678       // Scale Vector and AddVectro
6679       Vec[0] := Vec[0] * 0.5 + 0.5;
6680       Vec[1] := Vec[1] * 0.5 + 0.5;
6681       Vec[2] := Vec[2] * 0.5 + 0.5;
6682     end;
6683
6684     // Set Color
6685     Dest.Red   := Round(Vec[0] * 255);
6686     Dest.Green := Round(Vec[1] * 255);
6687     Dest.Blue  := Round(Vec[2] * 255);
6688   end;
6689 end;
6690
6691
6692 procedure TglBitmapNormalMap.AfterConstruction;
6693 begin
6694   inherited;
6695
6696   fGenMode := GL_NORMAL_MAP;
6697 end;
6698
6699
6700 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
6701   TestTextureSize: Boolean);
6702 var
6703   Rec: TglBitmapNormalMapRec;
6704   SizeRec: TglBitmapPixelPosition;
6705 begin
6706   Rec.HalfSize := Size div 2;
6707
6708   FreeDataAfterGenTexture := false;
6709
6710   SizeRec.Fields := [ffX, ffY];
6711   SizeRec.X := Size;
6712   SizeRec.Y := Size;
6713
6714   // Positive X
6715   Rec.Func := glBitmapNormalMapPosX;
6716   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6717   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
6718
6719   // Negative X
6720   Rec.Func := glBitmapNormalMapNegX;
6721   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6722   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
6723
6724   // Positive Y
6725   Rec.Func := glBitmapNormalMapPosY;
6726   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6727   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
6728
6729   // Negative Y
6730   Rec.Func := glBitmapNormalMapNegY;
6731   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6732   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
6733
6734   // Positive Z
6735   Rec.Func := glBitmapNormalMapPosZ;
6736   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6737   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
6738
6739   // Negative Z
6740   Rec.Func := glBitmapNormalMapNegZ;
6741   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6742   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
6743 end;
6744 *)
6745
6746 initialization
6747   glBitmapSetDefaultFormat(tfEmpty);
6748   glBitmapSetDefaultMipmap(mmMipmap);
6749   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
6750   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
6751
6752   glBitmapSetDefaultFreeDataAfterGenTexture(true);
6753   glBitmapSetDefaultDeleteTextureOnFree    (true);
6754
6755 finalization
6756
6757 end.