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   EglBitmapException                 = class(Exception);
 587   EglBitmapSizeToLargeException      = class(EglBitmapException);
 588   EglBitmapNonPowerOfTwoException    = class(EglBitmapException);
 589   EglBitmapUnsupportedInternalFormat = class(EglBitmapException);
 590
 591   TglBitmapPixelDesc = packed record
 592     RedRange: Cardinal;
 593     GreenRange: Cardinal;
 594     BlueRange: Cardinal;
 595     AlphaRange: Cardinal;
 596
 597     RedShift: Shortint;
 598     GreenShift: Shortint;
 599     BlueShift: Shortint;
 600     AlphaShift: Shortint;
 601   end;
 602
 603   TglBitmapPixelData = packed record
 604     Red: Cardinal;
 605     Green: Cardinal;
 606     Blue: Cardinal;
 607     Alpha: Cardinal;
 608     PixelDesc: TglBitmapPixelDesc;
 609   end;
 610
 611   TglBitmapPixelPositionFields = set of (ffX, ffY);
 612   TglBitmapPixelPosition = record
 613     Fields : TglBitmapPixelPositionFields;
 614     X : Word;
 615     Y : Word;
 616   end;
 617
 618 const
 619   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
 620
 621 type
 622   TglBitmap = class;
 623
 624   TglBitmapFunctionRec = record
 625     Sender : TglBitmap;
 626     Size: TglBitmapPixelPosition;
 627     Position: TglBitmapPixelPosition;
 628     Source: TglBitmapPixelData;
 629     Dest: TglBitmapPixelData;
 630     CustomData: Pointer;
 631   end;
 632
 633   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 634
 635   TglBitmapGetPixel = procedure (
 636     const Pos: TglBitmapPixelPosition;
 637     var Pixel: TglBitmapPixelData) of object;
 638
 639   TglBitmapSetPixel = procedure (
 640     const Pos: TglBitmapPixelPosition;
 641     const Pixel: TglBitmapPixelData) of object;
 642
 643   TglBitmapFileType = (
 644       {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
 645       {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
 646       ftDDS,
 647       ftTGA,
 648       ftBMP);
 649   TglBitmapFileTypes = set of TglBitmapFileType;
 650
 651   TglBitmapMipMap = (
 652     mmNone,
 653     mmMipmap,
 654     mmMipmapGlu);
 655   TglBitmapNormalMapFunc = (
 656     nm4Samples,
 657     nmSobel,
 658     nm3x3,
 659     nm5x5);
 660   TglBitmapFormat = (
 661     tfRed = GL_RED,
 662     tfGreen = GL_GREEN,
 663     tfBlue = GL_BLUE,
 664     tfAlpha = GL_ALPHA,
 665     tfRGB = GL_RGB,
 666     tfBGR = GL_BGR,
 667     tfRGBA = GL_RGBA,
 668     tfBGRA = GL_BGRA,
 669     tfLuminance = GL_LUMINANCE,
 670     tfLuminanceAlpha = GL_LUMINANCE_ALPHA
 671   );
 672   TglBitmapInternalFormat = (
 673     ifAlpha4 = GL_ALPHA4,
 674     ifAlpha8 = GL_ALPHA8,
 675     ifAlpha12 = GL_ALPHA12,
 676     ifAlpha16 = GL_ALPHA16,
 677
 678     ifLuminance4 = GL_LUMINANCE4,
 679     ifLuminance8 = GL_LUMINANCE8,
 680     ifLuminance12 = GL_LUMINANCE12,
 681     ifLuminance16 = GL_LUMINANCE16,
 682
 683     ifLuminance4Alpha4 = GL_LUMINANCE4_ALPHA4,
 684     ifLuminance6Alpha2 = GL_LUMINANCE6_ALPHA2,
 685     ifLuminance8Alpha8 = GL_LUMINANCE8_ALPHA8,
 686     ifLuminance12Alpha4 = GL_LUMINANCE12_ALPHA4,
 687     ifLuminance12Alpha12 = GL_LUMINANCE12_ALPHA12,
 688     ifLuminance16Alpha16 = GL_LUMINANCE16_ALPHA16,
 689
 690     ifR3G3B2 = GL_R3_G3_B2,
 691     ifRGB4 = GL_RGB4,
 692     ifRGB5 = GL_RGB5,
 693     ifRGB8 = GL_RGB8,
 694     ifRGB10 = GL_RGB10,
 695     ifRGB12 = GL_RGB12,
 696     ifRGB16 = GL_RGB16,
 697
 698     ifRGBA2 = GL_RGBA2,
 699     ifRGBA4 = GL_RGBA4,
 700     ifRGB5A1 = GL_RGB5_A1,
 701     ifRGBA8 = GL_RGBA8,
 702     ifRGB10A2 = GL_RGB10_A2,
 703     ifRGBA12 = GL_RGBA12,
 704     ifRGBA16 = GL_RGBA16,
 705
 706     ifDepth16 = GL_DEPTH_COMPONENT16,
 707     ifDepth24 = GL_DEPTH_COMPONENT24,
 708     ifDepth32 = GL_DEPTH_COMPONENT32
 709   );
 710
 711   // Pixelmapping
 712   TglBitmapMapFunc   = procedure(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
 713   TglBitmapUnMapFunc = procedure(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
 714
 715   // Base Class
 716   TglBitmap = class
 717   protected
 718     fID: Cardinal;
 719     fTarget: Cardinal;
 720     fAnisotropic: Integer;
 721     fDeleteTextureOnFree: Boolean;
 722     fFreeDataAfterGenTexture: Boolean;
 723     fData: PByte;
 724     fIsResident: Boolean;
 725     fBorderColor: array[0..3] of Single;
 726
 727     fDimension: TglBitmapPixelPosition;
 728     fMipMap: TglBitmapMipMap;
 729     fFormat: TglBitmapFormat;
 730     fInternalFormat: TglBitmapInternalFormat;
 731
 732     // Mapping
 733     fPixelSize: Integer;
 734     fRowSize: Integer;
 735     fUnmapFunc: TglBitmapUnMapFunc;
 736     fMapFunc: TglBitmapMapFunc;
 737
 738     // Filtering
 739     fFilterMin: Cardinal;
 740     fFilterMag: Cardinal;
 741
 742     // TexturWarp
 743     fWrapS: Cardinal;
 744     fWrapT: Cardinal;
 745     fWrapR: Cardinal;
 746
 747     fGetPixelFunc: TglBitmapGetPixel;
 748     fSetPixelFunc: TglBitmapSetPixel;
 749
 750     // CustomData
 751     fFilename: String;
 752     fCustomName: String;
 753     fCustomNameW: WideString;
 754     fCustomData: Pointer;
 755
 756     //Getter
 757     function GetHeight: Integer; virtual;
 758     function GetWidth:  Integer; virtual;
 759
 760     //Setter
 761     procedure SetCustomData(const aValue: Pointer);
 762     procedure SetCustomName(const aValue: String);
 763     procedure SetCustomNameW(const aValue: WideString);
 764     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 765     procedure SetFormat(const aValue: TglBitmapFormat);
 766     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 767     procedure SetID(const aValue: Cardinal);
 768     procedure SetMipMap(const aValue: TglBitmapMipMap);
 769     procedure SetTarget(const aValue: Cardinal);
 770     procedure SetAnisotropic(const aValue: Integer);
 771     procedure SetInternalFormat(const aValue: TglBitmapInternalFormat);
 772
 773     //Load
 774     {$IFDEF GLB_SUPPORT_PNG_READ}
 775     function LoadPNG(Stream: TStream): Boolean; virtual;
 776     {$ENDIF}
 777     {$IFDEF GLB_SUPPORT_JPEG_READ}
 778     function LoadJPEG(Stream: TStream): Boolean; virtual;
 779     {$ENDIF}
 780     function LoadDDS(Stream: TStream): Boolean; virtual;
 781     function LoadTGA(Stream: TStream): Boolean; virtual;
 782     function LoadBMP(Stream: TStream): Boolean; virtual;
 783
 784     //Save
 785     {$IFDEF GLB_SUPPORT_PNG_WRITE}
 786     procedure SavePNG(Stream: TStream); virtual;
 787     {$ENDIF}
 788     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 789     procedure SaveJPEG(Stream: TStream); virtual;
 790     {$ENDIF}
 791     procedure SaveDDS(Stream: TStream); virtual;
 792     procedure SaveTGA(Stream: TStream); virtual;
 793     procedure SaveBMP(Stream: TStream); virtual;
 794
 795     procedure CreateID;
 796     procedure SetupParameters(var BuildWithGlu: Boolean);
 797     procedure SelectFormat(DataFormat: TglBitmapInternalFormat; var glFormat, glInternalFormat, glType: Cardinal; CanConvertImage: Boolean = True);
 798
 799     procedure SetDataPointer(NewData: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); virtual;
 800     procedure GenTexture(TestTextureSize: Boolean = True); virtual; abstract;
 801
 802     function FlipHorz: Boolean; virtual;
 803     function FlipVert: Boolean; virtual;
 804
 805     property Width:  Integer read GetWidth;
 806     property Height: Integer read GetHeight;
 807   public
 808     property ID:             Cardinal                read fID             write SetID;
 809     property Target:         Cardinal                read fTarget         write SetTarget;
 810     property Format:         TglBitmapFormat         read fFormat         write SetFormat;
 811     property InternalFormat: TglBitmapInternalFormat read fInternalFormat write SetInternalFormat;
 812     property MipMap:         TglBitmapMipMap         read fMipMap      write SetMipMap;
 813     property Anisotropic:    Integer                 read fAnisotropic write SetAnisotropic;
 814
 815     property Filename:    String     read fFilename;
 816     property CustomName:  String     read fCustomName  write SetCustomName;
 817     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
 818     property CustomData:  Pointer    read fCustomData  write SetCustomData;
 819
 820     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
 821     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
 822
 823     property Dimension:      TglBitmapPixelPosition  read fDimension;
 824     property Data:           PByte                   read fData;
 825     property IsResident:     Boolean                 read fIsResident;
 826
 827     procedure AfterConstruction; override;
 828     procedure BeforeDestruction; override;
 829
 830     //Loading
 831     procedure LoadFromFile(const aFileName: String);
 832     procedure LoadFromStream(const aStream: TStream); virtual;
 833     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
 834       const aFormat: TglBitmapFormat; const aInternalFormat: TglBitmapInternalFormat;
 835       const aArgs: PtrInt = 0);
 836     {$IFDEF GLB_DELPHI}
 837     procedure LoadFromResource(Instance: Cardinal; Resource: String; ResType: PChar = nil);
 838     procedure LoadFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
 839     {$ENDIF}
 840
 841     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
 842     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 843
 844     //function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; Format: TglBitmapInternalFormat; CustomData: Pointer = nil): boolean; overload;
 845     //function AddFunc(const aFunc: TglBitmapFunction; CreateTemp: Boolean; CustomData: Pointer = nil): boolean; overload;
 846 (* TODO
 847     {$IFDEF GLB_SDL}
 848     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 849     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 850     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 851     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
 852       const aArgs: PtrInt = 0): Boolean;
 853     {$ENDIF}
 854
 855     {$IFDEF GLB_DELPHI}
 856     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 857     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 858     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 859     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
 860       const aArgs: PtrInt = 0): Boolean;
 861     {$ENDIF}
 862
 863     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
 864     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 865     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 866     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 867     {$IFDEF GLB_DELPHI}
 868     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
 869       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 870     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
 871       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
 872     {$ENDIF}
 873
 874     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 875     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 876     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 877
 878     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 879     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 880     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 881
 882     function RemoveAlpha: Boolean; virtual;
 883     function Clone: TglBitmap;
 884     function ConvertTo(const aFormat: TglBitmapFormat; const aInternalFormat: TglBitmapInternalFormat): Boolean; virtual;
 885     procedure SetBorderColor(Red, Green, Blue, Alpha: Single);
 886     procedure Invert(const aUseRGB: Boolean = true; aUseAlpha: Boolean = false);
 887     procedure FreeData;
 888
 889     procedure FillWithColor(const aRed, aGreen, aBlue: aByte; Alpha: Byte = 255);
 890     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 891     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
 892 *)
 893     procedure SetFilter(const aMin, aMag: Cardinal);
 894     procedure SetWrap(
 895       const S: Cardinal = GL_CLAMP_TO_EDGE;
 896       const T: Cardinal = GL_CLAMP_TO_EDGE;
 897       const R: Cardinal = GL_CLAMP_TO_EDGE);
 898
 899     procedure GetPixel(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);   virtual;
 900     procedure SetPixel(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData); virtual;
 901
 902     procedure Unbind(DisableTextureUnit: Boolean = True); virtual;
 903     procedure Bind(EnableTextureUnit: Boolean = True); virtual;
 904
 905     constructor Create; overload;
 906     constructor Create(FileName: String); overload;
 907     constructor Create(Stream: TStream); overload;
 908     {$IFDEF GLB_DELPHI}
 909     constructor CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar = nil);
 910     constructor Create(Instance: Cardinal; Resource: String; ResType: PChar = nil); overload;
 911     constructor Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar); overload;
 912     {$ENDIF}
 913     constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat); overload;
 914     constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat; Func: TglBitmapFunction; CustomData: Pointer = nil); overload;
 915   end;
 916
 917
 918   TglBitmap2D = class(TglBitmap)
 919   protected
 920     // Bildeinstellungen
 921     fLines: array of PByte;
 922
 923     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
 924     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 925     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 926     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 927     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 928     function GetScanline(Index: Integer): Pointer;
 929
 930     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
 931
 932     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
 933     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
 934   public
 935     property Width;
 936     property Height;
 937     property Scanline[Index: Integer]: Pointer read GetScanline;
 938
 939     procedure AfterConstruction; override;
 940
 941     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aInternalFormat: TglBitmapInternalFormat);
 942     procedure GetDataFromTexture;
 943     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3; const aScale: Single = 2; const aUseAlpha: Boolean = False);
 944     procedure GenTexture(TestTextureSize: Boolean = True); override;
 945
 946     function FlipHorz: Boolean; override;
 947     function FlipVert: Boolean; override;
 948   end;
 949
 950 (* TODO
 951   TglBitmapCubeMap = class(TglBitmap2D)
 952   protected
 953     fGenMode: Integer;
 954
 955     // Hide GenTexture
 956     procedure GenTexture(TestTextureSize: Boolean = True); reintroduce;
 957   public
 958     procedure AfterConstruction; override;
 959
 960     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
 961
 962     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = True); reintroduce; virtual;
 963     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = True); reintroduce; virtual;
 964   end;
 965
 966
 967   TglBitmapNormalMap = class(TglBitmapCubeMap)
 968   public
 969     procedure AfterConstruction; override;
 970
 971     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
 972   end;
 973
 974
 975   TglBitmap1D = class(TglBitmap)
 976   protected
 977     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
 978
 979     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
 980     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
 981   public
 982     // propertys
 983     property Width;
 984
 985     procedure AfterConstruction; override;
 986
 987     // Other
 988     function FlipHorz: Boolean; override;
 989
 990     // Generation
 991     procedure GenTexture(TestTextureSize: Boolean = True); override;
 992   end;
 993 *)
 994
 995 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
 996 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
 997 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
 998 procedure glBitmapSetDefaultInternalFormat(const aInternalFormat: TglBitmapInternalFormat);
 999 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1000 procedure glBitmapSetDefaultWrap(
1001   const S: Cardinal = GL_CLAMP_TO_EDGE;
1002   const T: Cardinal = GL_CLAMP_TO_EDGE;
1003   const R: Cardinal = GL_CLAMP_TO_EDGE);
1004
1005 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1006 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1007 function glBitmapGetDefaultFormat: TglBitmapFormat;
1008 function glBitmapGetDefaultInternalFormat: TglBitmapInternalFormat;
1009 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1010 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1011
1012 // position / size
1013 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1014
1015 // Formatfunctions
1016 function FormatGetSize(Format: TglBitmapInternalFormat): Single;
1017 function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1018 function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1019 function FormatIsEmpty(Format: TglBitmapInternalFormat): boolean;
1020 function FormatHasAlpha(Format: TglBitmapInternalFormat): Boolean;
1021 procedure FormatPreparePixel(var Pixel: TglBitmapPixelData; Format: TglBitmapInternalFormat);
1022 function FormatGetWithoutAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1023 function FormatGetWithAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1024 function FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; Format: TglBitmapInternalFormat): boolean;
1025
1026
1027 (* TODO
1028 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1029 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1030 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1031 *)
1032
1033 var
1034   glBitmapDefaultDeleteTextureOnFree: Boolean;
1035   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1036   glBitmapDefaultFormat: TglBitmapFormat;
1037   glBitmapDefaultInternalFormat: TglBitmapInternalFormat;
1038   glBitmapDefaultFilterMin: Cardinal;
1039   glBitmapDefaultFilterMag: Cardinal;
1040   glBitmapDefaultWrapS: Cardinal;
1041   glBitmapDefaultWrapT: Cardinal;
1042   glBitmapDefaultWrapR: Cardinal;
1043
1044 {$IFDEF GLB_DELPHI}
1045 function CreateGrayPalette: HPALETTE;
1046 {$ENDIF}
1047
1048 implementation
1049
1050 uses
1051   Math;
1052
1053 (* TODO
1054 {$IFNDEF GLB_NO_NATIVE_GL}
1055 procedure ReadOpenGLExtensions;
1056 var
1057   {$IFDEF GLB_DELPHI}
1058   Context: HGLRC;
1059   {$ENDIF}
1060   Buffer: AnsiString;
1061   MajorVersion, MinorVersion: Integer;
1062
1063
1064   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1065   var
1066     Separator: Integer;
1067   begin
1068     Minor := 0;
1069     Major := 0;
1070
1071     Separator := Pos(AnsiString('.'), Buffer);
1072
1073     if (Separator > 1) and (Separator < Length(Buffer)) and
1074        (Buffer[Separator - 1] in ['0'..'9']) and
1075        (Buffer[Separator + 1] in ['0'..'9']) then begin
1076
1077       Dec(Separator);
1078       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1079         Dec(Separator);
1080
1081       Delete(Buffer, 1, Separator);
1082       Separator := Pos(AnsiString('.'), Buffer) + 1;
1083
1084       while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1085         Inc(Separator);
1086
1087       Delete(Buffer, Separator, 255);
1088       Separator := Pos(AnsiString('.'), Buffer);
1089
1090       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1091       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1092     end;
1093   end;
1094
1095
1096   function CheckExtension(const Extension: AnsiString): Boolean;
1097   var
1098     ExtPos: Integer;
1099   begin
1100     ExtPos := Pos(Extension, Buffer);
1101     Result := ExtPos > 0;
1102
1103     if Result then
1104       Result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1105   end;
1106
1107
1108   function glLoad (aFunc: pAnsiChar): pointer;
1109   begin
1110     {$IFDEF LINUX}
1111       Result := glXGetProcAddress(aFunc);
1112     {$else}
1113       Result := wglGetProcAddress(aFunc);
1114     {$ENDIF}
1115   end;
1116
1117
1118 begin
1119   {$IFDEF GLB_DELPHI}
1120   Context := wglGetCurrentContext;
1121
1122   if Context <> gLastContext then begin
1123     gLastContext := Context;
1124   {$ENDIF}
1125
1126     // Version
1127     Buffer := glGetString(GL_VERSION);
1128     TrimVersionString(Buffer, MajorVersion, MinorVersion);
1129
1130     GL_VERSION_1_2 := False;
1131     GL_VERSION_1_3 := False;
1132     GL_VERSION_1_4 := False;
1133     GL_VERSION_2_0 := False;
1134
1135     if MajorVersion = 1 then begin
1136       if MinorVersion >= 1 then begin
1137         if MinorVersion >= 2 then
1138           GL_VERSION_1_2 := True;
1139
1140         if MinorVersion >= 3 then
1141           GL_VERSION_1_3 := True;
1142
1143         if MinorVersion >= 4 then
1144           GL_VERSION_1_4 := True;
1145       end;
1146     end;
1147
1148     if MajorVersion >= 2 then begin
1149       GL_VERSION_1_2 := True;
1150       GL_VERSION_1_3 := True;
1151       GL_VERSION_1_4 := True;
1152       GL_VERSION_2_0 := True;
1153     end;
1154
1155     // Extensions
1156     Buffer := glGetString(GL_EXTENSIONS);
1157     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
1158     GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
1159     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');
1160     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
1161     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
1162     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
1163     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');
1164     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
1165     GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
1166     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');
1167     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1168     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
1169     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
1170     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
1171     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
1172
1173     // Funtions
1174     if GL_VERSION_1_3 then begin
1175       // Loading Core
1176       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1177       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1178       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1179     end else
1180
1181     begin
1182       // Try loading Extension
1183       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1184       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1185       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1186     end;
1187   {$IFDEF GLB_DELPHI}
1188   end;
1189   {$ENDIF}
1190 end;
1191 {$ENDIF}
1192 *)
1193
1194 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1195 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1196 begin
1197   Result.Fields := [];
1198
1199   if X >= 0 then
1200     Result.Fields := Result.Fields + [ffX];
1201   if Y >= 0 then
1202     Result.Fields := Result.Fields + [ffY];
1203
1204   Result.X := Max(0, X);
1205   Result.Y := Max(0, Y);
1206 end;
1207
1208
1209 const
1210   LUMINANCE_WEIGHT_R = 0.30;
1211   LUMINANCE_WEIGHT_G = 0.59;
1212   LUMINANCE_WEIGHT_B = 0.11;
1213   UNSUPPORTED_INTERNAL_FORMAT = 'the given format isn''t supported by this function.';
1214
1215 {$REGION PixelDescription}
1216 const
1217   //ifAlpha4////////////////////////////////////////////////////////////////////////////////////////
1218   PIXEL_DESC_ALPHA4: TglBitmapPixelDesc = (
1219     RedRange:   $00000000; RedShift:   0;
1220     GreenRange: $00000000; GreenShift: 0;
1221     BlueRange:  $00000000; BlueShift:  0;
1222     AlphaRange: $0000000F; AlphaShift: 0);
1223
1224   //ifAlpha8
1225   PIXEL_DESC_ALPHA8: TglBitmapPixelDesc = (
1226     RedRange:   $00000000; RedShift:   0;
1227     GreenRange: $00000000; GreenShift: 0;
1228     BlueRange:  $00000000; BlueShift:  0;
1229     AlphaRange: $000000FF; AlphaShift: 0);
1230
1231   //ifAlpha12
1232   PIXEL_DESC_ALPHA12: TglBitmapPixelDesc = (
1233     RedRange:   $00000000; RedShift:   0;
1234     GreenRange: $00000000; GreenShift: 0;
1235     BlueRange:  $00000000; BlueShift:  0;
1236     AlphaRange: $00000FFF; AlphaShift: 0);
1237
1238   //ifAlpha16
1239   PIXEL_DESC_ALPHA16: TglBitmapPixelDesc = (
1240     RedRange:   $00000000; RedShift:   0;
1241     GreenRange: $00000000; GreenShift: 0;
1242     BlueRange:  $00000000; BlueShift:  0;
1243     AlphaRange: $0000FFFF; AlphaShift: 0);
1244
1245   //ifLuminance4////////////////////////////////////////////////////////////////////////////////////
1246   PIXEL_DESC_LUMINANCE4: TglBitmapPixelDesc = (
1247     RedRange:   $0000000F; RedShift:   0;
1248     GreenRange: $0000000F; GreenShift: 0;
1249     BlueRange:  $0000000F; BlueShift:  0;
1250     AlphaRange: $00000000; AlphaShift: 0);
1251
1252   //ifLuminance8
1253   PIXEL_DESC_LUMINANCE8: TglBitmapPixelDesc = (
1254     RedRange:   $000000FF; RedShift:   0;
1255     GreenRange: $000000FF; GreenShift: 0;
1256     BlueRange:  $000000FF; BlueShift:  0;
1257     AlphaRange: $00000000; AlphaShift: 0);
1258
1259   //ifLuminance12
1260   PIXEL_DESC_LUMINANCE12: TglBitmapPixelDesc = (
1261     RedRange:   $00000FFF; RedShift:   0;
1262     GreenRange: $00000FFF; GreenShift: 0;
1263     BlueRange:  $00000FFF; BlueShift:  0;
1264     AlphaRange: $00000000; AlphaShift: 0);
1265
1266   //ifLuminance16
1267   PIXEL_DESC_LUMINANCE16: TglBitmapPixelDesc = (
1268     RedRange:   $0000FFFF; RedShift:   0;
1269     GreenRange: $0000FFFF; GreenShift: 0;
1270     BlueRange:  $0000FFFF; BlueShift:  0;
1271     AlphaRange: $00000000; AlphaShift: 0);
1272
1273   //ifLuminance4Alpha4//////////////////////////////////////////////////////////////////////////////
1274   PIXEL_DESC_LUMINANCE4_ALPHA4: TglBitmapPixelDesc = (
1275     RedRange:   $0000000F; RedShift:   0;
1276     GreenRange: $0000000F; GreenShift: 0;
1277     BlueRange:  $0000000F; BlueShift:  0;
1278     AlphaRange: $0000000F; AlphaShift: 4);
1279   //ifLuminance6Alpha2
1280   PIXEL_DESC_LUMINANCE6_ALPHA2: TglBitmapPixelDesc = (
1281     RedRange:   $0000003F; RedShift:   0;
1282     GreenRange: $0000003F; GreenShift: 0;
1283     BlueRange:  $0000003F; BlueShift:  0;
1284     AlphaRange: $00000003; AlphaShift: 6);
1285
1286   //ifLuminance8Alpha8
1287   PIXEL_DESC_LUMINANCE8_ALPHA8: TglBitmapPixelDesc = (
1288     RedRange:   $000000FF; RedShift:   0;
1289     GreenRange: $000000FF; GreenShift: 0;
1290     BlueRange:  $000000FF; BlueShift:  0;
1291     AlphaRange: $000000FF; AlphaShift: 8);
1292
1293   //ifLuminance12Alpha4
1294   PIXEL_DESC_LUMINANCE12_ALPHA4: TglBitmapPixelDesc = (
1295     RedRange:   $00000FFF; RedShift:   0;
1296     GreenRange: $00000FFF; GreenShift: 0;
1297     BlueRange:  $00000FFF; BlueShift:  0;
1298     AlphaRange: $0000000F; AlphaShift: 12);
1299
1300   //ifLuminance12Alpha12
1301   PIXEL_DESC_LUMINANCE12_ALPHA12: TglBitmapPixelDesc = (
1302     RedRange:   $00000FFF; RedShift:   0;
1303     GreenRange: $00000FFF; GreenShift: 0;
1304     BlueRange:  $00000FFF; BlueShift:  0;
1305     AlphaRange: $00000FFF; AlphaShift: 12);
1306
1307   //ifLuminance16Alpha16
1308   PIXEL_DESC_LUMINANCE16_ALPHA16: TglBitmapPixelDesc = (
1309     RedRange:   $0000FFFF; RedShift:   0;
1310     GreenRange: $0000FFFF; GreenShift: 0;
1311     BlueRange:  $0000FFFF; BlueShift:  0;
1312     AlphaRange: $0000FFFF; AlphaShift: 16);
1313
1314   //ifR3G3B2////////////////////////////////////////////////////////////////////////////////////////
1315   PIXEL_DESC_R3_G3_B2: TglBitmapPixelDesc = (
1316     RedRange:   $00000007; RedShift:   0;
1317     GreenRange: $00000007; GreenShift: 3;
1318     BlueRange:  $00000003; BlueShift:  6;
1319     AlphaRange: $00000000; AlphaShift: 0);
1320
1321   //ifRGB4
1322   PIXEL_DESC_RGB4: TglBitmapPixelDesc = (
1323     RedRange:   $0000000F; RedShift:   0;
1324     GreenRange: $0000000F; GreenShift: 4;
1325     BlueRange:  $0000000F; BlueShift:  8;
1326     AlphaRange: $00000000; AlphaShift: 0);
1327
1328   //ifRGB5
1329   PIXEL_DESC_RGB5: TglBitmapPixelDesc = (
1330     RedRange:   $0000001F; RedShift:   0;
1331     GreenRange: $0000001F; GreenShift: 5;
1332     BlueRange:  $0000001F; BlueShift:  10;
1333     AlphaRange: $00000000; AlphaShift: 0);
1334
1335   //ifRGB8
1336   PIXEL_DESC_RGB8: TglBitmapPixelDesc = (
1337     RedRange:   $000000FF; RedShift:   0;
1338     GreenRange: $000000FF; GreenShift: 8;
1339     BlueRange:  $000000FF; BlueShift:  16;
1340     AlphaRange: $00000000; AlphaShift: 0);
1341
1342   //ifRGB10
1343   PIXEL_DESC_RGB10: TglBitmapPixelDesc = (
1344     RedRange:   $000003FF; RedShift:   0;
1345     GreenRange: $000003FF; GreenShift: 10;
1346     BlueRange:  $000003FF; BlueShift:  20;
1347     AlphaRange: $000003FF; AlphaShift: 0);
1348
1349   //ifRGB12
1350   PIXEL_DESC_RGB12: TglBitmapPixelDesc = (
1351     RedRange:   $00000000; RedShift:   0;
1352     GreenRange: $00000000; GreenShift: 0;
1353     BlueRange:  $00000000; BlueShift:  0;
1354     AlphaRange: $00000000; AlphaShift: 0);
1355
1356   //ifRGB16
1357   PIXEL_DESC_RGB16: TglBitmapPixelDesc = (
1358     RedRange:   $0000FFFF; RedShift:   0;
1359     GreenRange: $0000FFFF; GreenShift: 16;
1360     BlueRange:  $0000FFFF; BlueShift:  32;
1361     AlphaRange: $0000FFFF; AlphaShift: 0);
1362
1363   //ifRGBA2/////////////////////////////////////////////////////////////////////////////////////////
1364   PIXEL_DESC_RGBA2: TglBitmapPixelDesc = (
1365     RedRange:   $00000003; RedShift:   0;
1366     GreenRange: $00000003; GreenShift: 2;
1367     BlueRange:  $00000003; BlueShift:  4;
1368     AlphaRange: $00000003; AlphaShift: 6);
1369
1370   //ifRGBA4
1371   PIXEL_DESC_RGBA4: TglBitmapPixelDesc = (
1372     RedRange:   $0000000F; RedShift:   0;
1373     GreenRange: $0000000F; GreenShift: 4;
1374     BlueRange:  $0000000F; BlueShift:  8;
1375     AlphaRange: $0000000F; AlphaShift: 12);
1376
1377   //ifRGB5A1
1378   PIXEL_DESC_RGB5_A1: TglBitmapPixelDesc = (
1379     RedRange:   $0000001F; RedShift:   0;
1380     GreenRange: $0000001F; GreenShift: 5;
1381     BlueRange:  $0000001F; BlueShift:  10;
1382     AlphaRange: $00000001; AlphaShift: 11);
1383
1384   //ifRGBA8
1385   PIXEL_DESC_RGBA8: TglBitmapPixelDesc = (
1386     RedRange:   $000000FF; RedShift:   0;
1387     GreenRange: $000000FF; GreenShift: 8;
1388     BlueRange:  $000000FF; BlueShift:  16;
1389     AlphaRange: $000000FF; AlphaShift: 24);
1390
1391   //ifRGB10A2
1392   PIXEL_DESC_RGB10_A2: TglBitmapPixelDesc = (
1393     RedRange:   $000003FF; RedShift:   0;
1394     GreenRange: $000003FF; GreenShift: 10;
1395     BlueRange:  $000003FF; BlueShift:  20;
1396     AlphaRange: $00000003; AlphaShift: 22);
1397
1398   //ifRGBA12
1399   PIXEL_DESC_RGBA12: TglBitmapPixelDesc = (
1400     RedRange:   $00000FFF; RedShift:   0;
1401     GreenRange: $00000FFF; GreenShift: 12;
1402     BlueRange:  $00000FFF; BlueShift:  24;
1403     AlphaRange: $00000FFF; AlphaShift: 36);
1404
1405   //ifRGBA16
1406   PIXEL_DESC_RGBA16: TglBitmapPixelDesc = (
1407     RedRange:   $0000FFFF; RedShift:   0;
1408     GreenRange: $0000FFFF; GreenShift: 16;
1409     BlueRange:  $0000FFFF; BlueShift:  32;
1410     AlphaRange: $0000FFFF; AlphaShift: 48);
1411
1412   //ifDepthComponent16//////////////////////////////////////////////////////////////////////////////
1413   PIXEL_DESC_DEPTH16: TglBitmapPixelDesc = (
1414     RedRange:   $0000FFFF; RedShift:   0;
1415     GreenRange: $0000FFFF; GreenShift: 0;
1416     BlueRange:  $0000FFFF; BlueShift:  0;
1417     AlphaRange: $0000FFFF; AlphaShift: 0);
1418
1419   //ifDepthComponent24
1420   PIXEL_DESC_DEPTH24: TglBitmapPixelDesc = (
1421     RedRange:   $00FFFFFF; RedShift:   0;
1422     GreenRange: $00FFFFFF; GreenShift: 0;
1423     BlueRange:  $00FFFFFF; BlueShift:  0;
1424     AlphaRange: $00FFFFFF; AlphaShift: 0);
1425
1426   //ifDepthComponent32
1427   PIXEL_DESC_DEPTH32: TglBitmapPixelDesc = (
1428     RedRange:   $FFFFFFFF; RedShift:   0;
1429     GreenRange: $FFFFFFFF; GreenShift: 0;
1430     BlueRange:  $FFFFFFFF; BlueShift:  0;
1431     AlphaRange: $00000000; AlphaShift: 0);
1432 {$ENDREGION}
1433
1434 {$REGION MapFunctions}
1435 //ALPHA/////////////////////////////////////////////////////////////////////////////////////////////
1436 procedure MapAlpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1437 begin
1438   //TODO
1439 end;
1440
1441 procedure MapAlpha8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1442 begin
1443   aData^ := aPixel.Alpha;
1444   inc(aData);
1445 end;
1446
1447 procedure MapAlpha12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1448 begin
1449   //TODO
1450 end;
1451
1452 procedure MapAlpha16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1453 begin
1454   PWord(aData)^ := aPixel.Alpha;
1455   inc(aData, 2);
1456 end;
1457
1458 //LUMINANCE/////////////////////////////////////////////////////////////////////////////////////////
1459 procedure MapLuminance4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1460 begin
1461   //TODO
1462 end;
1463
1464 procedure MapLuminance8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1465 begin
1466   aData^ := Trunc(
1467     aPixel.Red   * LUMINANCE_WEIGHT_R +
1468     aPixel.Green * LUMINANCE_WEIGHT_G +
1469     aPixel.Blue  * LUMINANCE_WEIGHT_B);
1470   inc(aData);
1471 end;
1472
1473 procedure MapLuminance12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1474 begin
1475   //TODO
1476 end;
1477
1478 procedure MapLuminance16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1479 begin
1480   PWord(aData)^ := Trunc(
1481     aPixel.Red   * LUMINANCE_WEIGHT_R +
1482     aPixel.Green * LUMINANCE_WEIGHT_G +
1483     aPixel.Blue  * LUMINANCE_WEIGHT_B);
1484   inc(aData, 2);
1485 end;
1486
1487 //LUMINANCE_ALPHA///////////////////////////////////////////////////////////////////////////////////
1488 procedure MapLuminance4Alpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1489 begin
1490   aData^ :=
1491     ((Trunc(aPixel.Red   * LUMINANCE_WEIGHT_R +
1492             aPixel.Green * LUMINANCE_WEIGHT_G +
1493             aPixel.Blue  * LUMINANCE_WEIGHT_B) and
1494       aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or
1495     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift;
1496   inc(aData);
1497 end;
1498
1499 procedure MapLuminance6Alpha2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1500 begin
1501   MapLuminance4Alpha4(aPixel, aData, aBitOffset);
1502 end;
1503
1504 procedure MapLuminance8Alpha8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1505 begin
1506   PWord(aData)^ :=
1507     ((Trunc(aPixel.Red   * LUMINANCE_WEIGHT_R +
1508             aPixel.Green * LUMINANCE_WEIGHT_G +
1509             aPixel.Blue  * LUMINANCE_WEIGHT_B) and
1510       aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or
1511     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift;
1512   inc(aData, 2);
1513 end;
1514
1515 procedure MapLuminance12Alpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1516 begin
1517   MapLuminance8Alpha8(aPixel, aData, aBitOffset);
1518 end;
1519
1520 procedure MapLuminance12Alpha12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1521 begin
1522   //TODO
1523 end;
1524
1525 procedure MapLuminance16Alpha16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1526 begin
1527   PCardinal(aData)^ :=
1528     ((Trunc(aPixel.Red   * LUMINANCE_WEIGHT_R +
1529             aPixel.Green * LUMINANCE_WEIGHT_G +
1530             aPixel.Blue  * LUMINANCE_WEIGHT_B) and
1531       aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or
1532     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift;
1533   inc(aData, 4);
1534 end;
1535
1536 //RGB///////////////////////////////////////////////////////////////////////////////////////////////
1537 procedure MapR3G3B2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1538 begin
1539   aData^ :=
1540     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1541     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1542     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift);
1543   inc(aData);
1544 end;
1545
1546 procedure MapRGB4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1547 begin
1548   //TODO
1549 end;
1550
1551 procedure MapRGB5(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1552 begin
1553   //TODO
1554 end;
1555
1556 procedure MapRGB8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1557 begin
1558   PCardinal(aData)^ :=
1559     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1560     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1561     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift);
1562   inc(aData, 3);
1563 end;
1564
1565 procedure MapRGB10(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1566 begin
1567   //TODO
1568 end;
1569
1570 procedure MapRGB12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1571 begin
1572   //TODO
1573 end;
1574
1575 procedure MapRGB16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1576 begin
1577   PWord(aData)^ := aPixel.Red;
1578   inc(aData, 2);
1579   PWord(aData)^ := aPixel.Green;
1580   inc(aData, 2);
1581   PWord(aData)^ := aPixel.Blue;
1582   inc(aData, 2);
1583 end;
1584
1585 //RGBA//////////////////////////////////////////////////////////////////////////////////////////////
1586 procedure MapRGBA2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1587 begin
1588   aData^ :=
1589     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1590     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1591     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
1592     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
1593   inc(aData);
1594 end;
1595
1596 procedure MapRGBA4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1597 begin
1598   PWord(aData)^ :=
1599     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1600     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1601     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
1602     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
1603   inc(aData, 2);
1604 end;
1605
1606 procedure MapRGB5A1(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1607 begin
1608   PWord(aData)^ :=
1609     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1610     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1611     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
1612     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
1613   inc(aData, 2);
1614 end;
1615
1616 procedure MapRGBA8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1617 begin
1618   PCardinal(aData)^ :=
1619     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1620     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1621     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
1622     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
1623   inc(aData, 4);
1624 end;
1625
1626 procedure MapRGB10A2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1627 begin
1628   PCardinal(aData)^ :=
1629     ((aPixel.Red   and aPixel.PixelDesc.RedRange)   shl aPixel.PixelDesc.RedShift)   or
1630     ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
1631     ((aPixel.Blue  and aPixel.PixelDesc.BlueRange)  shl aPixel.PixelDesc.BlueShift)  or
1632     ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
1633   inc(aData, 4);
1634 end;
1635
1636 procedure MapRGBA12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1637 begin
1638   //TODO
1639 end;
1640
1641 procedure MapRGBA16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1642 begin
1643   PWord(aData)^ := aPixel.Red;
1644   inc(aData, 2);
1645   PWord(aData)^ := aPixel.Green;
1646   inc(aData, 2);
1647   PWord(aData)^ := aPixel.Blue;
1648   inc(aData, 2);
1649   PWord(aData)^ := aPixel.Alpha;
1650   inc(aData, 2);
1651 end;
1652
1653 //DEPTH/////////////////////////////////////////////////////////////////////////////////////////////
1654 procedure MapDepth16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1655 begin
1656   PWord(aData)^ := (aPixel.Red + aPixel.Green + aPixel.Blue) div 3;
1657   inc(aData, 2);
1658 end;
1659
1660 procedure MapDepth24(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1661 begin
1662   //TODO
1663 end;
1664
1665 procedure MapDepth32(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1666 begin
1667   PCardinal(aData)^ := (aPixel.Red + aPixel.Green + aPixel.Blue) div 3;
1668   inc(aData, 4);
1669 end;
1670
1671 function FormatGetMapFunc(const aInternalFormat: TglBitmapInternalFormat): TglBitmapMapFunc;
1672 begin
1673   case aInternalFormat of
1674     ifAlpha4:  result := MapAlpha4;
1675     ifAlpha8:  result := MapAlpha8;
1676     ifAlpha12: result := MapAlpha12;
1677     ifAlpha16: result := MapAlpha16;
1678
1679     ifLuminance4:  result := MapLuminance4;
1680     ifLuminance8:  result := MapLuminance8;
1681     ifLuminance12: result := MapLuminance8;
1682     ifLuminance16: result := MapLuminance8;
1683
1684     ifLuminance4Alpha4:   result := MapLuminance4Alpha4;
1685     ifLuminance6Alpha2:   result := MapLuminance6Alpha2;
1686     ifLuminance8Alpha8:   result := MapLuminance8Alpha8;
1687     ifLuminance12Alpha4:  result := MapLuminance12Alpha4;
1688     ifLuminance12Alpha12: result := MapLuminance12Alpha12;
1689     ifLuminance16Alpha16: result := MapLuminance16Alpha16;
1690
1691     ifR3G3B2: result := MapR3G3B2;
1692     ifRGB4:   result := MapRGB4;
1693     ifRGB5:   result := MapRGB5;
1694     ifRGB8:   result := MapRGB8;
1695     ifRGB10:  result := MapRGB10;
1696     ifRGB12:  result := MapRGB12;
1697     ifRGB16:  result := MapRGB16;
1698
1699     ifRGBA2:   result := MapRGBA2;
1700     ifRGBA4:   result := MapRGBA4;
1701     ifRGB5A1:  result := MapRGB5A1;
1702     ifRGBA8:   result := MapRGBA8;
1703     ifRGB10A2: result := MapRGB10A2;
1704     ifRGBA12:  result := MapRGBA12;
1705     ifRGBA16:  result := MapRGBA16;
1706
1707     ifDepth16: result := MapDepth16;
1708     ifDepth24: result := MapDepth24;
1709     ifDepth32: result := MapDepth32;
1710   else
1711     raise EglBitmapUnsupportedInternalFormat.Create('FormatGetMapFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
1712   end;
1713 end;
1714 {$ENDREGION}
1715
1716 {$REGION UnmapFunctions}
1717 //ALPHA/////////////////////////////////////////////////////////////////////////////////////////////
1718 procedure UnmapAlpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1719 begin
1720   //TODO
1721 end;
1722
1723 procedure UnmapAlpha8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1724 begin
1725
1726 end;
1727
1728 procedure UnmapAlpha12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1729 begin
1730   //TODO
1731 end;
1732
1733 procedure UnmapAlpha16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1734 begin
1735
1736 end;
1737
1738 //LUMINANCE/////////////////////////////////////////////////////////////////////////////////////////
1739 procedure UnmapLuminance4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1740 begin
1741   //TODO
1742 end;
1743
1744 procedure UnmapLuminance8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1745 begin
1746
1747 end;
1748
1749 procedure UnmapLuminance12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1750 begin
1751   //TODO
1752 end;
1753
1754 procedure UnmapLuminance16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1755 begin
1756
1757 end;
1758
1759 //LUMINANCE_ALPHA///////////////////////////////////////////////////////////////////////////////////
1760 procedure UnmapLuminance4Alpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1761 begin
1762
1763 end;
1764
1765 procedure UnmapLuminance6Alpha2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1766 begin
1767
1768 end;
1769
1770 procedure UnmapLuminance8Alpha8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1771 begin
1772
1773 end;
1774
1775 procedure UnmapLuminance12Alpha4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1776 begin
1777
1778 end;
1779
1780 procedure UnmapLuminance12Alpha12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1781 begin
1782   //TODO
1783 end;
1784
1785 procedure UnmapLuminance16Alpha16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1786 begin
1787
1788 end;
1789
1790 //RGB///////////////////////////////////////////////////////////////////////////////////////////////
1791 procedure UnmapR3G3B2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1792 begin
1793
1794 end;
1795
1796 procedure UnmapRGB4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1797 begin
1798   //TODO
1799 end;
1800
1801 procedure UnmapRGB5(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1802 begin
1803   //TODO
1804 end;
1805
1806 procedure UnmapRGB8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1807 begin
1808
1809 end;
1810
1811 procedure UnmapRGB10(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1812 begin
1813   //TODO
1814 end;
1815
1816 procedure UnmapRGB12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1817 begin
1818   //TODO
1819 end;
1820
1821 procedure UnmapRGB16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1822 begin
1823
1824 end;
1825
1826 //RGBA//////////////////////////////////////////////////////////////////////////////////////////////
1827 procedure UnmapRGBA2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1828 begin
1829
1830 end;
1831
1832 procedure UnmapRGBA4(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1833 begin
1834
1835 end;
1836
1837 procedure UnmapRGB5A1(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1838 begin
1839
1840 end;
1841
1842 procedure UnmapRGBA8(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1843 begin
1844
1845 end;
1846
1847 procedure UnmapRGB10A2(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1848 begin
1849
1850 end;
1851
1852 procedure UnmapRGBA12(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1853 begin
1854   //TODO
1855 end;
1856
1857 procedure UnmapRGBA16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1858 begin
1859
1860 end;
1861
1862 //DEPTH/////////////////////////////////////////////////////////////////////////////////////////////
1863 procedure UnmapDepth16(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1864 begin
1865
1866 end;
1867
1868 procedure UnmapDepth24(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1869 begin
1870   //TODO
1871 end;
1872
1873 procedure UnmapDepth32(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
1874 begin
1875
1876 end;
1877
1878
1879
1880
1881 procedure UnMapAlpha(var pData: pByte; var Pixel: TglBitmapPixelData);
1882 begin
1883   Pixel.Alpha := pData^;
1884   Pixel.Red   := Pixel.PixelDesc.RedRange;
1885   Pixel.Green := Pixel.PixelDesc.GreenRange;
1886   Pixel.Blue  := Pixel.PixelDesc.BlueRange;
1887
1888   Inc(pData);
1889 end;
1890
1891
1892 procedure UnMapLuminance(var pData: pByte; var Pixel: TglBitmapPixelData);
1893 begin
1894   Pixel.Alpha := 255;
1895   Pixel.Red   := pData^;
1896   Pixel.Green := pData^;
1897   Pixel.Blue  := pData^;
1898
1899   Inc(pData);
1900 end;
1901
1902
1903 procedure UnMapDepth8(var pData: pByte; var Pixel: TglBitmapPixelData);
1904 begin
1905   Pixel.Alpha := 255;
1906   Pixel.Red   := pData^;
1907   Pixel.Green := pData^;
1908   Pixel.Blue  := pData^;
1909
1910   Inc(pData);
1911 end;
1912
1913
1914 procedure UnMapLuminanceAlpha(var pData: pByte; var Pixel: TglBitmapPixelData);
1915 begin
1916   Pixel.Red   := pData^;
1917   Pixel.Green := pData^;
1918   Pixel.Blue  := pData^;
1919   Inc(pData);
1920
1921   Pixel.Alpha := pData^;
1922   Inc(pData);
1923 end;
1924
1925
1926 procedure UnMapRGBA4(var pData: pByte; var Pixel: TglBitmapPixelData);
1927 var
1928   Temp: Word;
1929 begin
1930   Temp := pWord(pData)^;
1931
1932   Pixel.Alpha := Temp shr PIXEL_DESC_RGBA4.AlphaShift and PIXEL_DESC_RGBA4.AlphaRange;
1933   Pixel.Red   := Temp shr PIXEL_DESC_RGBA4.RedShift   and PIXEL_DESC_RGBA4.RedRange;
1934   Pixel.Green := Temp shr PIXEL_DESC_RGBA4.GreenShift and PIXEL_DESC_RGBA4.GreenRange;
1935   Pixel.Blue  := Temp                                 and PIXEL_DESC_RGBA4.BlueRange;
1936
1937   Inc(pData, 2);
1938 end;
1939
1940
1941 procedure UnMapR5G6B5(var pData: pByte; var Pixel: TglBitmapPixelData);
1942 var
1943   Temp: Word;
1944 begin
1945   Temp := pWord(pData)^;
1946
1947   Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1948   Pixel.Red   := Temp shr PIXEL_DESC_R5G6B5.RedShift   and PIXEL_DESC_R5G6B5.RedRange;
1949   Pixel.Green := Temp shr PIXEL_DESC_R5G6B5.GreenShift and PIXEL_DESC_R5G6B5.GreenRange;
1950   Pixel.Blue  := Temp                                  and PIXEL_DESC_R5G6B5.BlueRange;
1951
1952   Inc(pData, 2);
1953 end;
1954
1955
1956 procedure UnMapRGB5A1(var pData: pByte; var Pixel: TglBitmapPixelData);
1957 var
1958   Temp: Word;
1959 begin
1960   Temp := pWord(pData)^;
1961
1962   Pixel.Alpha := Temp shr PIXEL_DESC_RGB5A1.AlphaShift and PIXEL_DESC_RGB5A1.AlphaRange;
1963   Pixel.Red   := Temp shr PIXEL_DESC_RGB5A1.RedShift   and PIXEL_DESC_RGB5A1.RedRange;
1964   Pixel.Green := Temp shr PIXEL_DESC_RGB5A1.GreenShift and PIXEL_DESC_RGB5A1.GreenRange;
1965   Pixel.Blue  := Temp                                  and PIXEL_DESC_RGB5A1.BlueRange;
1966
1967   Inc(pData, 2);
1968 end;
1969
1970
1971 procedure UnMapRGB8(var pData: pByte; var Pixel: TglBitmapPixelData);
1972 begin
1973   Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1974
1975   Pixel.Red   := pData^;
1976   Inc(pData);
1977
1978   Pixel.Green := pData^;
1979   Inc(pData);
1980
1981   Pixel.Blue  := pData^;
1982   Inc(pData);
1983 end;
1984
1985
1986 procedure UnMapBGR8(var pData: pByte; var Pixel: TglBitmapPixelData);
1987 begin
1988   Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1989
1990   Pixel.Blue  := pData^;
1991   Inc(pData);
1992
1993   Pixel.Green := pData^;
1994   Inc(pData);
1995
1996   Pixel.Red   := pData^;
1997   Inc(pData);
1998 end;
1999
2000
2001 procedure UnMapRGBA8(var pData: pByte; var Pixel: TglBitmapPixelData);
2002 begin
2003   Pixel.Red   := pData^;
2004   Inc(pData);
2005
2006   Pixel.Green := pData^;
2007   Inc(pData);
2008
2009   Pixel.Blue  := pData^;
2010   Inc(pData);
2011
2012   Pixel.Alpha := pData^;
2013   Inc(pData);
2014 end;
2015
2016
2017 procedure UnMapBGRA8(var pData: pByte; var Pixel: TglBitmapPixelData);
2018 begin
2019   Pixel.Blue  := pData^;
2020   Inc(pData);
2021
2022   Pixel.Green := pData^;
2023   Inc(pData);
2024
2025   Pixel.Red   := pData^;
2026   Inc(pData);
2027
2028   Pixel.Alpha := pData^;
2029   Inc(pData);
2030 end;
2031
2032
2033 procedure UnMapRGB10A2(var pData: pByte; var Pixel: TglBitmapPixelData);
2034 var
2035   Temp: DWord;
2036 begin
2037   Temp := pDWord(pData)^;
2038
2039   Pixel.Alpha := Temp shr PIXEL_DESC_RGB10A2.AlphaShift and PIXEL_DESC_RGB10A2.AlphaRange;
2040   Pixel.Red   := Temp shr PIXEL_DESC_RGB10A2.RedShift   and PIXEL_DESC_RGB10A2.RedRange;
2041   Pixel.Green := Temp shr PIXEL_DESC_RGB10A2.GreenShift and PIXEL_DESC_RGB10A2.GreenRange;
2042   Pixel.Blue  := Temp                                   and PIXEL_DESC_RGB10A2.BlueRange;
2043
2044   Inc(pData, 4);
2045 end;
2046
2047
2048 function FormatGetUnMapFunc(const aInternalFormat: TglBitmapInternalFormat): TglBitmapUnMapFunc;
2049 begin
2050   case aInternalFormat of
2051     ifAlpha4:  result := UnmapAlpha4;
2052     ifAlpha8:  result := UnmapAlpha8;
2053     ifAlpha12: result := UnmapAlpha12;
2054     ifAlpha16: result := UnmapAlpha16;
2055
2056     ifLuminance4:  result := UnmapLuminance4;
2057     ifLuminance8:  result := UnmapLuminance8;
2058     ifLuminance12: result := UnmapLuminance8;
2059     ifLuminance16: result := UnmapLuminance8;
2060
2061     ifLuminance4Alpha4:   result := UnmapLuminance4Alpha4;
2062     ifLuminance6Alpha2:   result := UnmapLuminance6Alpha2;
2063     ifLuminance8Alpha8:   result := UnmapLuminance8Alpha8;
2064     ifLuminance12Alpha4:  result := UnmapLuminance12Alpha4;
2065     ifLuminance12Alpha12: result := UnmapLuminance12Alpha12;
2066     ifLuminance16Alpha16: result := UnmapLuminance16Alpha16;
2067
2068     ifR3G3B2: result := UnmapR3G3B2;
2069     ifRGB4:   result := UnmapRGB4;
2070     ifRGB5:   result := UnmapRGB5;
2071     ifRGB8:   result := UnmapRGB8;
2072     ifRGB10:  result := UnmapRGB10;
2073     ifRGB12:  result := UnmapRGB12;
2074     ifRGB16:  result := UnmapRGB16;
2075
2076     ifRGBA2:   result := UnmapRGBA2;
2077     ifRGBA4:   result := UnmapRGBA4;
2078     ifRGB5A1:  result := UnmapRGB5A1;
2079     ifRGBA8:   result := UnmapRGBA8;
2080     ifRGB10A2: result := UnmapRGB10A2;
2081     ifRGBA12:  result := UnmapRGBA12;
2082     ifRGBA16:  result := UnmapRGBA16;
2083
2084     ifDepth16: result := UnmapDepth16;
2085     ifDepth24: result := UnmapDepth24;
2086     ifDepth32: result := UnmapDepth32;
2087   else
2088     raise EglBitmapUnsupportedInternalFormat.Create('FormatGetMapFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
2089   end;
2090 end;
2091 {$ENDREGION}
2092
2093 {*
2094 ** Tools
2095 *}
2096 function FormatGetSize (Format: TglBitmapInternalFormat): Single;
2097 begin
2098   case Format of
2099     ifEmpty:
2100       Result := 0;
2101     ifDXT1:
2102       Result := 0.5;
2103     ifAlpha, ifLuminance, ifDepth8, ifDXT3, ifDXT5:
2104       Result := 1;
2105     ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5:
2106       Result := 2;
2107     ifBGR8, ifRGB8:
2108       Result := 3;
2109     ifBGRA8, ifRGBA8, ifRGB10A2:
2110       Result := 4;
2111     else
2112       raise EglBitmapUnsupportedInternalFormat.Create('FormatGetSize - ' + UNSUPPORTED_INTERNAL_FORMAT);
2113   end;
2114 end;
2115
2116
2117 function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
2118 begin
2119   Result := Format in [ifDXT1, ifDXT3, ifDXT5];
2120 end;
2121
2122
2123 function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
2124 begin
2125   Result := Format in [ifAlpha, ifLuminance, ifDepth8, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5, ifBGR8, ifRGB8, ifBGRA8, ifRGBA8, ifRGB10A2];
2126 end;
2127
2128
2129 function FormatIsEmpty(Format: TglBitmapInternalFormat): boolean;
2130 begin
2131   Result := Format = ifEmpty;
2132 end;
2133
2134
2135 function FormatHasAlpha(Format: TglBitmapInternalFormat): Boolean;
2136 begin
2137   Result := Format in [ifDXT1, ifDXT3, ifDXT5 ,ifAlpha, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifBGRA8, ifRGBA8, ifRGB10A2];
2138 end;
2139
2140
2141 procedure FormatPreparePixel(var Pixel: TglBitmapPixelData; Format: TglBitmapInternalFormat);
2142 begin
2143   FillChar(Pixel, SizeOf(Pixel), #0);
2144
2145   case Format of
2146     ifAlpha:
2147       Pixel.PixelDesc := PIXEL_DESC_ALPHA;
2148     ifLuminance:
2149       Pixel.PixelDesc := PIXEL_DESC_LUMINANCE;
2150     ifDepth8:
2151       Pixel.PixelDesc := PIXEL_DESC_DEPTH8;
2152     ifLuminanceAlpha:
2153       Pixel.PixelDesc := PIXEL_DESC_LUMINANCEALPHA;
2154     ifRGBA4:
2155       Pixel.PixelDesc := PIXEL_DESC_RGBA4;
2156     ifR5G6B5:
2157       Pixel.PixelDesc := PIXEL_DESC_R5G6B5;
2158     ifRGB5A1:
2159       Pixel.PixelDesc := PIXEL_DESC_RGB5A1;
2160     ifDXT1, ifDXT3, ifDXT5, ifBGRA8:
2161       Pixel.PixelDesc := PIXEL_DESC_BGRA8;
2162     ifBGR8:
2163       Pixel.PixelDesc := PIXEL_DESC_BGR8;
2164     ifRGB8:
2165       Pixel.PixelDesc := PIXEL_DESC_RGB8;
2166     ifRGBA8:
2167       Pixel.PixelDesc := PIXEL_DESC_RGBA8;
2168     ifRGB10A2:
2169       Pixel.PixelDesc := PIXEL_DESC_RGB10A2;
2170   end;
2171
2172   Pixel.Red   := Pixel.PixelDesc.RedRange;
2173   Pixel.Green := Pixel.PixelDesc.GreenRange;
2174   Pixel.Blue  := Pixel.PixelDesc.BlueRange;
2175   Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
2176 end;
2177
2178
2179 function FormatGetWithoutAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
2180 begin
2181   case Format of
2182     ifAlpha:
2183       Result := ifLuminance;
2184     ifLuminanceAlpha:
2185       Result := ifLuminance;
2186     ifRGBA4:
2187       Result := ifR5G6B5;
2188     ifRGB5A1:
2189       Result := ifR5G6B5;
2190     ifBGRA8:
2191       Result := ifBGR8;
2192     ifRGBA8:
2193       Result := ifRGB8;
2194     ifRGB10A2:
2195       Result := ifRGB8;
2196     else
2197       Result := Format;
2198   end;
2199 end;
2200
2201
2202 function FormatGetWithAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
2203 begin
2204   case Format of
2205     ifLuminance:
2206       Result := ifLuminanceAlpha;
2207     ifR5G6B5:
2208       Result := ifRGB5A1;
2209     ifBGR8:
2210       Result := ifBGRA8;
2211     ifRGB8:
2212       Result := ifRGBA8;
2213     else
2214       Result := Format;
2215   end;
2216 end;
2217
2218
2219 function FormatGetUncompressed(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
2220 begin
2221   case Format of
2222     ifDXT1:
2223       Result := ifRGB5A1;
2224     ifDXT3:
2225       Result := ifRGBA8;
2226     ifDXT5:
2227       Result := ifRGBA8;
2228     else
2229       Result := Format;
2230   end;
2231 end;
2232
2233
2234 function FormatGetImageSize(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat): Integer;
2235 begin
2236   if (Size.X = 0) and (Size.Y = 0) then
2237     Result := 0
2238   else
2239     Result := Trunc(Max(Size.Y, 1) * Max(Size.X, 1) * FormatGetSize(Format));
2240 end;
2241
2242
2243 function FormatGetSupportedFiles(Format: TglBitmapInternalFormat): TglBitmapFileTypes;
2244 begin
2245   Result := [];
2246
2247   {$IFDEF GLB_SUPPORT_PNG_WRITE}
2248   if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifBGR8, ifBGRA8, ifRGB8, ifRGBA8] then
2249     Result := Result + [ftPNG];
2250   {$ENDIF}
2251
2252   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2253   if Format in [ifLuminance, ifAlpha, ifDepth8, ifRGB8, ifBGR8] then
2254     Result := Result + [ftJPEG];
2255   {$ENDIF}
2256
2257   Result := Result + [ftDDS];
2258
2259   if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifBGR8, ifRGB8, ifBGRA8, ifRGBA8] then
2260     Result := Result + [ftTGA];
2261
2262   if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5, ifRGB8, ifBGR8, ifRGBA8, ifBGRA8, ifRGB10A2] then
2263     Result := Result + [ftBMP];
2264 end;
2265
2266
2267 function FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; Format: TglBitmapInternalFormat): boolean;
2268 var
2269   Pix: TglBitmapPixelData;
2270 begin
2271   Result := False;
2272
2273   if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) and (AlphaMask = 0) then
2274     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2275
2276   FormatPreparePixel(Pix, Format);
2277
2278   with Pix.PixelDesc do begin
2279     if RedMask <> 0 then
2280       if (RedMask <> (RedRange shl RedShift)) then
2281         Exit;
2282
2283     if GreenMask <> 0 then
2284       if (GreenMask <> (GreenRange shl GreenShift)) then
2285         Exit;
2286
2287     if BlueMask <> 0 then
2288       if (BlueMask <> (BlueRange shl BlueShift)) then
2289         Exit;
2290
2291     if AlphaMask <> 0 then
2292       if (AlphaMask <> (AlphaRange shl AlphaShift)) then
2293         Exit;
2294
2295     Result := True;
2296   end;
2297 end;
2298
2299
2300 function IsPowerOfTwo(Number: Integer): Boolean;
2301 begin
2302   while Number and 1 = 0 do
2303     Number := Number shr 1;
2304
2305   Result := Number = 1;
2306 end;
2307
2308
2309 function GetBitSize(BitSet: Cardinal): Integer;
2310 begin
2311   Result := 0;
2312
2313   while BitSet > 0 do begin
2314     if (BitSet and $1) = 1 then
2315       Inc(Result);
2316
2317     BitSet := BitSet shr 1;
2318   end;
2319 end;
2320
2321
2322 procedure SwapRGB(pData: pByte; Width: Integer; HasAlpha: Boolean);
2323 type
2324   PRGBPix = ^TRGBPix;
2325   TRGBPix = array [0..2] of byte;
2326 var
2327   Temp: Byte;
2328 begin
2329   while Width > 0 do begin
2330     Temp := pRGBPIX(pData)^[0];
2331     pRGBPIX(pData)^[0] := pRGBPIX(pData)^[2];
2332     pRGBPIX(pData)^[2] := Temp;
2333
2334     if HasAlpha then
2335       Inc(pData, 4)
2336     else
2337       Inc(pData, 3);
2338
2339     Dec(Width);
2340   end;
2341 end;
2342
2343
2344 {$IFDEF GLB_DELPHI}
2345 function CreateGrayPalette: HPALETTE;
2346 var
2347   Idx: Integer;
2348   Pal: PLogPalette;
2349 begin
2350   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2351
2352   Pal.palVersion := $300;
2353   Pal.palNumEntries := 256;
2354
2355   {$IFOPT R+}
2356     {$DEFINE GLB_TEMPRANGECHECK}
2357     {$R-}
2358   {$ENDIF}
2359
2360   for Idx := 0 to 256 - 1 do begin
2361     Pal.palPalEntry[Idx].peRed   := Idx;
2362     Pal.palPalEntry[Idx].peGreen := Idx;
2363     Pal.palPalEntry[Idx].peBlue  := Idx;
2364     Pal.palPalEntry[Idx].peFlags := 0;
2365   end;
2366
2367   {$IFDEF GLB_TEMPRANGECHECK}
2368     {$UNDEF GLB_TEMPRANGECHECK}
2369     {$R+}
2370   {$ENDIF}
2371
2372   Result := CreatePalette(Pal^);
2373
2374   FreeMem(Pal);
2375 end;
2376 {$ENDIF}
2377
2378
2379 {$IFDEF GLB_SDL_IMAGE}
2380 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2381 begin
2382   Result := TStream(context^.unknown.data1).Seek(offset, whence);
2383 end;
2384
2385
2386 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2387 begin
2388   Result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2389 end;
2390
2391
2392 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2393 begin
2394   Result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2395 end;
2396
2397
2398 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2399 begin
2400   Result := 0;
2401 end;
2402
2403
2404 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2405 begin
2406   Result := SDL_AllocRW;
2407
2408   if Result = nil then
2409     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2410
2411   Result^.seek := glBitmapRWseek;
2412   Result^.read := glBitmapRWread;
2413   Result^.write := glBitmapRWwrite;
2414   Result^.close := glBitmapRWclose;
2415   Result^.unknown.data1 := Stream;
2416 end;
2417 {$ENDIF}
2418
2419
2420 {*
2421 ** Helper functions
2422 *}
2423 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2424 var
2425   glBitmap: TglBitmap2D;
2426 begin
2427   Result := false;
2428   Texture := 0;
2429
2430   {$IFDEF GLB_DELPHI}
2431   if Instance = 0 then
2432     Instance := HInstance;
2433
2434   if (LoadFromRes) then
2435     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2436   else
2437   {$ENDIF}
2438     glBitmap := TglBitmap2D.Create(FileName);
2439
2440   try
2441     glBitmap.DeleteTextureOnFree := False;
2442     glBitmap.FreeDataAfterGenTexture := False;
2443     glBitmap.GenTexture(True);
2444     if (glBitmap.ID > 0) then begin
2445       Texture := glBitmap.ID;
2446       Result := True;
2447     end;
2448   finally
2449     glBitmap.Free;
2450   end;
2451 end;
2452
2453
2454 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2455 var
2456   CM: TglBitmapCubeMap;
2457 begin
2458   Texture := 0;
2459
2460   {$IFDEF GLB_DELPHI}
2461   if Instance = 0 then
2462     Instance := HInstance;
2463   {$ENDIF}
2464
2465   CM := TglBitmapCubeMap.Create;
2466   try
2467     CM.DeleteTextureOnFree := False;
2468
2469     // Maps
2470     {$IFDEF GLB_DELPHI}
2471     if (LoadFromRes) then
2472       CM.LoadFromResource(Instance, PositiveX)
2473     else
2474     {$ENDIF}
2475       CM.LoadFromFile(PositiveX);
2476     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2477
2478     {$IFDEF GLB_DELPHI}
2479     if (LoadFromRes) then
2480       CM.LoadFromResource(Instance, NegativeX)
2481     else
2482     {$ENDIF}
2483       CM.LoadFromFile(NegativeX);
2484     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2485
2486     {$IFDEF GLB_DELPHI}
2487     if (LoadFromRes) then
2488       CM.LoadFromResource(Instance, PositiveY)
2489     else
2490     {$ENDIF}
2491       CM.LoadFromFile(PositiveY);
2492     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2493
2494     {$IFDEF GLB_DELPHI}
2495     if (LoadFromRes) then
2496       CM.LoadFromResource(Instance, NegativeY)
2497     else
2498     {$ENDIF}
2499       CM.LoadFromFile(NegativeY);
2500     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2501
2502     {$IFDEF GLB_DELPHI}
2503     if (LoadFromRes) then
2504       CM.LoadFromResource(Instance, PositiveZ)
2505     else
2506     {$ENDIF}
2507       CM.LoadFromFile(PositiveZ);
2508     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2509
2510     {$IFDEF GLB_DELPHI}
2511     if (LoadFromRes) then
2512       CM.LoadFromResource(Instance, NegativeZ)
2513     else
2514     {$ENDIF}
2515       CM.LoadFromFile(NegativeZ);
2516     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2517
2518     Texture := CM.ID;
2519     Result := True;
2520   finally
2521     CM.Free;
2522   end;
2523 end;
2524
2525
2526 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2527 var
2528   NM: TglBitmapNormalMap;
2529 begin
2530   Texture := 0;
2531
2532   NM := TglBitmapNormalMap.Create;
2533   try
2534     NM.DeleteTextureOnFree := False;
2535     NM.GenerateNormalMap(Size);
2536
2537     Texture := NM.ID;
2538     Result := True;
2539   finally
2540     NM.Free;
2541   end;
2542 end;
2543
2544
2545 procedure glBitmapSetDefaultFormat(Format: TglBitmapFormat);
2546 begin
2547   glBitmapDefaultFormat := Format;
2548 end;
2549
2550
2551 procedure glBitmapSetDefaultDeleteTextureOnFree(DeleteTextureOnFree: Boolean);
2552 begin
2553   glBitmapDefaultDeleteTextureOnFree := DeleteTextureOnFree;
2554 end;
2555
2556
2557 procedure glBitmapSetDefaultFilter(Min, Mag: Integer);
2558 begin
2559   glBitmapDefaultFilterMin := Min;
2560   glBitmapDefaultFilterMag := Mag;
2561 end;
2562
2563
2564 procedure glBitmapSetDefaultWrap(S: Integer; T: Integer; R: Integer);
2565 begin
2566   glBitmapDefaultWrapS := S;
2567   glBitmapDefaultWrapT := T;
2568   glBitmapDefaultWrapR := R;
2569 end;
2570
2571
2572 procedure glBitmapSetDefaultFreeDataAfterGenTexture(FreeData: Boolean);
2573 begin
2574   glBitmapDefaultFreeDataAfterGenTextures := FreeData;
2575 end;
2576
2577
2578 function glBitmapGetDefaultFormat: TglBitmapFormat;
2579 begin
2580   Result := glBitmapDefaultFormat;
2581 end;
2582
2583
2584 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2585 begin
2586   Result := glBitmapDefaultDeleteTextureOnFree;
2587 end;
2588
2589
2590 procedure glBitmapGetDefaultFilter(var Min, Mag: Integer);
2591 begin
2592   Min := glBitmapDefaultFilterMin;
2593   Mag := glBitmapDefaultFilterMag;
2594 end;
2595
2596
2597 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Integer);
2598 begin
2599   S := glBitmapDefaultWrapS;
2600   T := glBitmapDefaultWrapT;
2601   R := glBitmapDefaultWrapR;
2602 end;
2603
2604
2605 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2606 begin
2607   Result := glBitmapDefaultFreeDataAfterGenTextures;
2608 end;
2609
2610
2611 { TglBitmap }
2612
2613 procedure TglBitmap.AfterConstruction;
2614 begin
2615   inherited;
2616
2617   fID := 0;
2618   fTarget := 0;
2619   fMipMap := mmMipmap;
2620   fIsResident := False;
2621
2622   // get defaults
2623   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
2624   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
2625
2626   fFormat := glBitmapGetDefaultFormat;
2627
2628   glBitmapGetDefaultFilter(fFilterMin, fFilterMag);
2629   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
2630 end;
2631
2632
2633 procedure TglBitmap.BeforeDestruction;
2634 begin
2635   SetDataPointer(nil, ifEmpty);
2636
2637   if ((ID > 0) and (fDeleteTextureOnFree)) then
2638     glDeleteTextures(1, @ID);
2639
2640   inherited;
2641 end;
2642
2643
2644 constructor TglBitmap.Create;
2645 begin
2646   {$IFNDEF GLB_NO_NATIVE_GL}
2647     ReadOpenGLExtensions;
2648   {$ENDIF}
2649
2650   if (ClassType = TglBitmap) then
2651     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
2652
2653   inherited Create;
2654 end;
2655
2656
2657 constructor TglBitmap.Create(FileName: String);
2658 begin
2659   Create;
2660   LoadFromFile(FileName);
2661 end;
2662
2663
2664 constructor TglBitmap.Create(Stream: TStream);
2665 begin
2666   Create;
2667   LoadFromStream(Stream);
2668 end;
2669
2670
2671 {$IFDEF GLB_DELPHI}
2672 constructor TglBitmap.CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar);
2673 begin
2674   Create;
2675   LoadFromResource(Instance, Resource, ResType);
2676 end;
2677
2678
2679 constructor TglBitmap.Create(Instance: Cardinal; Resource: String; ResType: PChar);
2680 begin
2681   Create;
2682   LoadFromResource(Instance, Resource, ResType);
2683 end;
2684
2685
2686
2687 constructor TglBitmap.Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2688 begin
2689   Create;
2690   LoadFromResourceID(Instance, ResourceID, ResType);
2691 end;
2692 {$ENDIF}
2693
2694
2695 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2696   Format: TglBitmapInternalFormat);
2697 var
2698   Image: pByte;
2699   ImageSize: Integer;
2700 begin
2701   Create;
2702
2703   ImageSize := FormatGetImageSize(Size, Format);
2704   GetMem(Image, ImageSize);
2705   try
2706     FillChar(Image^, ImageSize, #$FF);
2707
2708     SetDataPointer(Image, Format, Size.X, Size.Y);
2709   except
2710     FreeMem(Image);
2711     raise;
2712   end;
2713 end;
2714
2715
2716 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2717   Format: TglBitmapInternalFormat; Func: TglBitmapFunction; CustomData: Pointer);
2718 begin
2719   Create;
2720   LoadFromFunc(Size, Func, Format, CustomData);
2721 end;
2722
2723
2724 function TglBitmap.Clone: TglBitmap;
2725 var
2726   Temp: TglBitmap;
2727   TempPtr: pByte;
2728   Size: Integer;
2729 begin
2730   Temp := ClassType.Create as TglBitmap;
2731   try
2732     // copy texture data if assigned
2733     if Assigned(Data) then begin
2734       Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
2735
2736       GetMem(TempPtr, Size);
2737       try
2738         Move(Data^, TempPtr^, Size);
2739         Temp.SetDataPointer(TempPtr, InternalFormat, Width, Height);
2740       except
2741         FreeMem(TempPtr);
2742         raise;
2743       end;
2744     end else
2745       Temp.SetDataPointer(nil, InternalFormat, Width, Height);
2746
2747         // copy properties
2748     Temp.fID := ID;
2749     Temp.fTarget := Target;
2750     Temp.fFormat := Format;
2751     Temp.fMipMap := MipMap;
2752     Temp.fAnisotropic := Anisotropic;
2753     Temp.fBorderColor := fBorderColor;
2754     Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
2755     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
2756     Temp.fFilterMin := fFilterMin;
2757     Temp.fFilterMag := fFilterMag;
2758     Temp.fWrapS := fWrapS;
2759     Temp.fWrapT := fWrapT;
2760     Temp.fWrapR := fWrapR;
2761     Temp.fFilename := fFilename;
2762     Temp.fCustomName := fCustomName;
2763     Temp.fCustomNameW := fCustomNameW;
2764     Temp.fCustomDataPointer := fCustomDataPointer;
2765
2766     Result := Temp;
2767   except
2768     FreeAndNil(Temp);
2769     raise;
2770   end;
2771 end;
2772
2773
2774 procedure TglBitmap.LoadFromFile(FileName: String);
2775 var
2776   FS: TFileStream;
2777 begin
2778   fFilename := FileName;
2779
2780   FS := TFileStream.Create(FileName, fmOpenRead);
2781   try
2782     FS.Position := 0;
2783
2784     LoadFromStream(FS);
2785   finally
2786     FS.Free;
2787   end;
2788 end;
2789
2790
2791 procedure TglBitmap.LoadFromStream(Stream: TStream);
2792 begin
2793   {$IFDEF GLB_SUPPORT_PNG_READ}
2794   if not LoadPNG(Stream) then
2795   {$ENDIF}
2796   {$IFDEF GLB_SUPPORT_JPEG_READ}
2797   if not LoadJPEG(Stream) then
2798   {$ENDIF}
2799   if not LoadDDS(Stream) then
2800   if not LoadTGA(Stream) then
2801   if not LoadBMP(Stream) then
2802     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
2803 end;
2804
2805
2806 {$IFDEF GLB_DELPHI}
2807 procedure TglBitmap.LoadFromResource(Instance: Cardinal; Resource: String; ResType: PChar);
2808 var
2809   RS: TResourceStream;
2810   TempPos: Integer;
2811   ResTypeStr: String;
2812   TempResType: PChar;
2813 begin
2814   if Assigned(ResType) then
2815     TempResType := ResType
2816   else
2817     begin
2818       TempPos := Pos('.', Resource);
2819       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
2820       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
2821       TempResType := PChar(ResTypeStr);
2822     end;
2823
2824   RS := TResourceStream.Create(Instance, Resource, TempResType);
2825   try
2826     LoadFromStream(RS);
2827   finally
2828     RS.Free;
2829   end;
2830 end;
2831
2832
2833 procedure TglBitmap.LoadFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2834 var
2835   RS: TResourceStream;
2836 begin
2837   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
2838   try
2839     LoadFromStream(RS);
2840   finally
2841     RS.Free;
2842   end;
2843 end;
2844 {$ENDIF}
2845
2846
2847
2848 procedure TglBitmap.LoadFromFunc(Size: TglBitmapPixelPosition;
2849   Func: TglBitmapFunction; Format: TglBitmapInternalFormat; CustomData: Pointer);
2850 var
2851   Image: pByte;
2852   ImageSize: Integer;
2853 begin
2854   ImageSize := FormatGetImageSize(Size, Format);
2855   GetMem(Image, ImageSize);
2856   try
2857     FillChar(Image^, ImageSize, #$FF);
2858
2859     SetDataPointer(Image, Format, Size.X, Size.Y);
2860   except
2861     FreeMem(Image);
2862     raise;
2863   end;
2864
2865   AddFunc(Self, Func, False, Format, CustomData)
2866 end;
2867
2868
2869 procedure TglBitmap.SaveToFile(FileName: String; FileType: TglBitmapFileType);
2870 var
2871   FS: TFileStream;
2872 begin
2873   FS := TFileStream.Create(FileName, fmCreate);
2874   try
2875     FS.Position := 0;
2876     SaveToStream(FS, FileType);
2877   finally
2878     FS.Free;
2879   end;
2880 end;
2881
2882
2883 procedure TglBitmap.SaveToStream(Stream: TStream; FileType: TglBitmapFileType);
2884 begin
2885   case FileType of
2886     {$IFDEF GLB_SUPPORT_PNG_WRITE}
2887     ftPNG:  SavePng(Stream);
2888     {$ENDIF}
2889     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2890     ftJPEG: SaveJPEG(Stream);
2891     {$ENDIF}
2892     ftDDS:  SaveDDS(Stream);
2893     ftTGA:  SaveTGA(Stream);
2894     ftBMP:  SaveBMP(Stream);
2895   end;
2896 end;
2897
2898
2899 {$IFDEF GLB_SDL}
2900 function TglBitmap.AssignToSurface(out Surface: PSDL_Surface): boolean;
2901 var
2902   Row, RowSize: Integer;
2903   pSource, pData: PByte;
2904   TempDepth: Integer;
2905   Pix: TglBitmapPixelData;
2906
2907   function GetRowPointer(Row: Integer): pByte;
2908   begin
2909     Result := Surface.pixels;
2910     Inc(Result, Row * RowSize);
2911   end;
2912
2913 begin
2914   Result := False;
2915
2916   if not FormatIsUncompressed(InternalFormat) then
2917     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2918
2919   if Assigned(Data) then begin
2920     case Trunc(FormatGetSize(InternalFormat)) of
2921       1: TempDepth :=  8;
2922       2: TempDepth := 16;
2923       3: TempDepth := 24;
2924       4: TempDepth := 32;
2925       else
2926         raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2927     end;
2928
2929     FormatPreparePixel(Pix, InternalFormat);
2930
2931     with Pix.PixelDesc do
2932       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
2933
2934     pSource := Data;
2935     RowSize := Trunc(FileWidth * FormatGetSize(InternalFormat));
2936
2937     for Row := 0 to FileHeight -1 do begin
2938       pData := GetRowPointer(Row);
2939
2940       if Assigned(pData) then begin
2941         Move(pSource^, pData^, RowSize);
2942         Inc(pSource, RowSize);
2943       end;
2944     end;
2945
2946     Result := True;
2947   end;
2948 end;
2949
2950
2951 function TglBitmap.AssignFromSurface(const Surface: PSDL_Surface): boolean;
2952 var
2953   pSource, pData, pTempData: PByte;
2954   Row, RowSize, TempWidth, TempHeight: Integer;
2955   IntFormat: TglBitmapInternalFormat;
2956
2957   function GetRowPointer(Row: Integer): pByte;
2958   begin
2959     Result := Surface^.pixels;
2960     Inc(Result, Row * RowSize);
2961   end;
2962
2963 begin
2964   Result := False;
2965
2966   if (Assigned(Surface)) then begin
2967     with Surface^.format^ do begin
2968       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminance) then
2969         IntFormat := ifLuminance
2970       else
2971
2972       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminanceAlpha) then
2973         IntFormat := ifLuminanceAlpha
2974       else
2975
2976       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA4) then
2977         IntFormat := ifRGBA4
2978       else
2979
2980       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifR5G6B5) then
2981         IntFormat := ifR5G6B5
2982       else
2983
2984       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB5A1) then
2985         IntFormat := ifRGB5A1
2986       else
2987
2988       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGR8) then
2989         IntFormat := ifBGR8
2990       else
2991
2992       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB8) then
2993         IntFormat := ifRGB8
2994       else
2995
2996       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGRA8) then
2997         IntFormat := ifBGRA8
2998       else
2999
3000       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA8) then
3001         IntFormat := ifRGBA8
3002       else
3003
3004       if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB10A2) then
3005         IntFormat := ifRGB10A2
3006       else
3007         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
3008     end;
3009
3010     TempWidth := Surface^.w;
3011     TempHeight := Surface^.h;
3012
3013     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
3014
3015     GetMem(pData, TempHeight * RowSize);
3016     try
3017       pTempData := pData;
3018
3019       for Row := 0 to TempHeight -1 do begin
3020         pSource := GetRowPointer(Row);
3021
3022         if (Assigned(pSource)) then begin
3023           Move(pSource^, pTempData^, RowSize);
3024           Inc(pTempData, RowSize);
3025         end;
3026       end;
3027
3028       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
3029
3030       Result := True;
3031     except
3032       FreeMem(pData);
3033       raise;
3034     end;
3035   end;
3036 end;
3037
3038
3039 function TglBitmap.AssignAlphaToSurface(out Surface: PSDL_Surface): boolean;
3040 var
3041   Row, Col, AlphaInterleave: Integer;
3042   pSource, pDest: PByte;
3043
3044   function GetRowPointer(Row: Integer): pByte;
3045   begin
3046     Result := Surface.pixels;
3047     Inc(Result, Row * Width);
3048   end;
3049
3050 begin
3051   Result := False;
3052
3053   if Assigned(Data) then begin
3054     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifBGRA8, ifRGBA8] then begin
3055       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
3056
3057       case InternalFormat of
3058         ifLuminanceAlpha:
3059           AlphaInterleave := 1;
3060         ifBGRA8, ifRGBA8:
3061           AlphaInterleave := 3;
3062         else
3063           AlphaInterleave := 0;
3064       end;
3065
3066       // Copy Data
3067       pSource := Data;
3068
3069       for Row := 0 to Height -1 do begin
3070         pDest := GetRowPointer(Row);
3071
3072         if Assigned(pDest) then begin
3073           for Col := 0 to Width -1 do begin
3074             Inc(pSource, AlphaInterleave);
3075             pDest^ := pSource^;
3076             Inc(pDest);
3077             Inc(pSource);
3078           end;
3079         end;
3080       end;
3081
3082       Result := True;
3083     end;
3084   end;
3085 end;
3086
3087
3088 function TglBitmap.AddAlphaFromSurface(Surface: PSDL_Surface; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3089 var
3090   glBitmap: TglBitmap2D;
3091 begin
3092   glBitmap := TglBitmap2D.Create;
3093   try
3094     glBitmap.AssignFromSurface(Surface);
3095
3096     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
3097   finally
3098     glBitmap.Free;
3099   end;
3100 end;
3101 {$ENDIF}
3102
3103
3104 {$IFDEF GLB_DELPHI}
3105 function TglBitmap.AssignFromBitmap(const Bitmap: TBitmap): boolean;
3106 var
3107   pSource, pData, pTempData: PByte;
3108   Row, RowSize, TempWidth, TempHeight: Integer;
3109   IntFormat: TglBitmapInternalFormat;
3110 begin
3111   Result := False;
3112
3113   if (Assigned(Bitmap)) then begin
3114     case Bitmap.PixelFormat of
3115       pf8bit:
3116         IntFormat := ifLuminance;
3117       pf15bit:
3118         IntFormat := ifRGB5A1;
3119       pf16bit:
3120         IntFormat := ifR5G6B5;
3121       pf24bit:
3122         IntFormat := ifBGR8;
3123       pf32bit:
3124         IntFormat := ifBGRA8;
3125       else
3126         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
3127     end;
3128
3129     TempWidth := Bitmap.Width;
3130     TempHeight := Bitmap.Height;
3131
3132     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
3133
3134     GetMem(pData, TempHeight * RowSize);
3135     try
3136       pTempData := pData;
3137
3138       for Row := 0 to TempHeight -1 do begin
3139         pSource := Bitmap.Scanline[Row];
3140
3141         if (Assigned(pSource)) then begin
3142           Move(pSource^, pTempData^, RowSize);
3143           Inc(pTempData, RowSize);
3144         end;
3145       end;
3146
3147       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
3148
3149       Result := True;
3150     except
3151       FreeMem(pData);
3152       raise;
3153     end;
3154   end;
3155 end;
3156
3157
3158 function TglBitmap.AssignToBitmap(const Bitmap: TBitmap): boolean;
3159 var
3160   Row: Integer;
3161   pSource, pData: PByte;
3162 begin
3163   Result := False;
3164
3165   if Assigned(Data) then begin
3166     if Assigned(Bitmap) then begin
3167       Bitmap.Width := Width;
3168       Bitmap.Height := Height;
3169
3170       case InternalFormat of
3171         ifAlpha, ifLuminance, ifDepth8:
3172           begin
3173             Bitmap.PixelFormat := pf8bit;
3174             Bitmap.Palette := CreateGrayPalette;
3175           end;
3176         ifRGB5A1:
3177           Bitmap.PixelFormat := pf15bit;
3178         ifR5G6B5:
3179           Bitmap.PixelFormat := pf16bit;
3180         ifRGB8, ifBGR8:
3181           Bitmap.PixelFormat := pf24bit;
3182         ifRGBA8, ifBGRA8:
3183           Bitmap.PixelFormat := pf32bit;
3184         else
3185           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
3186       end;
3187
3188       pSource := Data;
3189       for Row := 0 to FileHeight -1 do begin
3190         pData := Bitmap.Scanline[Row];
3191
3192         Move(pSource^, pData^, fRowSize);
3193         Inc(pSource, fRowSize);
3194
3195         // swap RGB(A) to BGR(A)
3196         if InternalFormat in [ifRGB8, ifRGBA8] then
3197           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
3198       end;
3199
3200       Result := True;
3201     end;
3202   end;
3203 end;
3204
3205
3206 function TglBitmap.AssignAlphaToBitmap(const Bitmap: TBitmap): boolean;
3207 var
3208   Row, Col, AlphaInterleave: Integer;
3209   pSource, pDest: PByte;
3210 begin
3211   Result := False;
3212
3213   if Assigned(Data) then begin
3214     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
3215       if Assigned(Bitmap) then begin
3216         Bitmap.PixelFormat := pf8bit;
3217         Bitmap.Palette := CreateGrayPalette;
3218         Bitmap.Width := Width;
3219         Bitmap.Height := Height;
3220
3221         case InternalFormat of
3222           ifLuminanceAlpha:
3223             AlphaInterleave := 1;
3224           ifRGBA8, ifBGRA8:
3225             AlphaInterleave := 3;
3226           else
3227             AlphaInterleave := 0;
3228         end;
3229
3230         // Copy Data
3231         pSource := Data;
3232
3233         for Row := 0 to Height -1 do begin
3234           pDest := Bitmap.Scanline[Row];
3235
3236           if Assigned(pDest) then begin
3237             for Col := 0 to Width -1 do begin
3238               Inc(pSource, AlphaInterleave);
3239               pDest^ := pSource^;
3240               Inc(pDest);
3241               Inc(pSource);
3242             end;
3243           end;
3244         end;
3245
3246         Result := True;
3247       end;
3248     end;
3249   end;
3250 end;
3251
3252
3253 function TglBitmap.AddAlphaFromBitmap(Bitmap: TBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3254 var
3255   glBitmap: TglBitmap2D;
3256 begin
3257   glBitmap := TglBitmap2D.Create;
3258   try
3259     glBitmap.AssignFromBitmap(Bitmap);
3260
3261     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
3262   finally
3263     glBitmap.Free;
3264   end;
3265 end;
3266 {$ENDIF}
3267
3268
3269 function TglBitmap.AddAlphaFromFile(FileName: String; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3270 var
3271   FS: TFileStream;
3272 begin
3273   FS := TFileStream.Create(FileName, fmOpenRead);
3274   try
3275     Result := AddAlphaFromStream(FS, Func, CustomData);
3276   finally
3277     FS.Free;
3278   end;
3279 end;
3280
3281
3282 function TglBitmap.AddAlphaFromStream(Stream: TStream; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3283 var
3284   glBitmap: TglBitmap2D;
3285 begin
3286   glBitmap := TglBitmap2D.Create(Stream);
3287   try
3288     Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
3289   finally
3290     glBitmap.Free;
3291   end;
3292 end;
3293
3294
3295 {$IFDEF GLB_DELPHI}
3296 function TglBitmap.AddAlphaFromResource(Instance: Cardinal; Resource: String;
3297   ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3298 var
3299   RS: TResourceStream;
3300   TempPos: Integer;
3301   ResTypeStr: String;
3302   TempResType: PChar;
3303 begin
3304   if Assigned(ResType) then
3305     TempResType := ResType
3306   else
3307     begin
3308       TempPos := Pos('.', Resource);
3309       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
3310       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
3311       TempResType := PChar(ResTypeStr);
3312     end;
3313
3314   RS := TResourceStream.Create(Instance, Resource, TempResType);
3315   try
3316     Result := AddAlphaFromStream(RS, Func, CustomData);
3317   finally
3318     RS.Free;
3319   end;
3320 end;
3321
3322
3323 function TglBitmap.AddAlphaFromResourceID(Instance: Cardinal; ResourceID: Integer;
3324   ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
3325 var
3326   RS: TResourceStream;
3327 begin
3328   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
3329   try
3330     Result := AddAlphaFromStream(RS, Func, CustomData);
3331   finally
3332     RS.Free;
3333   end;
3334 end;
3335 {$ENDIF}
3336
3337
3338 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3339 begin
3340   with FuncRec do begin
3341     Dest.Red   := Source.Red;
3342     Dest.Green := Source.Green;
3343     Dest.Blue  := Source.Blue;
3344
3345     with TglBitmapPixelData(CustomData^) do
3346       if ((Dest.Red   <= Red  ) and (Dest.Red   >= PixelDesc.RedRange  ) and
3347           (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and
3348           (Dest.Blue  <= Blue ) and (Dest.Blue  >= PixelDesc.BlueRange )) then
3349         Dest.Alpha := 0
3350       else
3351         Dest.Alpha := Dest.PixelDesc.AlphaRange;
3352   end;
3353 end;
3354
3355
3356 function TglBitmap.AddAlphaFromColorKey(Red, Green, Blue: Byte; Deviation: Byte
3357   ): Boolean;
3358 begin
3359   Result := AddAlphaFromColorKeyFloat(Red / $FF, Green / $FF, Blue / $FF, Deviation / $FF);
3360 end;
3361
3362
3363 function TglBitmap.AddAlphaFromColorKeyRange(Red, Green, Blue: Cardinal; Deviation: Cardinal = 0): Boolean;
3364 var
3365   PixelData: TglBitmapPixelData;
3366 begin
3367   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3368
3369   Result := AddAlphaFromColorKeyFloat(
3370     Red   / PixelData.PixelDesc.RedRange,
3371     Green / PixelData.PixelDesc.GreenRange,
3372     Blue  / PixelData.PixelDesc.BlueRange,
3373     Deviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange)));
3374 end;
3375
3376
3377 function TglBitmap.AddAlphaFromColorKeyFloat(Red, Green, Blue: Single; Deviation: Single = 0): Boolean;
3378 var
3379   TempR, TempG, TempB: Cardinal;
3380   PixelData: TglBitmapPixelData;
3381 begin
3382   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3383
3384   // Calculate Colorrange
3385   with PixelData.PixelDesc do begin
3386     TempR := Trunc(RedRange   * Deviation);
3387     TempG := Trunc(GreenRange * Deviation);
3388     TempB := Trunc(BlueRange  * Deviation);
3389
3390     PixelData.Red   := Min(RedRange,   Trunc(RedRange   * Red)   + TempR);
3391     RedRange        := Max(0,          Trunc(RedRange   * Red)   - TempR);
3392     PixelData.Green := Min(GreenRange, Trunc(GreenRange * Green) + TempG);
3393     GreenRange      := Max(0,          Trunc(GreenRange * Green) - TempG);
3394     PixelData.Blue  := Min(BlueRange,  Trunc(BlueRange  * Blue)  + TempB);
3395     BlueRange       := Max(0,          Trunc(BlueRange  * Blue)  - TempB);
3396     PixelData.Alpha := 0;
3397     AlphaRange      := 0;
3398   end;
3399
3400   Result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
3401 end;
3402
3403
3404 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3405 begin
3406   with FuncRec do begin
3407     Dest.Red   := Source.Red;
3408     Dest.Green := Source.Green;
3409     Dest.Blue  := Source.Blue;
3410
3411     with TglBitmapPixelData(CustomData^) do
3412       Dest.Alpha := Alpha;
3413   end;
3414 end;
3415
3416
3417 function TglBitmap.AddAlphaFromValue(Alpha: Byte): Boolean;
3418 begin
3419   Result := AddAlphaFromValueFloat(Alpha / $FF);
3420 end;
3421
3422
3423 function TglBitmap.AddAlphaFromValueFloat(Alpha: Single): Boolean;
3424 var
3425   PixelData: TglBitmapPixelData;
3426 begin
3427   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3428
3429   with PixelData.PixelDesc do
3430     PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * Alpha)));
3431
3432   Result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData);
3433 end;
3434
3435
3436 function TglBitmap.AddAlphaFromValueRange(Alpha: Cardinal): Boolean;
3437 var
3438   PixelData: TglBitmapPixelData;
3439 begin
3440   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
3441
3442   Result := AddAlphaFromValueFloat(Alpha / PixelData.PixelDesc.AlphaRange);
3443 end;
3444
3445
3446 procedure glBitmapInvertFunc(var FuncRec: TglBitmapFunctionRec);
3447 begin
3448   with FuncRec do begin
3449     Dest.Red   := Source.Red;
3450     Dest.Green := Source.Green;
3451     Dest.Blue  := Source.Blue;
3452     Dest.Alpha := Source.Alpha;
3453
3454     if (Integer(CustomData) and $1 > 0) then begin
3455       Dest.Red   := Dest.Red   xor Dest.PixelDesc.RedRange;
3456       Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange;
3457       Dest.Blue  := Dest.Blue  xor Dest.PixelDesc.BlueRange;
3458     end;
3459
3460     if (Integer(CustomData) and $2 > 0) then begin
3461       Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange;
3462     end;
3463   end;
3464 end;
3465
3466
3467 procedure TglBitmap.Invert(UseRGB: Boolean; UseAlpha: Boolean);
3468 begin
3469   if ((UseRGB) or (UseAlpha)) then
3470     AddFunc(glBitmapInvertFunc, False, Pointer(Integer(UseAlpha) shl 1 or Integer(UseRGB)));
3471 end;
3472
3473
3474 procedure TglBitmap.SetFilter(Min, Mag: Integer);
3475 begin
3476   case Min of
3477     GL_NEAREST:
3478       fFilterMin := GL_NEAREST;
3479     GL_LINEAR:
3480       fFilterMin := GL_LINEAR;
3481     GL_NEAREST_MIPMAP_NEAREST:
3482       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
3483     GL_LINEAR_MIPMAP_NEAREST:
3484       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
3485     GL_NEAREST_MIPMAP_LINEAR:
3486       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
3487     GL_LINEAR_MIPMAP_LINEAR:
3488       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
3489     else
3490       raise EglBitmapException.Create('SetFilter - Unknow Minfilter.');
3491   end;
3492
3493   case Mag of
3494     GL_NEAREST:
3495       fFilterMag := GL_NEAREST;
3496     GL_LINEAR:
3497       fFilterMag := GL_LINEAR;
3498     else
3499       raise EglBitmapException.Create('SetFilter - Unknow Magfilter.');
3500   end;
3501
3502   // If texture is created then assign filter
3503   if ID > 0 then begin
3504     Bind(False);
3505
3506     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
3507
3508     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE_ARB) then begin
3509       case fFilterMin of
3510         GL_NEAREST, GL_LINEAR:
3511           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3512         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
3513           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
3514         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
3515           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
3516       end;
3517     end else
3518       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3519   end;
3520 end;
3521
3522
3523 procedure TglBitmap.SetWrap(S: Integer; T: Integer; R: Integer);
3524 begin
3525   case S of
3526     GL_CLAMP:
3527       fWrapS := GL_CLAMP;
3528     GL_REPEAT:
3529       fWrapS := GL_REPEAT;
3530     GL_CLAMP_TO_EDGE:
3531       begin
3532         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3533           fWrapS := GL_CLAMP_TO_EDGE
3534         else
3535           fWrapS := GL_CLAMP;
3536       end;
3537     GL_CLAMP_TO_BORDER:
3538       begin
3539         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3540           fWrapS := GL_CLAMP_TO_BORDER
3541         else
3542           fWrapS := GL_CLAMP;
3543       end;
3544     GL_MIRRORED_REPEAT:
3545       begin
3546         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3547           fWrapS := GL_MIRRORED_REPEAT
3548         else
3549           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
3550       end;
3551     else
3552       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
3553   end;
3554
3555   case T of
3556     GL_CLAMP:
3557       fWrapT := GL_CLAMP;
3558     GL_REPEAT:
3559       fWrapT := GL_REPEAT;
3560     GL_CLAMP_TO_EDGE:
3561       begin
3562         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3563           fWrapT := GL_CLAMP_TO_EDGE
3564         else
3565           fWrapT := GL_CLAMP;
3566       end;
3567     GL_CLAMP_TO_BORDER:
3568       begin
3569         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3570           fWrapT := GL_CLAMP_TO_BORDER
3571         else
3572           fWrapT := GL_CLAMP;
3573       end;
3574     GL_MIRRORED_REPEAT:
3575       begin
3576         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3577           fWrapT := GL_MIRRORED_REPEAT
3578         else
3579           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (T).');
3580       end;
3581     else
3582       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (T).');
3583   end;
3584
3585   case R of
3586     GL_CLAMP:
3587       fWrapR := GL_CLAMP;
3588     GL_REPEAT:
3589       fWrapR := GL_REPEAT;
3590     GL_CLAMP_TO_EDGE:
3591       begin
3592         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3593           fWrapR := GL_CLAMP_TO_EDGE
3594         else
3595           fWrapR := GL_CLAMP;
3596       end;
3597     GL_CLAMP_TO_BORDER:
3598       begin
3599         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3600           fWrapR := GL_CLAMP_TO_BORDER
3601         else
3602           fWrapR := GL_CLAMP;
3603       end;
3604     GL_MIRRORED_REPEAT:
3605       begin
3606         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3607           fWrapR := GL_MIRRORED_REPEAT
3608         else
3609           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (R).');
3610       end;
3611     else
3612       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (R).');
3613   end;
3614
3615   if ID > 0 then begin
3616     Bind (False);
3617     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
3618     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
3619     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
3620   end;
3621 end;
3622
3623
3624 procedure TglBitmap.SetDataPointer(NewData: pByte;
3625   Format: TglBitmapInternalFormat; Width: Integer; Height: Integer);
3626 begin
3627   // Data
3628   if Data <> NewData then begin
3629     if (Assigned(Data))
3630       then FreeMem(Data);
3631
3632     fData := NewData;
3633   end;
3634
3635   if Data = nil then begin
3636     fInternalFormat := ifEmpty;
3637     fPixelSize := 0;
3638     fRowSize := 0;
3639   end else begin
3640     if Width <> -1 then begin
3641       fDimension.Fields := fDimension.Fields + [ffX];
3642       fDimension.X := Width;
3643     end;
3644
3645     if Height <> -1 then begin
3646       fDimension.Fields := fDimension.Fields + [ffY];
3647       fDimension.Y := Height;
3648     end;
3649
3650     fInternalFormat := Format;
3651     fPixelSize := Trunc(FormatGetSize(InternalFormat));
3652     fRowSize :=  Trunc(FormatGetSize(InternalFormat) * Self.Width);
3653   end;
3654 end;
3655
3656 {$IFDEF GLB_SUPPORT_PNG_READ}
3657 {$IFDEF GLB_LIB_PNG}
3658 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
3659 begin
3660   TStream(png_get_io_ptr(png)).Read(buffer^, size);
3661 end;
3662 {$ENDIF}
3663
3664
3665 function TglBitmap.LoadPNG(Stream: TStream): Boolean;
3666 {$IFDEF GLB_SDL_IMAGE}
3667 var
3668   Surface: PSDL_Surface;
3669   RWops: PSDL_RWops;
3670 begin
3671   Result := False;
3672
3673   RWops := glBitmapCreateRWops(Stream);
3674   try
3675     if IMG_isPNG(RWops) > 0 then begin
3676       Surface := IMG_LoadPNG_RW(RWops);
3677       try
3678         AssignFromSurface(Surface);
3679         Result := True;
3680       finally
3681         SDL_FreeSurface(Surface);
3682       end;
3683     end;
3684   finally
3685     SDL_FreeRW(RWops);
3686   end;
3687 end;
3688 {$ENDIF}
3689 {$IFDEF GLB_LIB_PNG}
3690 var
3691   StreamPos: Int64;
3692   signature: array [0..7] of byte;
3693   png: png_structp;
3694   png_info: png_infop;
3695
3696   TempHeight, TempWidth: Integer;
3697   Format: TglBitmapInternalFormat;
3698
3699   png_data: pByte;
3700   png_rows: array of pByte;
3701   Row, LineSize: Integer;
3702 begin
3703   Result := False;
3704
3705   if not init_libPNG then
3706     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
3707
3708   try
3709     // signature
3710     StreamPos := Stream.Position;
3711     Stream.Read(signature, 8);
3712     Stream.Position := StreamPos;
3713
3714     if png_check_sig(@signature, 8) <> 0 then begin
3715       // png read struct
3716       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
3717       if png = nil then
3718         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
3719
3720       // png info
3721       png_info := png_create_info_struct(png);
3722       if png_info = nil then begin
3723         png_destroy_read_struct(@png, nil, nil);
3724         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
3725       end;
3726
3727       // set read callback
3728       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
3729
3730       // read informations
3731       png_read_info(png, png_info);
3732
3733       // size
3734       TempHeight := png_get_image_height(png, png_info);
3735       TempWidth := png_get_image_width(png, png_info);
3736
3737       // format
3738       case png_get_color_type(png, png_info) of
3739         PNG_COLOR_TYPE_GRAY:
3740           Format := ifLuminance;
3741         PNG_COLOR_TYPE_GRAY_ALPHA:
3742           Format := ifLuminanceAlpha;
3743         PNG_COLOR_TYPE_RGB:
3744           Format := ifRGB8;
3745         PNG_COLOR_TYPE_RGB_ALPHA:
3746           Format := ifRGBA8;
3747         else
3748           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3749       end;
3750
3751       // cut upper 8 bit from 16 bit formats
3752       if png_get_bit_depth(png, png_info) > 8 then
3753         png_set_strip_16(png);
3754
3755       // expand bitdepth smaller than 8
3756       if png_get_bit_depth(png, png_info) < 8 then
3757         png_set_expand(png);
3758
3759       // allocating mem for scanlines
3760       LineSize := png_get_rowbytes(png, png_info);
3761       GetMem(png_data, TempHeight * LineSize);
3762       try
3763         SetLength(png_rows, TempHeight);
3764         for Row := Low(png_rows) to High(png_rows) do begin
3765           png_rows[Row] := png_data;
3766           Inc(png_rows[Row], Row * LineSize);
3767         end;
3768
3769         // read complete image into scanlines
3770         png_read_image(png, @png_rows[0]);
3771
3772         // read end
3773         png_read_end(png, png_info);
3774
3775         // destroy read struct
3776         png_destroy_read_struct(@png, @png_info, nil);
3777
3778         SetLength(png_rows, 0);
3779
3780         // set new data
3781         SetDataPointer(png_data, Format, TempWidth, TempHeight);
3782
3783         Result := True;
3784       except
3785         FreeMem(png_data);
3786         raise;
3787       end;
3788     end;
3789   finally
3790     quit_libPNG;
3791   end;
3792 end;
3793 {$ENDIF}
3794 {$IFDEF GLB_PNGIMAGE}
3795 var
3796   StreamPos: Int64;
3797   Png: TPNGObject;
3798   Header: Array[0..7] of Byte;
3799   Row, Col, PixSize, LineSize: Integer;
3800   NewImage, pSource, pDest, pAlpha: pByte;
3801   Format: TglBitmapInternalFormat;
3802
3803 const
3804   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
3805
3806 begin
3807   Result := False;
3808
3809   StreamPos := Stream.Position;
3810   Stream.Read(Header[0], SizeOf(Header));
3811   Stream.Position := StreamPos;
3812
3813   {Test if the header matches}
3814   if Header = PngHeader then begin
3815     Png := TPNGObject.Create;
3816     try
3817       Png.LoadFromStream(Stream);
3818
3819       case Png.Header.ColorType of
3820         COLOR_GRAYSCALE:
3821           Format := ifLuminance;
3822         COLOR_GRAYSCALEALPHA:
3823           Format := ifLuminanceAlpha;
3824         COLOR_RGB:
3825           Format := ifBGR8;
3826         COLOR_RGBALPHA:
3827           Format := ifBGRA8;
3828         else
3829           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3830       end;
3831
3832       PixSize := Trunc(FormatGetSize(Format));
3833       LineSize := Integer(Png.Header.Width) * PixSize;
3834
3835       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
3836       try
3837         pDest := NewImage;
3838
3839         case Png.Header.ColorType of
3840           COLOR_RGB, COLOR_GRAYSCALE:
3841             begin
3842               for Row := 0 to Png.Height -1 do begin
3843                 Move (Png.Scanline[Row]^, pDest^, LineSize);
3844                 Inc(pDest, LineSize);
3845               end;
3846             end;
3847           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
3848             begin
3849               PixSize := PixSize -1;
3850
3851               for Row := 0 to Png.Height -1 do begin
3852                 pSource := Png.Scanline[Row];
3853                 pAlpha := pByte(Png.AlphaScanline[Row]);
3854
3855                 for Col := 0 to Png.Width -1 do begin
3856                   Move (pSource^, pDest^, PixSize);
3857                   Inc(pSource, PixSize);
3858                   Inc(pDest, PixSize);
3859
3860                   pDest^ := pAlpha^;
3861                   inc(pAlpha);
3862                   Inc(pDest);
3863                 end;
3864               end;
3865             end;
3866           else
3867             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3868         end;
3869
3870         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
3871
3872         Result := True;
3873       except
3874         FreeMem(NewImage);
3875         raise;
3876       end;
3877     finally
3878       Png.Free;
3879     end;
3880   end;
3881 end;
3882 {$ENDIF}
3883 {$ENDIF}
3884
3885
3886 {$IFDEF GLB_LIB_JPEG}
3887 type
3888   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
3889   glBitmap_libJPEG_source_mgr = record
3890     pub: jpeg_source_mgr;
3891
3892     SrcStream: TStream;
3893     SrcBuffer: array [1..4096] of byte;
3894   end;
3895
3896
3897   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
3898   glBitmap_libJPEG_dest_mgr = record
3899     pub: jpeg_destination_mgr;
3900
3901     DestStream: TStream;
3902     DestBuffer: array [1..4096] of byte;
3903   end;
3904
3905
3906
3907 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
3908 //var
3909 //  Msg: String;
3910 begin
3911 //  SetLength(Msg, 256);
3912 //  cinfo^.err^.format_message(cinfo, pChar(Msg));
3913
3914 //  Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3915
3916 //  cinfo^.global_state := 0;
3917
3918 //  jpeg_abort(cinfo);
3919 end;
3920
3921
3922 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
3923 //var
3924 //  Msg: String;
3925 begin
3926 //  SetLength(Msg, 256);
3927 //  cinfo^.err^.format_message(cinfo, pChar(Msg));
3928
3929 //  Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3930
3931 //  cinfo^.global_state := 0;
3932 end;
3933
3934
3935 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
3936 begin
3937 end;
3938
3939
3940 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
3941 var
3942   src: glBitmap_libJPEG_source_mgr_ptr;
3943   bytes: integer;
3944 begin
3945   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3946
3947   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
3948         if (bytes <= 0) then begin
3949                 src^.SrcBuffer[1] := $FF;
3950                 src^.SrcBuffer[2] := JPEG_EOI;
3951                 bytes := 2;
3952         end;
3953
3954         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
3955         src^.pub.bytes_in_buffer := bytes;
3956
3957   result := true;
3958 end;
3959
3960
3961 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
3962 var
3963   src: glBitmap_libJPEG_source_mgr_ptr;
3964 begin
3965   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3966
3967   if num_bytes > 0 then begin
3968     // wanted byte isn't in buffer so set stream position and read buffer
3969     if num_bytes > src^.pub.bytes_in_buffer then begin
3970       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
3971       src^.pub.fill_input_buffer(cinfo);
3972     end else begin
3973       // wanted byte is in buffer so only skip
3974                 inc(src^.pub.next_input_byte, num_bytes);
3975                 dec(src^.pub.bytes_in_buffer, num_bytes);
3976     end;
3977   end;
3978 end;
3979
3980
3981 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
3982 begin
3983 end;
3984
3985
3986 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
3987 begin
3988 end;
3989
3990
3991 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
3992 var
3993   dest: glBitmap_libJPEG_dest_mgr_ptr;
3994 begin
3995   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
3996
3997   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
3998     // write complete buffer
3999     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
4000
4001     // reset buffer
4002     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
4003     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
4004   end;
4005
4006   Result := True;
4007 end;
4008
4009
4010 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
4011 var
4012   Idx: Integer;
4013   dest: glBitmap_libJPEG_dest_mgr_ptr;
4014 begin
4015   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
4016
4017   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
4018     // check for endblock
4019     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
4020       // write endblock
4021       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
4022
4023       // leave
4024       Break;
4025     end else
4026       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
4027   end;
4028 end;
4029 {$ENDIF}
4030
4031
4032 {$IFDEF GLB_SUPPORT_JPEG_READ}
4033 function TglBitmap.LoadJPEG(Stream: TStream): Boolean;
4034 {$IFDEF GLB_SDL_IMAGE}
4035 var
4036   Surface: PSDL_Surface;
4037   RWops: PSDL_RWops;
4038 begin
4039   Result := False;
4040
4041   RWops := glBitmapCreateRWops(Stream);
4042   try
4043     if IMG_isJPG(RWops) > 0 then begin
4044       Surface := IMG_LoadJPG_RW(RWops);
4045       try
4046         AssignFromSurface(Surface);
4047         Result := True;
4048       finally
4049         SDL_FreeSurface(Surface);
4050       end;
4051     end;
4052   finally
4053     SDL_FreeRW(RWops);
4054   end;
4055 end;
4056 {$ENDIF}
4057 {$IFDEF GLB_LIB_JPEG}
4058 var
4059   StreamPos: Int64;
4060   Temp: array[0..1]of Byte;
4061
4062   jpeg: jpeg_decompress_struct;
4063   jpeg_err: jpeg_error_mgr;
4064
4065   IntFormat: TglBitmapInternalFormat;
4066   pImage: pByte;
4067   TempHeight, TempWidth: Integer;
4068
4069   pTemp: pByte;
4070   Row: Integer;
4071 begin
4072   Result := False;
4073
4074   if not init_libJPEG then
4075     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
4076
4077   try
4078     // reading first two bytes to test file and set cursor back to begin
4079     StreamPos := Stream.Position;
4080     Stream.Read(Temp[0], 2);
4081     Stream.Position := StreamPos;
4082
4083     // if Bitmap then read file.
4084     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
4085       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
4086       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
4087
4088       // error managment
4089       jpeg.err := jpeg_std_error(@jpeg_err);
4090       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
4091       jpeg_err.output_message := glBitmap_libJPEG_output_message;
4092
4093       // decompression struct
4094       jpeg_create_decompress(@jpeg);
4095
4096       // allocation space for streaming methods
4097       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
4098
4099       // seeting up custom functions
4100       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
4101         pub.init_source       := glBitmap_libJPEG_init_source;
4102         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
4103         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
4104         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
4105         pub.term_source       := glBitmap_libJPEG_term_source;
4106
4107         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
4108         pub.next_input_byte := nil;   // until buffer loaded
4109
4110         SrcStream := Stream;
4111       end;
4112
4113       // set global decoding state
4114       jpeg.global_state := DSTATE_START;
4115
4116       // read header of jpeg
4117       jpeg_read_header(@jpeg, False);
4118
4119       // setting output parameter
4120       case jpeg.jpeg_color_space of
4121         JCS_GRAYSCALE:
4122           begin
4123             jpeg.out_color_space := JCS_GRAYSCALE;
4124             IntFormat := ifLuminance;
4125           end;
4126         else
4127           jpeg.out_color_space := JCS_RGB;
4128           IntFormat := ifRGB8;
4129       end;
4130
4131       // reading image
4132       jpeg_start_decompress(@jpeg);
4133
4134       TempHeight := jpeg.output_height;
4135       TempWidth := jpeg.output_width;
4136
4137       // creating new image
4138       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
4139       try
4140         pTemp := pImage;
4141
4142         for Row := 0 to TempHeight -1 do begin
4143           jpeg_read_scanlines(@jpeg, @pTemp, 1);
4144           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
4145         end;
4146
4147         // finish decompression
4148         jpeg_finish_decompress(@jpeg);
4149
4150         // destroy decompression
4151         jpeg_destroy_decompress(@jpeg);
4152
4153         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
4154
4155         Result := True;
4156       except
4157         FreeMem(pImage);
4158         raise;
4159       end;
4160     end;
4161   finally
4162     quit_libJPEG;
4163   end;
4164 end;
4165 {$ENDIF}
4166 {$IFDEF GLB_DELPHI_JPEG}
4167 var
4168   bmp: TBitmap;
4169   jpg: TJPEGImage;
4170   StreamPos: Int64;
4171   Temp: array[0..1]of Byte;
4172 begin
4173   Result := False;
4174
4175   // reading first two bytes to test file and set cursor back to begin
4176   StreamPos := Stream.Position;
4177   Stream.Read(Temp[0], 2);
4178   Stream.Position := StreamPos;
4179
4180   // if Bitmap then read file.
4181   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
4182     bmp := TBitmap.Create;
4183     try
4184       jpg := TJPEGImage.Create;
4185       try
4186         jpg.LoadFromStream(Stream);
4187         bmp.Assign(jpg);
4188         Result := AssignFromBitmap(bmp);
4189       finally
4190         jpg.Free;
4191       end;
4192     finally
4193       bmp.Free;
4194     end;
4195   end;
4196 end;
4197 {$ENDIF}
4198 {$ENDIF}
4199
4200
4201 const
4202   BMP_MAGIC          = $4D42;
4203
4204   BMP_COMP_RGB       = 0;
4205   BMP_COMP_RLE8      = 1;
4206   BMP_COMP_RLE4      = 2;
4207   BMP_COMP_BITFIELDS = 3;
4208
4209 type
4210   TBMPHeader = packed record
4211     bfType: Word;
4212     bfSize: Cardinal;
4213     bfReserved1: Word;
4214     bfReserved2: Word;
4215     bfOffBits: Cardinal;
4216   end;
4217
4218   TBMPInfo = packed record
4219     biSize: Cardinal;
4220     biWidth: Longint;
4221     biHeight: Longint;
4222     biPlanes: Word;
4223     biBitCount: Word;
4224     biCompression: Cardinal;
4225     biSizeImage: Cardinal;
4226     biXPelsPerMeter: Longint;
4227     biYPelsPerMeter: Longint;
4228     biClrUsed: Cardinal;
4229     biClrImportant: Cardinal;
4230   end;
4231
4232   TBMPInfoOS = packed record
4233     biSize: Cardinal;
4234     biWidth: Longint;
4235     biHeight: Longint;
4236     biPlanes: Word;
4237     biBitCount: Word;
4238   end;
4239
4240 //  TBMPPalette = record
4241 //    case Boolean of
4242 //      True : (Colors: array[Byte] of TRGBQUAD);
4243 //      False: (redMask, greenMask, blueMask: Cardinal);
4244 //  end;
4245
4246 function TglBitmap.LoadBMP(Stream: TStream): Boolean;
4247 var
4248   StreamPos: Int64;
4249   Header: TBMPHeader;
4250   Info: TBMPInfo;
4251   NewImage, pData: pByte;
4252
4253   Format: TglBitmapInternalFormat;
4254   LineSize, Padding, LineIdx: Integer;
4255   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
4256
4257   PaddingBuff: Cardinal;
4258
4259
4260   function GetLineWidth : Integer;
4261   begin
4262     Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
4263   end;
4264
4265
4266 begin
4267   Result := False;
4268
4269   RedMask := 0;
4270   GreenMask := 0;
4271   BlueMask := 0;
4272   Format := ifEmpty;
4273
4274   // Header
4275   StreamPos := Stream.Position;
4276   Stream.Read(Header, SizeOf(Header));
4277
4278   if Header.bfType = BMP_MAGIC then begin
4279     Stream.Read(Info, SizeOf(Info));
4280
4281     // Check for Compression
4282     if Info.biCompression <> BMP_COMP_RGB then begin
4283       if Info.biCompression = BMP_COMP_BITFIELDS then begin
4284         // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!)
4285         if (Info.biBitCount = 16) or (Info.biBitCount = 32) then begin
4286           Stream.Read(RedMask,   SizeOf(Cardinal));
4287           Stream.Read(GreenMask, SizeOf(Cardinal));
4288           Stream.Read(BlueMask,  SizeOf(Cardinal));
4289           Stream.Read(AlphaMask, SizeOf(Cardinal));
4290         end;
4291       end else begin
4292         // RLE compression is unsupported
4293         Stream.Position := StreamPos;
4294
4295         Exit;
4296       end;
4297     end;
4298
4299     // Skip palette
4300     if Info.biBitCount < 16 then
4301       Stream.Position := Stream.Position + Info.biClrUsed * 4;
4302
4303     // Jump to the data
4304     Stream.Position := StreamPos + Header.bfOffBits;
4305
4306     // Select Format
4307     case Info.biBitCount of
4308       8 : Format := ifLuminance;
4309       16:
4310         begin
4311           if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
4312               Format := ifRGB5A1;
4313           end else begin
4314             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifLuminanceAlpha) then
4315               Format := ifLuminanceAlpha;
4316
4317             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGBA4) then
4318               Format := ifRGBA4;
4319
4320             if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, ifRGB5A1) then
4321               Format := ifRGB5A1;
4322
4323             if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, ifR5G6B5) then
4324               Format := ifR5G6B5;
4325           end;
4326         end;
4327       24: Format := ifBGR8;
4328       32:
4329         begin
4330           if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
4331             Format := ifBGRA8;
4332           end else begin
4333             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGBA8) then
4334               Format := ifRGBA8;
4335
4336             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifBGRA8) then
4337               Format := ifBGRA8;
4338
4339             if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGB10A2) then
4340               Format := ifRGB10A2;
4341           end;
4342         end;
4343     end;
4344
4345     if Format <> ifEmpty then begin
4346        LineSize := Trunc(Info.biWidth * FormatGetSize(Format));
4347       Padding := GetLineWidth - LineSize;
4348
4349       // copying data
4350       GetMem(NewImage, Info.biHeight * LineSize);
4351       try
4352         FillChar(NewImage^, Info.biHeight * LineSize, $FF);
4353
4354         // Set pData to last Line
4355         pData := NewImage;
4356         Inc(pData, LineSize * (Info.biHeight -1));
4357
4358         // Copy Image Data
4359         for LineIdx := 0 to Info.biHeight - 1 do begin
4360           Stream.Read(pData^, LineSize);
4361           Dec(pData, LineSize);
4362
4363           Stream.Read(PaddingBuff, Padding);
4364         end;
4365
4366         // Set new Image
4367         SetDataPointer(NewImage, Format, Info.biWidth, Info.biHeight);
4368
4369         Result := True;
4370       except
4371         FreeMem(NewImage);
4372         raise;
4373       end;
4374     end;
4375   end
4376     else Stream.Position := StreamPos;
4377 end;
4378
4379
4380 const
4381   DDS_MAGIC                   = $20534444;
4382
4383   // DDS_header.dwFlags
4384   DDSD_CAPS                   = $00000001;
4385   DDSD_HEIGHT                 = $00000002;
4386   DDSD_WIDTH                  = $00000004;
4387   DDSD_PITCH                  = $00000008;
4388   DDSD_PIXELFORMAT            = $00001000;
4389   DDSD_MIPMAPCOUNT            = $00020000;
4390   DDSD_LINEARSIZE             = $00080000;
4391   DDSD_DEPTH                  = $00800000;
4392
4393   // DDS_header.sPixelFormat.dwFlags
4394   DDPF_ALPHAPIXELS            = $00000001;
4395   DDPF_FOURCC                 = $00000004;
4396   DDPF_INDEXED                = $00000020;
4397   DDPF_RGB                    = $00000040;
4398
4399   // DDS_header.sCaps.dwCaps1
4400   DDSCAPS_COMPLEX             = $00000008;
4401   DDSCAPS_TEXTURE             = $00001000;
4402   DDSCAPS_MIPMAP              = $00400000;
4403
4404   // DDS_header.sCaps.dwCaps2
4405   DDSCAPS2_CUBEMAP            = $00000200;
4406   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;
4407   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;
4408   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;
4409   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;
4410   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;
4411   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;
4412   DDSCAPS2_VOLUME             = $00200000;
4413
4414   D3DFMT_DXT1                 = $31545844;
4415   D3DFMT_DXT3                 = $33545844;
4416   D3DFMT_DXT5                 = $35545844;
4417
4418 type
4419   TDDSPixelFormat = packed record
4420     dwSize: Cardinal;
4421     dwFlags: Cardinal;
4422     dwFourCC: Cardinal;
4423     dwRGBBitCount: Cardinal;
4424     dwRBitMask: Cardinal;
4425     dwGBitMask: Cardinal;
4426     dwBBitMask: Cardinal;
4427     dwAlphaBitMask: Cardinal;
4428   end;
4429
4430   TDDSCaps = packed record
4431     dwCaps1: Cardinal;
4432     dwCaps2: Cardinal;
4433     dwDDSX: Cardinal;
4434     dwReserved: Cardinal;
4435   end;
4436
4437   TDDSHeader = packed record
4438     dwMagic: Cardinal;
4439     dwSize: Cardinal;
4440     dwFlags: Cardinal;
4441     dwHeight: Cardinal;
4442     dwWidth: Cardinal;
4443     dwPitchOrLinearSize: Cardinal;
4444     dwDepth: Cardinal;
4445     dwMipMapCount: Cardinal;
4446     dwReserved: array[0..10] of Cardinal;
4447     PixelFormat: TDDSPixelFormat;
4448     Caps: TDDSCaps;
4449     dwReserved2: Cardinal;
4450   end;
4451
4452 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4453 begin
4454   if fCustomData = aValue then Exit;
4455   fCustomData := aValue;
4456 end;
4457
4458 procedure TglBitmap.SetCustomName(const aValue: String);
4459 begin
4460   if fCustomName = aValue then Exit;
4461   fCustomName := aValue;
4462 end;
4463
4464 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4465 begin
4466   if fCustomNameW = aValue then Exit;
4467   fCustomNameW := aValue;
4468 end;
4469
4470 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4471 begin
4472   if fDeleteTextureOnFree = aValue then Exit;
4473   fDeleteTextureOnFree := aValue;
4474 end;
4475
4476 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4477 begin
4478   if fFormat = aValue then Exit;
4479   fFormat := aValue;
4480 end;
4481
4482 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4483 begin
4484   if fFreeDataAfterGenTexture = aValue then Exit;
4485   fFreeDataAfterGenTexture := aValue;
4486 end;
4487
4488 procedure TglBitmap.SetID(const aValue: Cardinal);
4489 begin
4490   if fID = aValue then Exit;
4491   fID := aValue;
4492 end;
4493
4494 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4495 begin
4496   if fMipMap = aValue then Exit;
4497   fMipMap := aValue;
4498 end;
4499
4500 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4501 begin
4502   if fTarget = aValue then Exit;
4503   fTarget := aValue;
4504 end;
4505
4506 function TglBitmap.LoadDDS(Stream: TStream): Boolean;
4507 var
4508   Header: TDDSHeader;
4509   StreamPos: Int64;
4510   Y, LineSize: Cardinal;
4511
4512 //  MipMapCount, X, Y, XSize, YSize: Cardinal;
4513   RowSize: Cardinal;
4514   NewImage, pData: pByte;
4515   Format: TglBitmapInternalFormat;
4516
4517
4518   function RaiseEx : Exception;
4519   begin
4520     Result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
4521   end;
4522
4523
4524   function GetInternalFormat: TglBitmapInternalFormat;
4525   begin
4526     with Header.PixelFormat do begin
4527       // Compresses
4528       if (dwFlags and DDPF_FOURCC) > 0 then begin
4529         case Header.PixelFormat.dwFourCC of
4530           D3DFMT_DXT1: Result := ifDXT1;
4531           D3DFMT_DXT3: Result := ifDXT3;
4532           D3DFMT_DXT5: Result := ifDXT5;
4533           else
4534             raise RaiseEx;
4535         end;
4536       end else
4537
4538       // RGB
4539       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4540         case dwRGBBitCount of
4541            8:
4542             begin
4543               if dwFlags and DDPF_ALPHAPIXELS > 0 then
4544                 Result := ifAlpha
4545               else
4546                 Result := ifLuminance;
4547             end;
4548           16:
4549             begin
4550               if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
4551                 // Alpha
4552                 case GetBitSize(dwRBitMask) of
4553                   5: Result := ifRGB5A1;
4554                   4: Result := ifRGBA4;
4555                 else
4556                   Result := ifLuminanceAlpha;
4557                 end;
4558               end else begin
4559                 // no Alpha
4560                 Result := ifR5G6B5;
4561               end;
4562             end;
4563           24:
4564             begin
4565               if dwRBitMask > dwBBitMask then
4566                 Result := ifBGR8
4567               else
4568                 Result := ifRGB8;
4569             end;
4570           32:
4571             begin
4572               if GetBitSize(dwRBitMask) = 10 then
4573                 Result := ifRGB10A2
4574               else
4575
4576               if dwRBitMask > dwBBitMask then
4577                 Result := ifBGRA8
4578               else
4579                 Result := ifRGBA8;
4580             end;
4581           else
4582             raise RaiseEx;
4583         end;
4584       end else
4585         raise RaiseEx;
4586     end;
4587   end;
4588
4589 begin
4590   Result := False;
4591
4592   // Header
4593   StreamPos := Stream.Position;
4594   Stream.Read(Header, sizeof(Header));
4595
4596   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
4597      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
4598     Stream.Position := StreamPos;
4599     Exit;
4600   end;
4601
4602   // Pixelformat
4603 //  if Header.dwFlags and DDSD_MIPMAPCOUNT <> 0
4604 //    then MipMapCount := Header.dwMipMapCount
4605 //    else MipMapCount := 1;
4606
4607   Format := GetInternalFormat;
4608   LineSize := Trunc(Header.dwWidth * FormatGetSize(Format));
4609
4610   GetMem(NewImage, Header.dwHeight * LineSize);
4611   try
4612     pData := NewImage;
4613
4614     // Compressed
4615     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
4616       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
4617
4618       for Y := 0 to Header.dwHeight -1 do begin
4619         Stream.Read(pData^, RowSize);
4620         Inc(pData, LineSize);
4621       end;
4622     end else
4623
4624     // RGB(A)
4625     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4626       RowSize := Header.dwPitchOrLinearSize;
4627
4628       for Y := 0 to Header.dwHeight -1 do begin
4629         Stream.Read(pData^, RowSize);
4630         Inc(pData, LineSize);
4631       end;
4632     end
4633       else raise RaiseEx;
4634
4635     SetDataPointer(NewImage, Format, Header.dwWidth, Header.dwHeight);
4636
4637     Result := True;
4638   except
4639     FreeMem(NewImage);
4640     raise;
4641   end;
4642 end;
4643
4644
4645 type
4646   TTGAHeader = packed record
4647     ImageID: Byte;
4648     ColorMapType: Byte;
4649     ImageType: Byte;
4650     ColorMapSpec: Array[0..4] of Byte;
4651     OrigX: Word;
4652     OrigY: Word;
4653     Width: Word;
4654     Height: Word;
4655     Bpp: Byte;
4656     ImageDes: Byte;
4657   end;
4658
4659 const
4660   TGA_UNCOMPRESSED_RGB = 2;
4661   TGA_UNCOMPRESSED_GRAY = 3;
4662   TGA_COMPRESSED_RGB = 10;
4663   TGA_COMPRESSED_GRAY = 11;
4664
4665
4666
4667 function TglBitmap.LoadTGA(Stream: TStream): Boolean;
4668 var
4669   Header: TTGAHeader;
4670   NewImage, pData: PByte;
4671   StreamPos: Int64;
4672   PixelSize, LineSize, YStart, YEnd, YInc: Integer;
4673   Format: TglBitmapInternalFormat;
4674
4675 const
4676   CACHE_SIZE = $4000;
4677
4678   procedure ReadUncompressed;
4679   var
4680     RowSize: Integer;
4681   begin
4682     RowSize := Header.Width * PixelSize;
4683
4684     // copy line by line
4685     while YStart <> YEnd + YInc do begin
4686       pData := NewImage;
4687       Inc(pData, YStart * LineSize);
4688
4689       Stream.Read(pData^, RowSize);
4690       Inc(YStart, YInc);
4691     end;
4692   end;
4693
4694
4695   procedure ReadCompressed;
4696   var
4697     HeaderWidth, HeaderHeight: Integer;
4698     LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
4699
4700     Cache: PByte;
4701     CacheSize, CachePos: Integer;
4702
4703     Temp: Byte;
4704     TempBuf: Array [0..15] of Byte;
4705
4706     PixelRepeat: Boolean;
4707     PixelToRead, TempPixels: Integer;
4708
4709
4710     procedure CheckLine;
4711     begin
4712       if LinePixelsRead >= HeaderWidth then begin
4713         LinePixelsRead := 0;
4714         pData := NewImage;
4715         Inc(YStart, YInc);
4716         Inc(pData, YStart * LineSize);
4717       end;
4718     end;
4719
4720
4721     procedure CachedRead(var Buffer; Count: Integer);
4722     var
4723       BytesRead: Integer;
4724     begin
4725       if (CachePos + Count) > CacheSize then begin
4726         BytesRead := 0;
4727
4728         // Read Data
4729         if CacheSize - CachePos > 0 then begin
4730           BytesRead := CacheSize - CachePos;
4731
4732           Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
4733           Inc(CachePos, BytesRead);
4734         end;
4735
4736         // Reload Data
4737         CacheSize := Min(CACHE_SIZE, Stream.Size - Stream.Position);
4738         Stream.Read(Cache^, CacheSize);
4739         CachePos := 0;
4740
4741         // Read else
4742         if Count - BytesRead > 0 then begin
4743           Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
4744           Inc(CachePos, Count - BytesRead);
4745         end;
4746       end else begin
4747         Move(pByteArray(Cache)^[CachePos], Buffer, Count);
4748         Inc(CachePos, Count);
4749       end;
4750     end;
4751
4752
4753   begin
4754     CacheSize := 0;
4755     CachePos := 0;
4756
4757     HeaderWidth := Header.Width;
4758     HeaderHeight := Header.Height;
4759
4760     GetMem(Cache, CACHE_SIZE); // 16K Buffer
4761     try
4762       ImgPixelsToRead := HeaderWidth * HeaderHeight;
4763       ImgPixelsRead := 0;
4764       LinePixelsRead := 0;
4765
4766       pData := NewImage;
4767       Inc(pData, YStart * LineSize);
4768
4769       // Read until all Pixels
4770       repeat
4771         CachedRead(Temp, 1);
4772
4773         PixelRepeat := Temp and $80 > 0;
4774         PixelToRead := (Temp and $7F) + 1;
4775
4776         Inc(ImgPixelsRead, PixelToRead);
4777
4778         if PixelRepeat then begin
4779           // repeat one pixel x times
4780           CachedRead(TempBuf[0], PixelSize);
4781
4782           // repeat Pixel
4783           while PixelToRead > 0 do begin
4784             CheckLine;
4785
4786             TempPixels := HeaderWidth - LinePixelsRead;
4787             if PixelToRead < TempPixels then
4788               TempPixels := PixelToRead;
4789
4790             Inc(LinePixelsRead, TempPixels);
4791             Dec(PixelToRead, TempPixels);
4792
4793             while TempPixels > 0 do begin
4794               case PixelSize of
4795                 1:
4796                   begin
4797                     pData^ := TempBuf[0];
4798                     Inc(pData);
4799                   end;
4800                 2:
4801                   begin
4802                     pWord(pData)^ := pWord(@TempBuf[0])^;
4803                     Inc(pData, 2);
4804                   end;
4805                 3:
4806                   begin
4807                     pWord(pData)^ := pWord(@TempBuf[0])^;
4808                     Inc(pData, 2);
4809                     pData^ := TempBuf[2];
4810                     Inc(pData);
4811                   end;
4812                 4:
4813                   begin
4814                     pDWord(pData)^ := pDWord(@TempBuf[0])^;
4815                     Inc(pData, 4);
4816                   end;
4817               end;
4818
4819               Dec(TempPixels);
4820             end;
4821           end;
4822         end else begin
4823           // copy x pixels
4824           while PixelToRead > 0 do begin
4825             CheckLine;
4826
4827             TempPixels := HeaderWidth - LinePixelsRead;
4828             if PixelToRead < TempPixels then
4829               TempPixels := PixelToRead;
4830
4831             CachedRead(pData^, PixelSize * TempPixels);
4832             Inc(pData, PixelSize * TempPixels);
4833
4834             Inc(LinePixelsRead, TempPixels);
4835
4836             Dec(PixelToRead, TempPixels);
4837           end;
4838         end;
4839       until ImgPixelsRead >= ImgPixelsToRead;
4840     finally
4841       FreeMem(Cache)
4842     end;
4843   end;
4844
4845 begin
4846   Result := False;
4847
4848   // reading header to test file and set cursor back to begin
4849   StreamPos := Stream.Position;
4850   Stream.Read(Header, SizeOf(Header));
4851
4852   // no colormapped files
4853   if (Header.ColorMapType = 0) then begin
4854     if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
4855       case Header.Bpp of
4856          8: Format := ifAlpha;
4857         16: Format := ifLuminanceAlpha;
4858         24: Format := ifBGR8;
4859         32: Format := ifBGRA8;
4860         else
4861           raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
4862       end;
4863
4864       // skip image ID
4865       if Header.ImageID <> 0 then
4866         Stream.Position := Stream.Position + Header.ImageID;
4867
4868       PixelSize := Trunc(FormatGetSize(Format));
4869       LineSize := Trunc(Header.Width * PixelSize);
4870
4871       GetMem(NewImage, LineSize * Header.Height);
4872       try
4873         // Row direction
4874         if (Header.ImageDes and $20 > 0) then begin
4875           YStart := 0;
4876           YEnd := Header.Height -1;
4877           YInc := 1;
4878         end else begin
4879           YStart := Header.Height -1;
4880           YEnd := 0;
4881           YInc := -1;
4882         end;
4883
4884         // Read Image
4885         case Header.ImageType of
4886           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
4887             ReadUncompressed;
4888           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
4889             ReadCompressed;
4890         end;
4891
4892         SetDataPointer(NewImage, Format, Header.Width, Header.Height);
4893
4894         Result := True;
4895       except
4896         FreeMem(NewImage);
4897         raise;
4898       end;
4899     end
4900       else Stream.Position := StreamPos;
4901   end
4902     else Stream.Position := StreamPos;
4903 end;
4904
4905
4906 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4907 {$IFDEF GLB_LIB_PNG}
4908 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4909 begin
4910   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4911 end;
4912 {$ENDIF}
4913
4914 procedure TglBitmap.SavePNG(Stream: TStream);
4915 {$IFDEF GLB_LIB_PNG}
4916 var
4917   png: png_structp;
4918   png_info: png_infop;
4919   png_rows: array of pByte;
4920   LineSize: Integer;
4921   ColorType: Integer;
4922   Row: Integer;
4923 begin
4924   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4925     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4926
4927   if not init_libPNG then
4928     raise Exception.Create('SavePNG - unable to initialize libPNG.');
4929
4930   try
4931     case FInternalFormat of
4932       ifAlpha, ifLuminance, ifDepth8:
4933         ColorType := PNG_COLOR_TYPE_GRAY;
4934       ifLuminanceAlpha:
4935         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4936       ifBGR8, ifRGB8:
4937         ColorType := PNG_COLOR_TYPE_RGB;
4938       ifBGRA8, ifRGBA8:
4939         ColorType := PNG_COLOR_TYPE_RGBA;
4940       else
4941         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4942     end;
4943
4944     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
4945
4946     // creating array for scanline
4947     SetLength(png_rows, Height);
4948     try
4949       for Row := 0 to Height - 1 do begin
4950         png_rows[Row] := Data;
4951         Inc(png_rows[Row], Row * LineSize)
4952       end;
4953
4954       // write struct
4955       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4956       if png = nil then
4957         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4958
4959       // create png info
4960       png_info := png_create_info_struct(png);
4961       if png_info = nil then begin
4962         png_destroy_write_struct(@png, nil);
4963         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4964       end;
4965
4966       // set read callback
4967       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
4968
4969       // set compression
4970       png_set_compression_level(png, 6);
4971
4972       if InternalFormat in [ifBGR8, ifBGRA8] then
4973         png_set_bgr(png);
4974
4975       // setup header
4976       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4977
4978       // write info
4979       png_write_info(png, png_info);
4980
4981       // write image data
4982       png_write_image(png, @png_rows[0]);
4983
4984       // write end
4985       png_write_end(png, png_info);
4986
4987       // destroy write struct
4988       png_destroy_write_struct(@png, @png_info);
4989     finally
4990       SetLength(png_rows, 0);
4991     end;
4992   finally
4993     quit_libPNG;
4994   end;
4995 end;
4996 {$ENDIF}
4997 {$IFDEF GLB_PNGIMAGE}
4998 var
4999   Png: TPNGObject;
5000
5001   pSource, pDest: pByte;
5002   X, Y, PixSize: Integer;
5003   ColorType: Cardinal;
5004   Alpha: Boolean;
5005
5006   pTemp: pByte;
5007   Temp: Byte;
5008 begin
5009   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5010     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5011
5012   case FInternalFormat of
5013     ifAlpha, ifLuminance, ifDepth8:
5014       begin
5015         ColorType := COLOR_GRAYSCALE;
5016         PixSize := 1;
5017         Alpha := False;
5018       end;
5019     ifLuminanceAlpha:
5020       begin
5021         ColorType := COLOR_GRAYSCALEALPHA;
5022         PixSize := 1;
5023         Alpha := True;
5024       end;
5025     ifBGR8, ifRGB8:
5026       begin
5027         ColorType := COLOR_RGB;
5028         PixSize := 3;
5029         Alpha := False;
5030       end;
5031     ifBGRA8, ifRGBA8:
5032       begin
5033         ColorType := COLOR_RGBALPHA;
5034         PixSize := 3;
5035         Alpha := True
5036       end;
5037     else
5038       raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5039   end;
5040
5041   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5042   try
5043     // Copy ImageData
5044     pSource := Data;
5045     for Y := 0 to Height -1 do begin
5046       pDest := png.ScanLine[Y];
5047
5048       for X := 0 to Width -1 do begin
5049         Move(pSource^, pDest^, PixSize);
5050
5051         Inc(pDest, PixSize);
5052         Inc(pSource, PixSize);
5053
5054         if Alpha then begin
5055           png.AlphaScanline[Y]^[X] := pSource^;
5056           Inc(pSource);
5057         end;
5058       end;
5059
5060       // convert RGB line to BGR
5061       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5062         pTemp := png.ScanLine[Y];
5063
5064         for X := 0 to Width -1 do begin
5065           Temp := pByteArray(pTemp)^[0];
5066           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5067           pByteArray(pTemp)^[2] := Temp;
5068
5069           Inc(pTemp, 3);
5070         end;
5071       end;
5072     end;
5073
5074     // Save to Stream
5075     Png.CompressionLevel := 6;
5076     Png.SaveToStream(Stream);
5077   finally
5078     FreeAndNil(Png);
5079   end;
5080 end;
5081 {$ENDIF}
5082 {$ENDIF}
5083
5084
5085 procedure TglBitmap.SaveDDS(Stream: TStream);
5086 var
5087   Header: TDDSHeader;
5088   Pix: TglBitmapPixelData;
5089 begin
5090   if not FormatIsUncompressed(InternalFormat) then
5091     raise EglBitmapUnsupportedInternalFormat.Create('SaveDDS - ' + UNSUPPORTED_INTERNAL_FORMAT);
5092
5093   if InternalFormat = ifAlpha then
5094     FormatPreparePixel(Pix, ifLuminance)
5095   else
5096     FormatPreparePixel(Pix, InternalFormat);
5097
5098   // Generell
5099   FillChar(Header, SizeOf(Header), 0);
5100
5101   Header.dwMagic := DDS_MAGIC;
5102   Header.dwSize := 124;
5103   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
5104
5105   if Width > 0 then begin
5106     Header.dwWidth := Width;
5107     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
5108   end;
5109
5110   if Height > 0 then begin
5111     Header.dwHeight := Height;
5112     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
5113   end;
5114
5115   Header.dwPitchOrLinearSize := fRowSize;
5116   Header.dwMipMapCount := 1;
5117
5118   // Caps
5119   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
5120
5121   // Pixelformat
5122   Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
5123   Header.PixelFormat.dwFlags := DDPF_RGB;
5124
5125   if FormatHasAlpha(InternalFormat) and (InternalFormat <> ifAlpha)
5126     then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
5127
5128   Header.PixelFormat.dwRGBBitCount  := Trunc(FormatGetSize(InternalFormat) * 8);
5129   Header.PixelFormat.dwRBitMask     := Pix.PixelDesc.RedRange   shl Pix.PixelDesc.RedShift;
5130   Header.PixelFormat.dwGBitMask     := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift;
5131   Header.PixelFormat.dwBBitMask     := Pix.PixelDesc.BlueRange  shl Pix.PixelDesc.BlueShift;
5132   Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift;
5133
5134   // Write
5135   Stream.Write(Header, SizeOf(Header));
5136
5137   Stream.Write(Data^, FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat));
5138 end;
5139
5140
5141 procedure TglBitmap.SaveTGA(Stream: TStream);
5142 var
5143   Header: TTGAHeader;
5144   Size: Integer;
5145   pTemp: pByte;
5146
5147
5148   procedure ConvertData(pTemp: pByte);
5149   var
5150     Idx, PixelSize: Integer;
5151     Temp: byte;
5152   begin
5153     PixelSize := fPixelSize;
5154
5155     for Idx := 1 to Height * Width do begin
5156       Temp := pByteArray(pTemp)^[2];
5157       pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
5158       pByteArray(pTemp)^[0] := Temp;
5159
5160       Inc(pTemp, PixelSize);
5161     end;
5162   end;
5163
5164
5165 begin
5166   if not (ftTGA in FormatGetSupportedFiles (InternalFormat)) then
5167     raise EglBitmapUnsupportedInternalFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
5168
5169   FillChar(Header, SizeOf(Header), 0);
5170
5171   case InternalFormat of
5172     ifAlpha, ifLuminance, ifDepth8:
5173       begin
5174         Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5175         Header.Bpp := 8;
5176       end;
5177     ifLuminanceAlpha:
5178       begin
5179         Header.ImageType := TGA_UNCOMPRESSED_GRAY;
5180         Header.Bpp := 16;
5181       end;
5182     ifRGB8, ifBGR8:
5183       begin
5184         Header.ImageType := TGA_UNCOMPRESSED_RGB;
5185         Header.Bpp := 24;
5186       end;
5187     ifRGBA8, ifBGRA8:
5188       begin
5189         Header.ImageType := TGA_UNCOMPRESSED_RGB;
5190         Header.Bpp := 32;
5191       end;
5192     else
5193       raise EglBitmapUnsupportedInternalFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
5194   end;
5195
5196   Header.Width := Width;
5197   Header.Height := Height;
5198   Header.ImageDes := $20;
5199
5200   if FormatHasAlpha(InternalFormat) then
5201     Header.ImageDes := Header.ImageDes or $08;
5202
5203   Stream.Write(Header, SizeOf(Header));
5204
5205   // convert RGB(A) to BGR(A)
5206   Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
5207   if InternalFormat in [ifRGB8, ifRGBA8] then begin
5208     GetMem(pTemp, Size);
5209   end else
5210     pTemp := Data;
5211
5212   try
5213     // convert data
5214     if InternalFormat in [ifRGB8, ifRGBA8] then begin
5215       Move(Data^, pTemp^, Size);
5216       ConvertData(pTemp);
5217     end;
5218
5219     // write data
5220     Stream.Write(pTemp^, Size);
5221   finally
5222     // free tempdata
5223     if InternalFormat in [ifRGB8, ifRGBA8] then
5224       FreeMem(pTemp);
5225   end;
5226 end;
5227
5228
5229 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5230 procedure TglBitmap.SaveJPEG(Stream: TStream);
5231 {$IFDEF GLB_LIB_JPEG}
5232 var
5233   jpeg: jpeg_compress_struct;
5234   jpeg_err: jpeg_error_mgr;
5235   Row: Integer;
5236   pTemp, pTemp2: pByte;
5237
5238
5239   procedure CopyRow(pDest, pSource: pByte);
5240   var
5241     X: Integer;
5242   begin
5243     for X := 0 to Width - 1 do begin
5244       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5245       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5246       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5247
5248       Inc(pDest, 3);
5249       Inc(pSource, 3);
5250     end;
5251   end;
5252
5253 begin
5254   if not (ftJPEG in FormatGetSupportedFiles(InternalFormat)) then
5255     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5256
5257   if not init_libJPEG then
5258     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5259
5260   try
5261     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
5262     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
5263
5264     // error managment
5265     jpeg.err := jpeg_std_error(@jpeg_err);
5266     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
5267     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5268
5269     // compression struct
5270     jpeg_create_compress(@jpeg);
5271
5272     // allocation space for streaming methods
5273     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5274
5275     // seeting up custom functions
5276     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5277       pub.init_destination    := glBitmap_libJPEG_init_destination;
5278       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5279       pub.term_destination    := glBitmap_libJPEG_term_destination;
5280
5281       pub.next_output_byte  := @DestBuffer[1];
5282       pub.free_in_buffer    := Length(DestBuffer);
5283
5284       DestStream := Stream;
5285     end;
5286
5287     // very important state
5288     jpeg.global_state := CSTATE_START;
5289
5290     jpeg.image_width := Width;
5291     jpeg.image_height := Height;
5292     case InternalFormat of
5293       ifAlpha, ifLuminance, ifDepth8:
5294         begin
5295           jpeg.input_components := 1;
5296           jpeg.in_color_space := JCS_GRAYSCALE;
5297         end;
5298       ifRGB8, ifBGR8:
5299         begin
5300           jpeg.input_components := 3;
5301           jpeg.in_color_space := JCS_RGB;
5302         end;
5303     end;
5304
5305     // setting defaults
5306     jpeg_set_defaults(@jpeg);
5307
5308     // compression quality
5309     jpeg_set_quality(@jpeg, 95, True);
5310
5311     // start compression
5312     jpeg_start_compress(@jpeg, true);
5313
5314     // write rows
5315     pTemp := Data;
5316
5317     // initialing row
5318     if InternalFormat = ifBGR8 then
5319       GetMem(pTemp2, fRowSize)
5320     else
5321       pTemp2 := pTemp;
5322
5323     try
5324       for Row := 0 to jpeg.image_height -1 do begin
5325         // prepare row
5326         if InternalFormat = ifBGR8 then
5327           CopyRow(pTemp2, pTemp)
5328         else
5329           pTemp2 := pTemp;
5330
5331         // write row
5332         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5333         inc(pTemp, fRowSize);
5334       end;
5335     finally
5336       // free memory
5337       if InternalFormat = ifBGR8 then
5338         FreeMem(pTemp2);
5339     end;
5340
5341     // finish compression
5342     jpeg_finish_compress(@jpeg);
5343
5344     // destroy compression
5345     jpeg_destroy_compress(@jpeg);
5346   finally
5347     quit_libJPEG;
5348   end;
5349 end;
5350 {$ENDIF}
5351 {$IFDEF GLB_DELPHI_JPEG}
5352 var
5353   Bmp: TBitmap;
5354   Jpg: TJPEGImage;
5355 begin
5356   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
5357     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
5358
5359   Bmp := TBitmap.Create;
5360   try
5361     Jpg := TJPEGImage.Create;
5362     try
5363       AssignToBitmap(Bmp);
5364
5365       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
5366         Jpg.Grayscale := True;
5367         Jpg.PixelFormat := jf8Bit;
5368       end;
5369
5370       Jpg.Assign(Bmp);
5371
5372       Jpg.SaveToStream(Stream);
5373     finally
5374       FreeAndNil(Jpg);
5375     end;
5376   finally
5377     FreeAndNil(Bmp);
5378   end;
5379 end;
5380 {$ENDIF}
5381 {$ENDIF}
5382
5383
5384 procedure TglBitmap.SaveBMP(Stream: TStream);
5385 var
5386   Header: TBMPHeader;
5387   Info: TBMPInfo;
5388   pData, pTemp: pByte;
5389
5390   PixelFormat: TglBitmapPixelData;
5391   ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
5392   Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5393
5394   PaddingBuff: Cardinal;
5395
5396
5397   function GetLineWidth : Integer;
5398   begin
5399     Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5400   end;
5401
5402
5403 begin
5404   if not (ftBMP in FormatGetSupportedFiles(InternalFormat)) then
5405     raise EglBitmapUnsupportedInternalFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
5406
5407   ImageSize := Trunc(Width * Height * FormatGetSize(InternalFormat));
5408
5409   Header.bfType := BMP_MAGIC;
5410   Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
5411   Header.bfReserved1 := 0;
5412   Header.bfReserved2 := 0;
5413   Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
5414
5415   FillChar(Info, SizeOf(Info), 0);
5416   Info.biSize := SizeOf(Info);
5417   Info.biWidth := Width;
5418   Info.biHeight := Height;
5419   Info.biPlanes := 1;
5420   Info.biCompression := BMP_COMP_RGB;
5421   Info.biSizeImage := ImageSize;
5422   case InternalFormat of
5423     ifAlpha, ifLuminance, ifDepth8:
5424       begin
5425         Info.biBitCount :=  8;
5426
5427         Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
5428         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
5429
5430         Info.biClrUsed := 256;
5431         Info.biClrImportant := 256;
5432       end;
5433     ifLuminanceAlpha, ifRGBA4, ifR5G6B5, ifRGB5A1:
5434       begin
5435         Info.biBitCount := 16;
5436         Info.biCompression := BMP_COMP_BITFIELDS;
5437       end;
5438     ifBGR8, ifRGB8:
5439       Info.biBitCount := 24;
5440     ifBGRA8, ifRGBA8, ifRGB10A2:
5441       begin
5442         Info.biBitCount := 32;
5443         Info.biCompression := BMP_COMP_BITFIELDS;
5444       end;
5445     else
5446       raise EglBitmapUnsupportedInternalFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
5447   end;
5448   Info.biXPelsPerMeter := 2835;
5449   Info.biYPelsPerMeter := 2835;
5450
5451   // prepare bitmasks
5452   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5453     Info.biSize := Info.biSize + 4 * SizeOf(Cardinal);
5454     Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
5455     Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5456
5457     FormatPreparePixel(PixelFormat, InternalFormat);
5458
5459     with PixelFormat.PixelDesc do begin
5460       RedMask   := RedRange   shl RedShift;
5461       GreenMask := GreenRange shl GreenShift;
5462       BlueMask  := BlueRange  shl BlueShift;
5463       AlphaMask := AlphaRange shl AlphaShift;
5464     end;
5465   end;
5466
5467   // headers
5468   Stream.Write(Header, SizeOf(Header));
5469   Stream.Write(Info, SizeOf(Info));
5470
5471   // colortable
5472   if Info.biBitCount = 8 then begin
5473     Temp := 0;
5474     for ColorIdx := Low(Byte) to High(Byte) do begin
5475       Stream.Write(Temp, 4);
5476       Temp := Temp + $00010101;
5477     end;
5478   end;
5479
5480   // bitmasks
5481   if Info.biCompression = BMP_COMP_BITFIELDS then begin
5482     Stream.Write(RedMask, SizeOf(Cardinal));
5483     Stream.Write(GreenMask, SizeOf(Cardinal));
5484     Stream.Write(BlueMask, SizeOf(Cardinal));
5485     Stream.Write(AlphaMask, SizeOf(Cardinal));
5486   end;
5487
5488   // image data
5489   LineSize := Trunc(Width * FormatGetSize(InternalFormat));
5490   Padding := GetLineWidth - LineSize;
5491   PaddingBuff := 0;
5492
5493   pData := Data;
5494   Inc(pData, (Height -1) * LineSize);
5495
5496   // prepare row buffer. But only for RGB because RGBA supports color masks
5497   // so it's possible to change color within the image.
5498   if InternalFormat = ifRGB8 then
5499     GetMem(pTemp, fRowSize)
5500   else
5501     pTemp := nil;
5502
5503   try
5504     // write image data
5505     for LineIdx := 0 to Height - 1 do begin
5506       // preparing row
5507       if InternalFormat = ifRGB8 then begin
5508         Move(pData^, pTemp^, fRowSize);
5509         SwapRGB(pTemp, Width, False);
5510       end else
5511         pTemp := pData;
5512
5513       Stream.Write(pTemp^, LineSize);
5514
5515       Dec(pData, LineSize);
5516
5517       if Padding > 0 then
5518         Stream.Write(PaddingBuff, Padding);
5519     end;
5520   finally
5521     // destroy row buffer
5522     if InternalFormat = ifRGB8 then
5523       FreeMem(pTemp);
5524   end;
5525 end;
5526
5527
5528 procedure TglBitmap.Bind(EnableTextureUnit: Boolean);
5529 begin
5530   if EnableTextureUnit then
5531     glEnable(Target);
5532
5533   if ID > 0 then
5534     glBindTexture(Target, ID);
5535 end;
5536
5537
5538 procedure TglBitmap.Unbind(DisableTextureUnit: Boolean);
5539 begin
5540   if DisableTextureUnit then
5541     glDisable(Target);
5542
5543   glBindTexture(Target, 0);
5544 end;
5545
5546
5547 procedure TglBitmap.GetPixel(const Pos: TglBitmapPixelPosition;
5548   var Pixel: TglBitmapPixelData);
5549 begin
5550   if Assigned (fGetPixelFunc) then
5551     fGetPixelFunc(Pos, Pixel);
5552 end;
5553
5554
5555 procedure TglBitmap.SetPixel (const Pos: TglBitmapPixelPosition;
5556   const Pixel: TglBitmapPixelData);
5557 begin
5558   if Assigned (fSetPixelFunc) then
5559     fSetPixelFunc(Pos, Pixel);
5560 end;
5561
5562
5563 procedure TglBitmap.CreateID;
5564 begin
5565   // Generate Texture
5566   if ID <> 0 then
5567     glDeleteTextures(1, @ID);
5568
5569   glGenTextures(1, @ID);
5570
5571   Bind(False);
5572 end;
5573
5574
5575 procedure TglBitmap.SetupParameters(var BuildWithGlu: Boolean);
5576 begin
5577   // Set up parameters
5578   SetWrap(fWrapS, fWrapT, fWrapR);
5579   SetFilter(fFilterMin, fFilterMag);
5580   SetAnisotropic(fAnisotropic);
5581   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
5582
5583   // Mip Maps generation Mode
5584   BuildWithGlu := False;
5585
5586   if (MipMap = mmMipmap) then begin
5587     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
5588       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
5589     else
5590       BuildWithGlu := True;
5591   end else
5592   if (MipMap = mmMipmapGlu) then
5593     BuildWithGlu := True;
5594 end;
5595
5596
5597 procedure TglBitmap.SelectFormat(DataFormat: TglBitmapInternalFormat; var glFormat, glInternalFormat, glType: Cardinal; CanConvertImage: Boolean = True);
5598
5599   procedure Check12;
5600   begin
5601     if not GL_VERSION_1_2 then
5602       raise EglBitmapUnsupportedInternalFormat.Create('SelectFormat - You need at least OpenGL 1.2 to support these format.');
5603   end;
5604
5605 begin
5606   glType := GL_UNSIGNED_BYTE;
5607
5608   // selecting Format
5609   case DataFormat of
5610     ifAlpha:
5611       glFormat := GL_ALPHA;
5612     ifLuminance:
5613       glFormat := GL_LUMINANCE;
5614     ifDepth8:
5615       glFormat := GL_DEPTH_COMPONENT;
5616     ifLuminanceAlpha:
5617       glFormat := GL_LUMINANCE_ALPHA;
5618     ifBGR8:
5619       begin
5620         if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
5621           glFormat := GL_BGR;
5622         end else begin
5623           if CanConvertImage then
5624             ConvertTo(ifRGB8);
5625           glFormat := GL_RGB;
5626         end;
5627       end;
5628     ifBGRA8:
5629       begin
5630         if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
5631           glFormat := GL_BGRA;
5632         end else begin
5633           if CanConvertImage then
5634             ConvertTo(ifRGBA8);
5635           glFormat := GL_RGBA;
5636         end;
5637       end;
5638     ifRGB8:
5639       glFormat := GL_RGB;
5640     ifRGBA8:
5641       glFormat := GL_RGBA;
5642     ifRGBA4:
5643       begin
5644         Check12;
5645         glFormat := GL_BGRA;
5646         glType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
5647       end;
5648     ifRGB5A1:
5649       begin
5650         Check12;
5651         glFormat := GL_BGRA;
5652         glType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
5653       end;
5654     ifRGB10A2:
5655       begin
5656         Check12;
5657         glFormat := GL_BGRA;
5658         glType := GL_UNSIGNED_INT_2_10_10_10_REV;
5659       end;
5660     ifR5G6B5:
5661       begin
5662         Check12;
5663         glFormat := GL_RGB;
5664         glType := GL_UNSIGNED_SHORT_5_6_5;
5665       end;
5666     else
5667       glFormat := 0;
5668   end;
5669
5670   // Selecting InternalFormat
5671   case DataFormat of
5672     ifDXT1, ifDXT3, ifDXT5:
5673       begin
5674         if GL_EXT_texture_compression_s3tc then begin
5675           case DataFormat of
5676             ifDXT1:
5677               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
5678             ifDXT3:
5679               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
5680             ifDXT5:
5681               glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
5682           end;
5683         end else begin
5684           // Compression isn't supported so convert to RGBA
5685           if CanConvertImage then
5686             ConvertTo(ifRGBA8);
5687           glFormat := GL_RGBA;
5688           glInternalFormat := GL_RGBA8;
5689         end;
5690       end;
5691     ifAlpha:
5692       begin
5693         case Format of
5694           tf4BitsPerChanel:
5695             glInternalFormat := GL_ALPHA4;
5696           tf8BitsPerChanel:
5697             glInternalFormat := GL_ALPHA8;
5698           tfCompressed:
5699             begin
5700               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5701                 glInternalFormat := GL_COMPRESSED_ALPHA
5702               else
5703                 glInternalFormat := GL_ALPHA;
5704             end;
5705           else
5706             glInternalFormat := GL_ALPHA;
5707         end;
5708       end;
5709     ifLuminance:
5710       begin
5711         case Format of
5712           tf4BitsPerChanel:
5713             glInternalFormat := GL_LUMINANCE4;
5714           tf8BitsPerChanel:
5715             glInternalFormat := GL_LUMINANCE8;
5716           tfCompressed:
5717             begin
5718               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5719                 glInternalFormat := GL_COMPRESSED_LUMINANCE
5720               else
5721                 glInternalFormat := GL_LUMINANCE;
5722             end;
5723           else
5724             glInternalFormat := GL_LUMINANCE;
5725         end;
5726       end;
5727     ifDepth8:
5728       begin
5729         glInternalFormat := GL_DEPTH_COMPONENT;
5730       end;
5731     ifLuminanceAlpha:
5732       begin
5733         case Format of
5734           tf4BitsPerChanel:
5735             glInternalFormat := GL_LUMINANCE4_ALPHA4;
5736           tf8BitsPerChanel:
5737             glInternalFormat := GL_LUMINANCE8_ALPHA8;
5738           tfCompressed:
5739             begin
5740               if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5741                 glInternalFormat := GL_COMPRESSED_LUMINANCE_ALPHA
5742               else
5743                 glInternalFormat := GL_LUMINANCE_ALPHA;
5744             end;
5745           else
5746             glInternalFormat := GL_LUMINANCE_ALPHA;
5747         end;
5748       end;
5749     ifBGR8, ifRGB8:
5750       begin
5751         case Format of
5752           tf4BitsPerChanel:
5753             glInternalFormat := GL_RGB4;
5754           tf8BitsPerChanel:
5755             glInternalFormat := GL_RGB8;
5756           tfCompressed:
5757             begin
5758               if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
5759                 glInternalFormat := GL_COMPRESSED_RGB
5760               end else begin
5761                 if (GL_EXT_texture_compression_s3tc) then
5762                   glInternalFormat := GL_COMPRESSED_RGB_S3TC_DXT1_EXT
5763                 else
5764                   glInternalFormat := GL_RGB;
5765               end;
5766             end;
5767           else
5768             glInternalFormat := GL_RGB;
5769         end;
5770       end;
5771     ifBGRA8, ifRGBA8, ifRGBA4, ifRGB5A1, ifRGB10A2, ifR5G6B5:
5772       begin
5773         case Format of
5774           tf4BitsPerChanel:
5775             glInternalFormat := GL_RGBA4;
5776           tf8BitsPerChanel:
5777             glInternalFormat := GL_RGBA8;
5778           tfCompressed:
5779             begin
5780               if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
5781                 glInternalFormat := GL_COMPRESSED_RGBA
5782               end else begin
5783                 if (GL_EXT_texture_compression_s3tc) then
5784                   glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT
5785                 else
5786                   glInternalFormat := GL_RGBA;
5787               end;
5788             end;
5789           else
5790             glInternalFormat := GL_RGBA;
5791         end;
5792       end;
5793   end;
5794 end;
5795
5796
5797 function TglBitmap.FlipHorz: Boolean;
5798 begin
5799   Result := False;
5800 end;
5801
5802
5803 function TglBitmap.FlipVert: Boolean;
5804 begin
5805   Result := False;
5806 end;
5807
5808
5809 procedure TglBitmap.FreeData;
5810 begin
5811   SetDataPointer(nil, ifEmpty);
5812 end;
5813
5814
5815 procedure glBitmapFillWithColorFunc(var FuncRec: TglBitmapFunctionRec);
5816 type
5817   PglBitmapPixelData = ^TglBitmapPixelData;
5818 begin
5819   with FuncRec do begin
5820     Dest.Red   := PglBitmapPixelData(CustomData)^.Red;
5821     Dest.Green := PglBitmapPixelData(CustomData)^.Green;
5822     Dest.Blue  := PglBitmapPixelData(CustomData)^.Blue;
5823     Dest.Alpha := PglBitmapPixelData(CustomData)^.Alpha;
5824   end;
5825 end;
5826
5827
5828 procedure TglBitmap.FillWithColor(Red, Green, Blue: Byte; Alpha: Byte);
5829 begin
5830   FillWithColorFloat(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
5831 end;
5832
5833
5834 procedure TglBitmap.FillWithColorFloat(Red, Green, Blue: Single; Alpha: Single);
5835 var
5836   PixelData: TglBitmapPixelData;
5837 begin
5838   FormatPreparePixel(PixelData, InternalFormat);
5839
5840   PixelData.Red   := Max(0, Min(PixelData.PixelDesc.RedRange,   Trunc(PixelData.PixelDesc.RedRange   * Red)));
5841   PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * Green)));
5842   PixelData.Blue  := Max(0, Min(PixelData.PixelDesc.BlueRange,  Trunc(PixelData.PixelDesc.BlueRange  * Blue)));
5843   PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * Alpha)));
5844
5845   AddFunc(glBitmapFillWithColorFunc, False, @PixelData);
5846 end;
5847
5848
5849 procedure TglBitmap.FillWithColorRange(Red, Green, Blue: Cardinal;
5850   Alpha: Cardinal);
5851 var
5852   PixelData: TglBitmapPixelData;
5853 begin
5854   FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
5855
5856   FillWithColorFloat(
5857     Red   / PixelData.PixelDesc.RedRange,
5858     Green / PixelData.PixelDesc.GreenRange,
5859     Blue  / PixelData.PixelDesc.BlueRange,
5860     Alpha / PixelData.PixelDesc.AlphaRange);
5861 end;
5862
5863
5864 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
5865 var
5866   MaxAniso: Integer;
5867 begin
5868   fAnisotropic := Value;
5869
5870   if (ID > 0) then begin
5871     if GL_EXT_texture_filter_anisotropic then begin
5872       if fAnisotropic > 0 then begin
5873         Bind(False);
5874
5875         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAniso);
5876
5877         if Value > MaxAniso then
5878           fAnisotropic := MaxAniso;
5879
5880         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
5881       end;
5882     end else begin
5883       fAnisotropic := 0;
5884     end;
5885   end;
5886 end;
5887
5888
5889 procedure TglBitmap.SetInternalFormat(const aValue: TglBitmapInternalFormat);
5890 begin
5891   if InternalFormat <> Value then begin
5892     if FormatGetSize(Value) <> FormatGetSize(InternalFormat) then
5893       raise EglBitmapUnsupportedInternalFormat.Create('SetInternalFormat - ' + UNSUPPORTED_INTERNAL_FORMAT);
5894
5895     // Update whatever
5896     SetDataPointer(Data, Value);
5897   end;
5898 end;
5899
5900
5901 function TglBitmap.AddFunc(Func: TglBitmapFunction; CreateTemp: Boolean;
5902   CustomData: Pointer): boolean;
5903 begin
5904   Result := AddFunc(Self, Func, CreateTemp, InternalFormat, CustomData);
5905 end;
5906
5907
5908 function TglBitmap.AddFunc(Source: TglBitmap; Func: TglBitmapFunction;
5909   CreateTemp: Boolean; Format: TglBitmapInternalFormat; CustomData: Pointer): boolean;
5910 var
5911   pDest, NewImage, pSource: pByte;
5912   TempHeight, TempWidth: Integer;
5913   MapFunc: TglBitmapMapFunc;
5914   UnMapFunc: TglBitmapUnMapFunc;
5915
5916   FuncRec: TglBitmapFunctionRec;
5917 begin
5918   Assert(Assigned(Data));
5919   Assert(Assigned(Source));
5920   Assert(Assigned(Source.Data));
5921
5922   Result := False;
5923
5924   if Assigned (Source.Data) and FormatIsUncompressed(Format) and
5925      ((Source.Height > 0) or (Source.Width > 0)) then begin
5926
5927     // inkompatible Formats so CreateTemp
5928     if FormatGetSize(Format) <> FormatGetSize(InternalFormat) then
5929       CreateTemp := True;
5930
5931     // Values
5932     TempHeight := Max(1, Source.Height);
5933     TempWidth := Max(1, Source.Width);
5934
5935     FuncRec.Sender := Self;
5936     FuncRec.CustomData := CustomData;
5937
5938     NewImage := nil;
5939
5940     if CreateTemp then begin
5941       GetMem(NewImage, Trunc(FormatGetSize(Format) * TempHeight * TempWidth));
5942       pDest := NewImage;
5943     end
5944       else pDest := Data;
5945
5946     try
5947       // Mapping
5948       MapFunc := FormatGetMapFunc(Format);
5949       FormatPreparePixel(FuncRec.Dest, Format);
5950       FormatPreparePixel(FuncRec.Source, Source.InternalFormat);
5951
5952       FuncRec.Size := Source.Dimension;
5953       FuncRec.Position.Fields := FuncRec.Size.Fields;
5954
5955       if FormatIsUncompressed(Source.InternalFormat) then begin
5956         // Uncompressed Images
5957         pSource := Source.Data;
5958         UnMapFunc := FormatGetUnMapFunc(Source.InternalFormat);
5959
5960         FuncRec.Position.Y := 0;
5961         while FuncRec.Position.Y < TempHeight do begin
5962           FuncRec.Position.X := 0;
5963           while FuncRec.Position.X < TempWidth do begin
5964             // Get Data
5965             UnMapFunc(pSource, FuncRec.Source);
5966             // Func
5967             Func(FuncRec);
5968             // Set Data
5969             MapFunc(FuncRec.Dest, pDest);
5970             Inc(FuncRec.Position.X);
5971           end;
5972           Inc(FuncRec.Position.Y);
5973         end;
5974       end else begin
5975         // Compressed Images
5976         FuncRec.Position.Y := 0;
5977         while FuncRec.Position.Y < TempHeight do begin
5978           FuncRec.Position.X := 0;
5979           while FuncRec.Position.X < TempWidth do begin
5980             // Get Data
5981             fGetPixelFunc(FuncRec.Position, FuncRec.Source);
5982             // Func
5983             Func(FuncRec);
5984             // Set Data
5985             MapFunc(FuncRec.Dest, pDest);
5986             Inc(FuncRec.Position.X);
5987           end;
5988           Inc(FuncRec.Position.Y);
5989         end;
5990       end;
5991
5992       // Updating Image or InternalFormat
5993       if CreateTemp then
5994         SetDataPointer(NewImage, Format)
5995       else
5996
5997       if Format <> InternalFormat then
5998         SetInternalFormat(Format);
5999
6000       Result := True;
6001     except
6002       if CreateTemp
6003         then FreeMem(NewImage);
6004       raise;
6005     end;
6006   end;
6007 end;
6008
6009
6010 procedure glBitmapConvertCopyFunc(var FuncRec: TglBitmapFunctionRec);
6011 begin
6012   with FuncRec do begin
6013     if Source.PixelDesc.RedRange > 0 then
6014       Dest.Red   := Source.Red;
6015
6016     if Source.PixelDesc.GreenRange > 0 then
6017       Dest.Green := Source.Green;
6018
6019     if Source.PixelDesc.BlueRange > 0 then
6020       Dest.Blue  := Source.Blue;
6021
6022     if Source.PixelDesc.AlphaRange > 0 then
6023       Dest.Alpha := Source.Alpha;
6024   end;
6025 end;
6026
6027
6028 procedure glBitmapConvertCalculateRGBAFunc(var FuncRec: TglBitmapFunctionRec);
6029 begin
6030   with FuncRec do begin
6031     if Source.PixelDesc.RedRange > 0 then
6032       Dest.Red   := Round(Dest.PixelDesc.RedRange   * Source.Red   / Source.PixelDesc.RedRange);
6033
6034     if Source.PixelDesc.GreenRange > 0 then
6035       Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange);
6036
6037     if Source.PixelDesc.BlueRange > 0 then
6038       Dest.Blue  := Round(Dest.PixelDesc.BlueRange  * Source.Blue  / Source.PixelDesc.BlueRange);
6039
6040     if Source.PixelDesc.AlphaRange > 0 then
6041       Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange);
6042   end;
6043 end;
6044
6045
6046 procedure glBitmapConvertShiftRGBAFunc(var FuncRec: TglBitmapFunctionRec);
6047 begin
6048   with FuncRec do
6049     with TglBitmapPixelDesc(CustomData^) do begin
6050       if Source.PixelDesc.RedRange > 0 then
6051         Dest.Red   := Source.Red   shr RedShift;
6052
6053       if Source.PixelDesc.GreenRange > 0 then
6054         Dest.Green := Source.Green shr GreenShift;
6055
6056       if Source.PixelDesc.BlueRange > 0 then
6057         Dest.Blue  := Source.Blue  shr BlueShift;
6058
6059       if Source.PixelDesc.AlphaRange > 0 then
6060         Dest.Alpha := Source.Alpha shr AlphaShift;
6061     end;
6062 end;
6063
6064
6065 function TglBitmap.ConvertTo(NewFormat: TglBitmapInternalFormat): boolean;
6066 var
6067   Source, Dest: TglBitmapPixelData;
6068   PixelDesc: TglBitmapPixelDesc;
6069
6070   function CopyDirect: Boolean;
6071   begin
6072     Result :=
6073       ((Source.PixelDesc.RedRange   = Dest.PixelDesc.RedRange)   or (Source.PixelDesc.RedRange   = 0) or (Dest.PixelDesc.RedRange   = 0)) and
6074       ((Source.PixelDesc.GreenRange = Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
6075       ((Source.PixelDesc.BlueRange  = Dest.PixelDesc.BlueRange)  or (Source.PixelDesc.BlueRange  = 0) or (Dest.PixelDesc.BlueRange  = 0)) and
6076       ((Source.PixelDesc.AlphaRange = Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
6077   end;
6078
6079   function CanShift: Boolean;
6080   begin
6081     Result :=
6082       ((Source.PixelDesc.RedRange   >= Dest.PixelDesc.RedRange  ) or (Source.PixelDesc.RedRange   = 0) or (Dest.PixelDesc.RedRange   = 0)) and
6083       ((Source.PixelDesc.GreenRange >= Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
6084       ((Source.PixelDesc.BlueRange  >= Dest.PixelDesc.BlueRange ) or (Source.PixelDesc.BlueRange  = 0) or (Dest.PixelDesc.BlueRange  = 0)) and
6085       ((Source.PixelDesc.AlphaRange >= Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
6086   end;
6087
6088   function GetShift(Source, Dest: Cardinal) : ShortInt;
6089   begin
6090     Result := 0;
6091
6092     while (Source > Dest) and (Source > 0) do begin
6093       Inc(Result);
6094       Source := Source shr 1;
6095     end;
6096   end;
6097
6098 begin
6099   if NewFormat <> InternalFormat then begin
6100     FormatPreparePixel(Source, InternalFormat);
6101     FormatPreparePixel(Dest, NewFormat);
6102
6103     if CopyDirect then
6104       Result := AddFunc(Self, glBitmapConvertCopyFunc, False, NewFormat)
6105     else
6106     if CanShift then begin
6107       PixelDesc.RedShift   := GetShift(Source.PixelDesc.RedRange,   Dest.PixelDesc.RedRange);
6108       PixelDesc.GreenShift := GetShift(Source.PixelDesc.GreenRange, Dest.PixelDesc.GreenRange);
6109       PixelDesc.BlueShift  := GetShift(Source.PixelDesc.BlueRange,  Dest.PixelDesc.BlueRange);
6110       PixelDesc.AlphaShift := GetShift(Source.PixelDesc.AlphaRange, Dest.PixelDesc.AlphaRange);
6111
6112       Result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, False, NewFormat, @PixelDesc);
6113     end
6114       else Result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, False, NewFormat);
6115   end
6116     else Result := True;
6117 end;
6118
6119
6120 function TglBitmap.RemoveAlpha: Boolean;
6121 begin
6122   Result := False;
6123
6124   if (Assigned(Data)) then begin
6125     if not (FormatIsUncompressed(InternalFormat) or FormatHasAlpha(InternalFormat)) then
6126       raise EglBitmapUnsupportedInternalFormat.Create('RemoveAlpha - ' + UNSUPPORTED_INTERNAL_FORMAT);
6127
6128     Result := ConvertTo(FormatGetWithoutAlpha(InternalFormat));
6129   end;
6130 end;
6131
6132
6133 function TglBitmap.AddAlphaFromFunc(Func: TglBitmapFunction; CustomData: Pointer): boolean;
6134 begin
6135   if not FormatIsUncompressed(InternalFormat) then
6136     raise EglBitmapUnsupportedInternalFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
6137
6138   Result := AddFunc(Self, Func, False, FormatGetWithAlpha(InternalFormat), CustomData);
6139 end;
6140
6141
6142 function TglBitmap.GetHeight: Integer;
6143 begin
6144   if ffY in fDimension.Fields then
6145     Result := fDimension.Y
6146   else
6147     Result := -1;
6148 end;
6149
6150
6151 function TglBitmap.GetWidth: Integer;
6152 begin
6153   if ffX in fDimension.Fields then
6154     Result := fDimension.X
6155   else
6156     Result := -1;
6157 end;
6158
6159
6160 function TglBitmap.GetFileHeight: Integer;
6161 begin
6162   Result := Max(1, Height);
6163 end;
6164
6165
6166 function TglBitmap.GetFileWidth: Integer;
6167 begin
6168   Result := Max(1, Width);
6169 end;
6170
6171
6172 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
6173 var
6174   Temp: Single;
6175 begin
6176   with FuncRec do begin
6177     Temp :=
6178       Source.Red   / Source.PixelDesc.RedRange   * 0.3 +
6179       Source.Green / Source.PixelDesc.GreenRange * 0.59 +
6180       Source.Blue  / Source.PixelDesc.BlueRange  * 0.11;
6181
6182     Dest.Alpha := Round (Dest.PixelDesc.AlphaRange * Temp);
6183   end;
6184 end;
6185
6186
6187 function TglBitmap.AddAlphaFromglBitmap(glBitmap: TglBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
6188 var
6189   pDest, pDest2, pSource: pByte;
6190   TempHeight, TempWidth: Integer;
6191   MapFunc: TglBitmapMapFunc;
6192   DestUnMapFunc, UnMapFunc: TglBitmapUnMapFunc;
6193
6194   FuncRec: TglBitmapFunctionRec;
6195 begin
6196   Result := False;
6197
6198   assert(Assigned(Data));
6199   assert(Assigned(glBitmap));
6200   assert(Assigned(glBitmap.Data));
6201
6202   if ((glBitmap.Width = Width) and (glBitmap.Height = Height)) then begin
6203     // Convert to Data with Alpha
6204     Result := ConvertTo(FormatGetWithAlpha(FormatGetUncompressed(InternalFormat)));
6205
6206     if not Assigned(Func) then
6207       Func := glBitmapAlphaFunc;
6208
6209     // Values
6210     TempHeight := glBitmap.FileHeight;
6211     TempWidth := glBitmap.FileWidth;
6212
6213     FuncRec.Sender := Self;
6214     FuncRec.CustomData := CustomData;
6215
6216     pDest := Data;
6217     pDest2 := Data;
6218     pSource := glBitmap.Data;
6219
6220     // Mapping
6221     FormatPreparePixel(FuncRec.Dest, InternalFormat);
6222     FormatPreparePixel(FuncRec.Source, glBitmap.InternalFormat);
6223     MapFunc := FormatGetMapFunc(InternalFormat);
6224     DestUnMapFunc := FormatGetUnMapFunc(InternalFormat);
6225     UnMapFunc := FormatGetUnMapFunc(glBitmap.InternalFormat);
6226
6227     FuncRec.Size := Dimension;
6228     FuncRec.Position.Fields := FuncRec.Size.Fields;
6229
6230     FuncRec.Position.Y := 0;
6231     while FuncRec.Position.Y < TempHeight do begin
6232       FuncRec.Position.X := 0;
6233       while FuncRec.Position.X < TempWidth do begin
6234         // Get Data
6235         UnMapFunc(pSource, FuncRec.Source);
6236         DestUnMapFunc(pDest2, FuncRec.Dest);
6237         // Func
6238         Func(FuncRec);
6239         // Set Data
6240         MapFunc(FuncRec.Dest, pDest);
6241         Inc(FuncRec.Position.X);
6242       end;
6243       Inc(FuncRec.Position.Y);
6244     end;
6245   end;
6246 end;
6247
6248
6249 procedure TglBitmap.SetBorderColor(Red, Green, Blue, Alpha: Single);
6250 begin
6251   fBorderColor[0] := Red;
6252   fBorderColor[1] := Green;
6253   fBorderColor[2] := Blue;
6254   fBorderColor[3] := Alpha;
6255
6256   if ID > 0 then begin
6257     Bind (False);
6258
6259     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
6260   end;
6261 end;
6262
6263
6264 { TglBitmap2D }
6265
6266 procedure TglBitmap2D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
6267 var
6268   Idx, LineWidth: Integer;
6269 begin
6270   inherited;
6271
6272   // Format
6273   if FormatIsUncompressed(Format) then begin
6274     fUnmapFunc := FormatGetUnMapFunc(Format);
6275     fGetPixelFunc := GetPixel2DUnmap;
6276
6277     fMapFunc := FormatGetMapFunc(Format);
6278     fSetPixelFunc := SetPixel2DUnmap;
6279
6280     // Assigning Data
6281     if Assigned(Data) then begin
6282       SetLength(fLines, GetHeight);
6283
6284       LineWidth := Trunc(GetWidth * FormatGetSize(InternalFormat));
6285
6286       for Idx := 0 to GetHeight -1 do begin
6287         fLines[Idx] := Data;
6288         Inc(fLines[Idx], Idx * LineWidth);
6289       end;
6290     end
6291       else SetLength(fLines, 0);
6292   end else begin
6293     SetLength(fLines, 0);
6294
6295     fSetPixelFunc := nil;
6296
6297     case Format of
6298       ifDXT1:
6299         fGetPixelFunc := GetPixel2DDXT1;
6300       ifDXT3:
6301         fGetPixelFunc := GetPixel2DDXT3;
6302       ifDXT5:
6303         fGetPixelFunc := GetPixel2DDXT5;
6304       else
6305         fGetPixelFunc := nil;
6306     end;
6307   end;
6308 end;
6309
6310
6311 procedure TglBitmap2D.GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
6312 type
6313   PDXT1Chunk = ^TDXT1Chunk;
6314   TDXT1Chunk = packed record
6315     Color1: WORD;
6316     Color2: WORD;
6317     Pixels: array [0..3] of byte;
6318   end;
6319
6320 var
6321   BasePtr: pDXT1Chunk;
6322   PixPos: Integer;
6323   Colors: array [0..3] of TRGBQuad;
6324 begin
6325   BasePtr := pDXT1Chunk(pData);
6326
6327   PixPos := BasePtr^.Pixels[relY] shr (relX * 2) and $3;
6328
6329   if PixPos in [0, 2, 3] then begin
6330     Colors[0].rgbRed      := BasePtr^.Color1 and $F800 shr 8;
6331     Colors[0].rgbGreen    := BasePtr^.Color1 and $07E0 shr 3;
6332     Colors[0].rgbBlue     := BasePtr^.Color1 and $001F shl 3;
6333     Colors[0].rgbReserved := 255;
6334   end;
6335
6336   if PixPos in [1, 2, 3] then begin
6337     Colors[1].rgbRed      := BasePtr^.Color2 and $F800 shr 8;
6338     Colors[1].rgbGreen    := BasePtr^.Color2 and $07E0 shr 3;
6339     Colors[1].rgbBlue     := BasePtr^.Color2 and $001F shl 3;
6340     Colors[1].rgbReserved := 255;
6341   end;
6342
6343   if PixPos = 2 then begin
6344     Colors[2].rgbRed      := (Colors[0].rgbRed   * 67 + Colors[1].rgbRed   * 33) div 100;
6345     Colors[2].rgbGreen    := (Colors[0].rgbGreen * 67 + Colors[1].rgbGreen * 33) div 100;
6346     Colors[2].rgbBlue     := (Colors[0].rgbBlue  * 67 + Colors[1].rgbBlue  * 33) div 100;
6347     Colors[2].rgbReserved := 255;
6348   end;
6349
6350   if PixPos = 3 then begin
6351     Colors[3].rgbRed      := (Colors[0].rgbRed   * 33 + Colors[1].rgbRed   * 67) div 100;
6352     Colors[3].rgbGreen    := (Colors[0].rgbGreen * 33 + Colors[1].rgbGreen * 67) div 100;
6353     Colors[3].rgbBlue     := (Colors[0].rgbBlue  * 33 + Colors[1].rgbBlue  * 67) div 100;
6354     if BasePtr^.Color1 > BasePtr^.Color2 then
6355       Colors[3].rgbReserved := 255
6356     else
6357       Colors[3].rgbReserved := 0;
6358   end;
6359
6360   Pixel.Red   := Colors[PixPos].rgbRed;
6361   Pixel.Green := Colors[PixPos].rgbGreen;
6362   Pixel.Blue  := Colors[PixPos].rgbBlue;
6363   Pixel.Alpha := Colors[PixPos].rgbReserved;
6364 end;
6365
6366
6367 procedure TglBitmap2D.GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6368 var
6369   BasePtr: pByte;
6370   PosX, PosY: Integer;
6371 begin
6372   inherited;
6373
6374   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
6375     PosX := Pos.X div 4;
6376     PosY := Pos.Y div 4;
6377
6378     BasePtr := Data;
6379     Inc(BasePtr, (PosY * Width div 4 + PosX) * 8);
6380
6381     GetDXTColorBlock(BasePtr, Pos.X - PosX * 4, Pos.Y - PosY * 4, Pixel);
6382   end;
6383 end;
6384
6385
6386 procedure TglBitmap2D.GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6387 type
6388   PDXT3AlphaChunk = ^TDXT3AlphaChunk;
6389   TDXT3AlphaChunk = array [0..3] of WORD;
6390
6391 var
6392   ColorPtr: pByte;
6393   AlphaPtr: PDXT3AlphaChunk;
6394   PosX, PosY, relX, relY: Integer;
6395 begin
6396   inherited;
6397
6398   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
6399     PosX := Pos.X div 4;
6400     PosY := Pos.Y div 4;
6401     relX := Pos.X - PosX * 4;
6402     relY := Pos.Y - PosY * 4;
6403
6404     // get color value
6405     AlphaPtr := PDXT3AlphaChunk(Data);
6406     Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
6407
6408     ColorPtr := pByte(AlphaPtr);
6409     Inc(ColorPtr, 8);
6410
6411     GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
6412
6413     // extracting alpha
6414     Pixel.Alpha := AlphaPtr^[relY] shr (4 * relX) and $0F shl 4;
6415   end;
6416 end;
6417
6418
6419 procedure TglBitmap2D.GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6420 var
6421   ColorPtr: pByte;
6422   AlphaPtr: PInt64;
6423   PixPos, PosX, PosY, relX, relY: Integer;
6424   Alpha0, Alpha1: Byte;
6425 begin
6426   inherited;
6427
6428   if (Pos.Y <= Height) and (Pos.X <= Width) then begin
6429     PosX := Pos.X div 4;
6430     PosY := Pos.Y div 4;
6431     relX := Pos.X - PosX * 4;
6432     relY := Pos.Y - PosY * 4;
6433
6434     // get color value
6435     AlphaPtr := PInt64(Data);
6436     Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
6437
6438     ColorPtr := pByte(AlphaPtr);
6439     Inc(ColorPtr, 8);
6440
6441     GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
6442
6443     // extracting alpha
6444     Alpha0 := AlphaPtr^ and $FF;
6445     Alpha1 := AlphaPtr^ shr 8 and $FF;
6446
6447     PixPos := AlphaPtr^ shr (16 + (relY * 4 + relX) * 3) and $07;
6448
6449     // use alpha 0
6450     if PixPos = 0 then begin
6451       Pixel.Alpha := Alpha0;
6452     end else
6453
6454     // use alpha 1
6455     if PixPos = 1 then begin
6456       Pixel.Alpha := Alpha1;
6457     end else
6458
6459     // alpha interpolate 7 Steps
6460     if Alpha0 > Alpha1 then begin
6461       Pixel.Alpha := ((8 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 7;
6462     end else
6463
6464     // alpha is 100% transparent or not transparent
6465     if PixPos >= 6 then begin
6466       if PixPos = 6 then
6467         Pixel.Alpha := 0
6468       else
6469         Pixel.Alpha := 255;
6470     end else
6471
6472     // alpha interpolate 5 Steps
6473     begin
6474       Pixel.Alpha := ((6 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 5;
6475     end;
6476   end;
6477 end;
6478
6479
6480 procedure TglBitmap2D.GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6481 var
6482   pTemp: pByte;
6483 begin
6484   pTemp := fLines[Pos.Y];
6485   Inc(pTemp, Pos.X * fPixelSize);
6486
6487   fUnmapFunc(pTemp, Pixel);
6488 end;
6489
6490
6491 procedure TglBitmap2D.SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
6492 var
6493   pTemp: pByte;
6494 begin
6495   pTemp := fLines[Pos.Y];
6496   Inc(pTemp, Pos.X * fPixelSize);
6497
6498   fMapFunc(Pixel, pTemp);
6499 end;
6500
6501
6502 function TglBitmap2D.FlipHorz: Boolean;
6503 var
6504   Col, Row: Integer;
6505   pTempDest, pDest, pSource: pByte;
6506   ImgSize: Integer;
6507 begin
6508   Result := Inherited FlipHorz;
6509
6510   if Assigned(Data) then begin
6511     pSource := Data;
6512     ImgSize := Height * fRowSize;
6513
6514     GetMem(pDest, ImgSize);
6515     try
6516       pTempDest := pDest;
6517
6518       Dec(pTempDest, fRowSize + fPixelSize);
6519       for Row := 0 to Height -1 do begin
6520         Inc(pTempDest, fRowSize * 2);
6521         for Col := 0 to Width -1 do begin
6522           Move(pSource^, pTempDest^, fPixelSize);
6523
6524           Inc(pSource, fPixelSize);
6525           Dec(pTempDest, fPixelSize);
6526         end;
6527       end;
6528
6529       SetDataPointer(pDest, InternalFormat);
6530
6531       Result := True;
6532     except
6533       FreeMem(pDest);
6534       raise;
6535     end;
6536   end;
6537 end;
6538
6539
6540 function TglBitmap2D.FlipVert: Boolean;
6541 var
6542   Row: Integer;
6543   pTempDest, pDest, pSource: pByte;
6544 begin
6545   Result := Inherited FlipVert;
6546
6547   if Assigned(Data) then begin
6548     pSource := Data;
6549     GetMem(pDest, Height * fRowSize);
6550     try
6551       pTempDest := pDest;
6552
6553       Inc(pTempDest, Width * (Height -1) * fPixelSize);
6554
6555       for Row := 0 to Height -1 do begin
6556         Move(pSource^, pTempDest^, fRowSize);
6557
6558         Dec(pTempDest, fRowSize);
6559         Inc(pSource, fRowSize);
6560       end;
6561
6562       SetDataPointer(pDest, InternalFormat);
6563
6564       Result := True;
6565     except
6566       FreeMem(pDest);
6567       raise;
6568     end;
6569   end;
6570 end;
6571
6572
6573 procedure TglBitmap2D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6574 begin
6575   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
6576
6577   // Upload data
6578   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6579     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
6580   else
6581
6582   if BuildWithGlu then
6583     gluBuild2DMipmaps(Target, InternalFormat, Width, Height, Format, Typ, Data)
6584   else
6585     glTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Format, Typ, Data);
6586
6587   // Freigeben
6588   if (FreeDataAfterGenTexture) then
6589     FreeData;
6590 end;
6591
6592
6593 procedure TglBitmap2D.GenTexture(TestTextureSize: Boolean);
6594 var
6595   BuildWithGlu, PotTex, TexRec: Boolean;
6596   glFormat, glInternalFormat, glType: Cardinal;
6597   TexSize: Integer;
6598 begin
6599   if Assigned(Data) then begin
6600     // Check Texture Size
6601     if (TestTextureSize) then begin
6602       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6603
6604       if ((Height > TexSize) or (Width > TexSize)) then
6605         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6606
6607       PotTex := IsPowerOfTwo (Height) and IsPowerOfTwo (Width);
6608       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6609                 (Target = GL_TEXTURE_RECTANGLE_ARB);
6610
6611       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6612         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6613     end;
6614
6615     CreateId;
6616
6617     SetupParameters(BuildWithGlu);
6618     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6619
6620     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6621
6622     // Infos sammeln
6623     glAreTexturesResident(1, @ID, @fIsResident);
6624   end;
6625 end;
6626
6627
6628 procedure TglBitmap2D.AfterConstruction;
6629 begin
6630   inherited;
6631
6632   Target := GL_TEXTURE_2D;
6633 end;
6634
6635
6636 type
6637   TMatrixItem = record
6638     X, Y: Integer;
6639     W: Single;
6640   end;
6641
6642   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
6643   TglBitmapToNormalMapRec = Record
6644     Scale: Single;
6645     Heights: array of Single;
6646     MatrixU : array of TMatrixItem;
6647     MatrixV : array of TMatrixItem;
6648   end;
6649
6650 const
6651   oneover255 = 1 / 255;
6652
6653 procedure glBitmapToNormalMapPrepareFunc (var FuncRec: TglBitmapFunctionRec);
6654 var
6655   Val: Single;
6656 begin
6657   with FuncRec do begin
6658     Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue *  0.11;
6659     PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255;
6660   end;
6661 end;
6662
6663
6664 procedure glBitmapToNormalMapPrepareAlphaFunc (var FuncRec: TglBitmapFunctionRec);
6665 begin
6666   with FuncRec do
6667     PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255;
6668 end;
6669
6670
6671 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
6672 type
6673   TVec = Array[0..2] of Single;
6674 var
6675   Idx: Integer;
6676   du, dv: Double;
6677   Len: Single;
6678   Vec: TVec;
6679
6680   function GetHeight(X, Y: Integer): Single;
6681   begin
6682     with FuncRec do begin
6683       X := Max(0, Min(Size.X -1, X));
6684       Y := Max(0, Min(Size.Y -1, Y));
6685
6686       Result := PglBitmapToNormalMapRec (CustomData)^.Heights[Y * Size.X + X];
6687     end;
6688   end;
6689
6690 begin
6691   with FuncRec do begin
6692     with PglBitmapToNormalMapRec (CustomData)^ do begin
6693       du := 0;
6694       for Idx := Low(MatrixU) to High(MatrixU) do
6695         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
6696
6697       dv := 0;
6698       for Idx := Low(MatrixU) to High(MatrixU) do
6699         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
6700
6701       Vec[0] := -du * Scale;
6702       Vec[1] := -dv * Scale;
6703       Vec[2] := 1;
6704     end;
6705
6706     // Normalize
6707     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6708     if Len <> 0 then begin
6709       Vec[0] := Vec[0] * Len;
6710       Vec[1] := Vec[1] * Len;
6711       Vec[2] := Vec[2] * Len;
6712     end;
6713
6714     // Farbe zuweisem
6715     Dest.Red   := Trunc((Vec[0] + 1) * 127.5);
6716     Dest.Green := Trunc((Vec[1] + 1) * 127.5);
6717     Dest.Blue  := Trunc((Vec[2] + 1) * 127.5);
6718   end;
6719 end;
6720
6721
6722 procedure TglBitmap2D.ToNormalMap(Func: TglBitmapNormalMapFunc; Scale: Single; UseAlpha: Boolean);
6723 var
6724   Rec: TglBitmapToNormalMapRec;
6725
6726   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
6727   begin
6728     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
6729       Matrix[Index].X := X;
6730       Matrix[Index].Y := Y;
6731       Matrix[Index].W := W;
6732     end;
6733   end;
6734
6735 begin
6736   if not FormatIsUncompressed(InternalFormat) then
6737     raise EglBitmapUnsupportedInternalFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_INTERNAL_FORMAT);
6738
6739   if Scale > 100 then
6740     Rec.Scale := 100
6741   else
6742   if Scale < -100 then
6743     Rec.Scale := -100
6744   else
6745     Rec.Scale := Scale;
6746
6747   SetLength(Rec.Heights, Width * Height);
6748   try
6749     case Func of
6750       nm4Samples:
6751         begin
6752           SetLength(Rec.MatrixU, 2);
6753           SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
6754           SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
6755
6756           SetLength(Rec.MatrixV, 2);
6757           SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
6758           SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
6759         end;
6760       nmSobel:
6761         begin
6762           SetLength(Rec.MatrixU, 6);
6763           SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
6764           SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
6765           SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
6766           SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
6767           SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
6768           SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
6769
6770           SetLength(Rec.MatrixV, 6);
6771           SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
6772           SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
6773           SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
6774           SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
6775           SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
6776           SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
6777         end;
6778       nm3x3:
6779         begin
6780           SetLength(Rec.MatrixU, 6);
6781           SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
6782           SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
6783           SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
6784           SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
6785           SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
6786           SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
6787
6788           SetLength(Rec.MatrixV, 6);
6789           SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
6790           SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
6791           SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
6792           SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
6793           SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
6794           SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
6795         end;
6796       nm5x5:
6797         begin
6798           SetLength(Rec.MatrixU, 20);
6799           SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
6800           SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
6801           SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
6802           SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
6803           SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
6804           SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
6805           SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
6806           SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
6807           SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
6808           SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
6809           SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
6810           SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
6811           SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
6812           SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
6813           SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
6814           SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
6815           SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
6816           SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
6817           SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
6818           SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
6819
6820           SetLength(Rec.MatrixV, 20);
6821           SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
6822           SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
6823           SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
6824           SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
6825           SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
6826           SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
6827           SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
6828           SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
6829           SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
6830           SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
6831           SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
6832           SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
6833           SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
6834           SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
6835           SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
6836           SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
6837           SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
6838           SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
6839           SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
6840           SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
6841         end;
6842     end;
6843
6844     // Daten Sammeln
6845     if UseAlpha and FormatHasAlpha(InternalFormat) then
6846       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, False, @Rec)
6847     else
6848       AddFunc(glBitmapToNormalMapPrepareFunc, False, @Rec);
6849
6850     // Neues Bild berechnen
6851     AddFunc(glBitmapToNormalMapFunc, False, @Rec);
6852   finally
6853     SetLength(Rec.Heights, 0);
6854   end;
6855 end;
6856
6857
6858 procedure TglBitmap2D.GrabScreen(Top, Left, Right, Bottom: Integer; Format: TglBitmapInternalFormat);
6859 var
6860   Temp: pByte;
6861   Size: Integer;
6862   glFormat, glInternalFormat, glType: Cardinal;
6863 begin
6864   if not FormatIsUncompressed(Format) then
6865     raise EglBitmapUnsupportedInternalFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_INTERNAL_FORMAT);
6866
6867   // Only to select Formats
6868   SelectFormat(Format, glFormat, glInternalFormat, glType, False);
6869
6870   Size := FormatGetImageSize(glBitmapPosition(Right - Left, Bottom - Top), Format);
6871   GetMem(Temp, Size);
6872   try
6873     glPixelStorei(GL_PACK_ALIGNMENT, 1);
6874     glReadPixels(Left, Top, Right - Left, Bottom - Top, glFormat, glType, Temp);
6875
6876     // Set Data
6877     SetDataPointer(Temp, Format, Right - Left, Bottom - Top);
6878
6879     // Flip
6880     FlipVert;
6881   except
6882     FreeMem(Temp);
6883     raise;
6884   end;
6885 end;
6886
6887
6888 procedure TglBitmap2D.GetDataFromTexture;
6889 var
6890   Temp: pByte;
6891   TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer;
6892   TempType, TempIntFormat: Cardinal;
6893   IntFormat: TglBitmapInternalFormat;
6894 begin
6895   Bind;
6896
6897   // Request Data
6898   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
6899   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
6900   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
6901
6902   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE, @RedSize);
6903   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE, @GreenSize);
6904   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE, @BlueSize);
6905   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE, @AlphaSize);
6906   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize);
6907
6908   // Get glBitmapInternalFormat from TempIntFormat
6909   TempType := GL_UNSIGNED_BYTE;
6910   case TempIntFormat of
6911     GL_ALPHA:
6912       IntFormat := ifAlpha;
6913     GL_LUMINANCE:
6914       IntFormat := ifLuminance;
6915     GL_LUMINANCE_ALPHA:
6916       IntFormat := ifLuminanceAlpha;
6917     GL_RGB4:
6918       begin
6919         IntFormat := ifR5G6B5;
6920         TempIntFormat := GL_RGB;
6921         TempType := GL_UNSIGNED_SHORT_5_6_5;
6922       end;
6923     GL_RGB, GL_RGB8:
6924       IntFormat := ifRGB8;
6925     GL_RGBA, GL_RGBA4, GL_RGBA8:
6926       begin
6927         if (RedSize = 4) and (BlueSize = 4) and (GreenSize = 4) and (AlphaSize = 4) then begin
6928           IntFormat := ifRGBA4;
6929           TempIntFormat := GL_BGRA;
6930           TempType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
6931         end else
6932         if (RedSize = 5) and (BlueSize = 5) and (GreenSize = 5) and (AlphaSize = 1) then begin
6933           IntFormat := ifRGB5A1;
6934           TempIntFormat := GL_BGRA;
6935           TempType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
6936         end else begin
6937           IntFormat := ifRGBA8;
6938         end;
6939       end;
6940     GL_BGR:
6941       IntFormat := ifBGR8;
6942     GL_BGRA:
6943       IntFormat := ifBGRA8;
6944     GL_COMPRESSED_RGB_S3TC_DXT1_EXT:
6945       IntFormat := ifDXT1;
6946     GL_COMPRESSED_RGBA_S3TC_DXT1_EXT:
6947       IntFormat := ifDXT1;
6948     GL_COMPRESSED_RGBA_S3TC_DXT3_EXT:
6949       IntFormat := ifDXT3;
6950     GL_COMPRESSED_RGBA_S3TC_DXT5_EXT:
6951       IntFormat := ifDXT5;
6952     else
6953       IntFormat := ifEmpty;
6954   end;
6955
6956   // Getting data from OpenGL
6957   GetMem(Temp, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6958   try
6959     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
6960       glGetCompressedTexImage(Target, 0, Temp)
6961     else
6962       glGetTexImage(Target, 0, TempIntFormat, TempType, Temp);
6963
6964     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
6965   except
6966     FreeMem(Temp);
6967     raise;
6968   end;
6969 end;
6970
6971
6972 function TglBitmap2D.GetScanline(Index: Integer): Pointer;
6973 begin
6974   if (Index >= Low(fLines)) and (Index <= High(fLines)) then
6975     Result := fLines[Index]
6976   else
6977     Result := nil;
6978 end;
6979
6980
6981 { TglBitmap1D }
6982
6983 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
6984 var
6985   pTemp: pByte;
6986   Size: Integer;
6987 begin
6988   if Height > 1 then begin
6989     // extract first line of the data
6990     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
6991     GetMem(pTemp, Size);
6992
6993     Move(Data^, pTemp^, Size);
6994
6995     FreeMem(Data);
6996   end else
6997     pTemp := Data;
6998
6999   // set data pointer
7000   inherited SetDataPointer(pTemp, Format, Width);
7001
7002   if FormatIsUncompressed(Format) then begin
7003     fUnmapFunc := FormatGetUnMapFunc(Format);
7004     fGetPixelFunc := GetPixel1DUnmap;
7005   end;
7006 end;
7007
7008
7009 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7010 var
7011   pTemp: pByte;
7012 begin
7013   pTemp := Data;
7014   Inc(pTemp, Pos.X * fPixelSize);
7015
7016   fUnmapFunc(pTemp, Pixel);
7017 end;
7018
7019
7020 function TglBitmap1D.FlipHorz: Boolean;
7021 var
7022   Col: Integer;
7023   pTempDest, pDest, pSource: pByte;
7024 begin
7025   Result := Inherited FlipHorz;
7026
7027   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7028     pSource := Data;
7029
7030     GetMem(pDest, fRowSize);
7031     try
7032       pTempDest := pDest;
7033
7034       Inc(pTempDest, fRowSize);
7035       for Col := 0 to Width -1 do begin
7036         Move(pSource^, pTempDest^, fPixelSize);
7037
7038         Inc(pSource, fPixelSize);
7039         Dec(pTempDest, fPixelSize);
7040       end;
7041
7042       SetDataPointer(pDest, InternalFormat);
7043
7044       Result := True;
7045     finally
7046       FreeMem(pDest);
7047     end;
7048   end;
7049 end;
7050
7051
7052 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7053 begin
7054   // Upload data
7055   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7056     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7057   else
7058
7059   // Upload data
7060   if BuildWithGlu then
7061     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7062   else
7063     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7064
7065   // Freigeben
7066   if (FreeDataAfterGenTexture) then
7067     FreeData;
7068 end;
7069
7070
7071 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7072 var
7073   BuildWithGlu, TexRec: Boolean;
7074   glFormat, glInternalFormat, glType: Cardinal;
7075   TexSize: Integer;
7076 begin
7077   if Assigned(Data) then begin
7078     // Check Texture Size
7079     if (TestTextureSize) then begin
7080       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7081
7082       if (Width > TexSize) then
7083         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7084
7085       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7086                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7087
7088       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7089         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7090     end;
7091
7092     CreateId;
7093
7094     SetupParameters(BuildWithGlu);
7095     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7096
7097     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7098
7099     // Infos sammeln
7100     glAreTexturesResident(1, @ID, @fIsResident);
7101   end;
7102 end;
7103
7104
7105 procedure TglBitmap1D.AfterConstruction;
7106 begin
7107   inherited;
7108
7109   Target := GL_TEXTURE_1D;
7110 end;
7111
7112
7113 { TglBitmapCubeMap }
7114
7115 procedure TglBitmapCubeMap.AfterConstruction;
7116 begin
7117   inherited;
7118
7119   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7120     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7121
7122   SetWrap; // set all to GL_CLAMP_TO_EDGE
7123   Target := GL_TEXTURE_CUBE_MAP;
7124   fGenMode := GL_REFLECTION_MAP;
7125 end;
7126
7127
7128 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
7129 begin
7130   inherited Bind (EnableTextureUnit);
7131
7132   if EnableTexCoordsGen then begin
7133     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
7134     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
7135     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
7136     glEnable(GL_TEXTURE_GEN_S);
7137     glEnable(GL_TEXTURE_GEN_T);
7138     glEnable(GL_TEXTURE_GEN_R);
7139   end;
7140 end;
7141
7142
7143 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
7144 var
7145   glFormat, glInternalFormat, glType: Cardinal;
7146   BuildWithGlu: Boolean;
7147   TexSize: Integer;
7148 begin
7149   // Check Texture Size
7150   if (TestTextureSize) then begin
7151     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
7152
7153     if ((Height > TexSize) or (Width > TexSize)) then
7154       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
7155
7156     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
7157       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
7158   end;
7159
7160   // create Texture
7161   if ID = 0 then begin
7162     CreateID;
7163     SetupParameters(BuildWithGlu);
7164   end;
7165
7166   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7167
7168   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
7169 end;
7170
7171
7172 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
7173 begin
7174   Assert(False, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
7175 end;
7176
7177
7178 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
7179   DisableTextureUnit: Boolean);
7180 begin
7181   inherited Unbind (DisableTextureUnit);
7182
7183   if DisableTexCoordsGen then begin
7184     glDisable(GL_TEXTURE_GEN_S);
7185     glDisable(GL_TEXTURE_GEN_T);
7186     glDisable(GL_TEXTURE_GEN_R);
7187   end;
7188 end;
7189
7190
7191 { TglBitmapNormalMap }
7192
7193 type
7194   TVec = Array[0..2] of Single;
7195   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7196
7197   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
7198   TglBitmapNormalMapRec = record
7199     HalfSize : Integer;
7200     Func: TglBitmapNormalMapGetVectorFunc;
7201   end;
7202
7203
7204 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7205 begin
7206   Vec[0] := HalfSize;
7207   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7208   Vec[2] := - (Position.X + 0.5 - HalfSize);
7209 end;
7210
7211
7212 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7213 begin
7214   Vec[0] := - HalfSize;
7215   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7216   Vec[2] := Position.X + 0.5 - HalfSize;
7217 end;
7218
7219
7220 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7221 begin
7222   Vec[0] := Position.X + 0.5 - HalfSize;
7223   Vec[1] := HalfSize;
7224   Vec[2] := Position.Y + 0.5 - HalfSize;
7225 end;
7226
7227
7228 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7229 begin
7230   Vec[0] := Position.X + 0.5 - HalfSize;
7231   Vec[1] := - HalfSize;
7232   Vec[2] := - (Position.Y + 0.5 - HalfSize);
7233 end;
7234
7235
7236 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7237 begin
7238   Vec[0] := Position.X + 0.5 - HalfSize;
7239   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7240   Vec[2] := HalfSize;
7241 end;
7242
7243
7244 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
7245 begin
7246   Vec[0] := - (Position.X + 0.5 - HalfSize);
7247   Vec[1] := - (Position.Y + 0.5 - HalfSize);
7248   Vec[2] := - HalfSize;
7249 end;
7250
7251
7252 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
7253 var
7254   Vec : TVec;
7255   Len: Single;
7256 begin
7257   with FuncRec do begin
7258     with PglBitmapNormalMapRec (CustomData)^ do begin
7259       Func(Vec, Position, HalfSize);
7260
7261       // Normalize
7262       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7263       if Len <> 0 then begin
7264         Vec[0] := Vec[0] * Len;
7265         Vec[1] := Vec[1] * Len;
7266         Vec[2] := Vec[2] * Len;
7267       end;
7268
7269       // Scale Vector and AddVectro
7270       Vec[0] := Vec[0] * 0.5 + 0.5;
7271       Vec[1] := Vec[1] * 0.5 + 0.5;
7272       Vec[2] := Vec[2] * 0.5 + 0.5;
7273     end;
7274
7275     // Set Color
7276     Dest.Red   := Round(Vec[0] * 255);
7277     Dest.Green := Round(Vec[1] * 255);
7278     Dest.Blue  := Round(Vec[2] * 255);
7279   end;
7280 end;
7281
7282
7283 procedure TglBitmapNormalMap.AfterConstruction;
7284 begin
7285   inherited;
7286
7287   fGenMode := GL_NORMAL_MAP;
7288 end;
7289
7290
7291 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
7292   TestTextureSize: Boolean);
7293 var
7294   Rec: TglBitmapNormalMapRec;
7295   SizeRec: TglBitmapPixelPosition;
7296 begin
7297   Rec.HalfSize := Size div 2;
7298
7299   FreeDataAfterGenTexture := False;
7300
7301   SizeRec.Fields := [ffX, ffY];
7302   SizeRec.X := Size;
7303   SizeRec.Y := Size;
7304
7305   // Positive X
7306   Rec.Func := glBitmapNormalMapPosX;
7307   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7308   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
7309
7310   // Negative X
7311   Rec.Func := glBitmapNormalMapNegX;
7312   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7313   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
7314
7315   // Positive Y
7316   Rec.Func := glBitmapNormalMapPosY;
7317   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7318   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
7319
7320   // Negative Y
7321   Rec.Func := glBitmapNormalMapNegY;
7322   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7323   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
7324
7325   // Positive Z
7326   Rec.Func := glBitmapNormalMapPosZ;
7327   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7328   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
7329
7330   // Negative Z
7331   Rec.Func := glBitmapNormalMapNegZ;
7332   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
7333   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
7334 end;
7335
7336
7337
7338 initialization
7339   glBitmapSetDefaultFormat(tfDefault);
7340   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
7341   glBitmapSetDefaultWrap(GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
7342
7343   glBitmapSetDefaultFreeDataAfterGenTexture(True);
7344   glBitmapSetDefaultDeleteTextureOnFree(True);
7345
7346 finalization
7347
7348 end.