glBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 // Please uncomment the defines below to configure the glBitmap to your preferences.
  28 // If you have configured the unit you can uncomment the warning above.
  29 {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  30
  31 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  32 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  33 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  34 // enable support for OpenGL ES 1.1
  35 {.$DEFINE OPENGL_ES_1_1}
  36
  37 // enable support for OpenGL ES 2.0
  38 {.$DEFINE OPENGL_ES_2_0}
  39
  40 // enable support for OpenGL ES 3.0
  41 {.$DEFINE OPENGL_ES_3_0}
  42
  43 // enable support for all OpenGL ES extensions
  44 {.$DEFINE OPENGL_ES_EXT}
  45
  46
  47
  48 // activate to enable the support for SDL_surfaces
  49 {.$DEFINE GLB_SDL}
  50
  51 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  52 {.$DEFINE GLB_DELPHI}
  53
  54 // activate to enable the support for TLazIntfImage from Lazarus
  55 {.$DEFINE GLB_LAZARUS}
  56
  57
  58
  59 // activate to enable the support of SDL_image to load files. (READ ONLY)
  60 // If you enable SDL_image all other libraries will be ignored!
  61 {.$DEFINE GLB_SDL_IMAGE}
  62
  63
  64
  65 // activate to enable Lazarus TPortableNetworkGraphic support
  66 // if you enable this pngImage and libPNG will be ignored
  67 {.$DEFINE GLB_LAZ_PNG}
  68
  69 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  70 // if you enable pngimage the libPNG will be ignored
  71 {.$DEFINE GLB_PNGIMAGE}
  72
  73 // activate to use the libPNG -> http://www.libpng.org/
  74 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  75 {.$DEFINE GLB_LIB_PNG}
  76
  77
  78
  79 // activate to enable Lazarus TJPEGImage support
  80 // if you enable this delphi jpegs and libJPEG will be ignored
  81 {.$DEFINE GLB_LAZ_JPEG}
  82
  83 // if you enable delphi jpegs the libJPEG will be ignored
  84 {.$DEFINE GLB_DELPHI_JPEG}
  85
  86 // activate to use the libJPEG -> http://www.ijg.org/
  87 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  88 {.$DEFINE GLB_LIB_JPEG}
  89
  90
  91 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  92 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  93 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  94 // Delphi Versions
  95 {$IFDEF fpc}
  96   {$MODE Delphi}
  97
  98   {$IFDEF CPUI386}
  99     {$DEFINE CPU386}
 100     {$ASMMODE INTEL}
 101   {$ENDIF}
 102
 103   {$IFNDEF WINDOWS}
 104     {$linklib c}
 105   {$ENDIF}
 106 {$ENDIF}
 107
 108 // Operation System
 109 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
 110   {$DEFINE GLB_WIN}
 111 {$ELSEIF DEFINED(LINUX)}
 112   {$DEFINE GLB_LINUX}
 113 {$IFEND}
 114
 115 // OpenGL ES
 116 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 117 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
 118 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
 119 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
 120
 121 // checking define combinations
 122 //SDL Image
 123 {$IFDEF GLB_SDL_IMAGE}
 124   {$IFNDEF GLB_SDL}
 125     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
 126     {$DEFINE GLB_SDL}
 127   {$ENDIF}
 128
 129   {$IFDEF GLB_LAZ_PNG}
 130     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
 131     {$undef GLB_LAZ_PNG}
 132   {$ENDIF}
 133
 134   {$IFDEF GLB_PNGIMAGE}
 135     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
 136     {$undef GLB_PNGIMAGE}
 137   {$ENDIF}
 138
 139   {$IFDEF GLB_LAZ_JPEG}
 140     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
 141     {$undef GLB_LAZ_JPEG}
 142   {$ENDIF}
 143
 144   {$IFDEF GLB_DELPHI_JPEG}
 145     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
 146     {$undef GLB_DELPHI_JPEG}
 147   {$ENDIF}
 148
 149   {$IFDEF GLB_LIB_PNG}
 150     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
 151     {$undef GLB_LIB_PNG}
 152   {$ENDIF}
 153
 154   {$IFDEF GLB_LIB_JPEG}
 155     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
 156     {$undef GLB_LIB_JPEG}
 157   {$ENDIF}
 158
 159   {$DEFINE GLB_SUPPORT_PNG_READ}
 160   {$DEFINE GLB_SUPPORT_JPEG_READ}
 161 {$ENDIF}
 162
 163 // Lazarus TPortableNetworkGraphic
 164 {$IFDEF GLB_LAZ_PNG}
 165   {$IFNDEF GLB_LAZARUS}
 166     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 167     {$DEFINE GLB_LAZARUS}
 168   {$ENDIF}
 169
 170   {$IFDEF GLB_PNGIMAGE}
 171     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 172     {$undef GLB_PNGIMAGE}
 173   {$ENDIF}
 174
 175   {$IFDEF GLB_LIB_PNG}
 176     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 177     {$undef GLB_LIB_PNG}
 178   {$ENDIF}
 179
 180   {$DEFINE GLB_SUPPORT_PNG_READ}
 181   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 182 {$ENDIF}
 183
 184 // PNG Image
 185 {$IFDEF GLB_PNGIMAGE}
 186   {$IFDEF GLB_LIB_PNG}
 187     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 188     {$undef GLB_LIB_PNG}
 189   {$ENDIF}
 190
 191   {$DEFINE GLB_SUPPORT_PNG_READ}
 192   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 193 {$ENDIF}
 194
 195 // libPNG
 196 {$IFDEF GLB_LIB_PNG}
 197   {$DEFINE GLB_SUPPORT_PNG_READ}
 198   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 199 {$ENDIF}
 200
 201 // Lazarus TJPEGImage
 202 {$IFDEF GLB_LAZ_JPEG}
 203   {$IFNDEF GLB_LAZARUS}
 204     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 205     {$DEFINE GLB_LAZARUS}
 206   {$ENDIF}
 207
 208   {$IFDEF GLB_DELPHI_JPEG}
 209     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 210     {$undef GLB_DELPHI_JPEG}
 211   {$ENDIF}
 212
 213   {$IFDEF GLB_LIB_JPEG}
 214     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 215     {$undef GLB_LIB_JPEG}
 216   {$ENDIF}
 217
 218   {$DEFINE GLB_SUPPORT_JPEG_READ}
 219   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 220 {$ENDIF}
 221
 222 // JPEG Image
 223 {$IFDEF GLB_DELPHI_JPEG}
 224   {$IFDEF GLB_LIB_JPEG}
 225     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 226     {$undef GLB_LIB_JPEG}
 227   {$ENDIF}
 228
 229   {$DEFINE GLB_SUPPORT_JPEG_READ}
 230   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 231 {$ENDIF}
 232
 233 // libJPEG
 234 {$IFDEF GLB_LIB_JPEG}
 235   {$DEFINE GLB_SUPPORT_JPEG_READ}
 236   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 237 {$ENDIF}
 238
 239 // general options
 240 {$EXTENDEDSYNTAX ON}
 241 {$LONGSTRINGS ON}
 242 {$ALIGN ON}
 243 {$IFNDEF FPC}
 244   {$OPTIMIZATION ON}
 245 {$ENDIF}
 246
 247 interface
 248
 249 uses
 250   {$IFDEF OPENGL_ES}            dglOpenGLES,
 251   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 252
 253   {$IF DEFINED(GLB_WIN) AND
 254        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 255
 256   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 257   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 258   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 259
 260   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 261   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 262   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 263   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 264   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 265
 266   Classes, SysUtils;
 267
 268 type
 269 {$IFNDEF fpc}
 270   QWord   = System.UInt64;
 271   PQWord  = ^QWord;
 272
 273   PtrInt  = Longint;
 274   PtrUInt = DWord;
 275 {$ENDIF}
 276
 277
 278   { type that describes the format of the data stored in a texture.
 279     the name of formats is composed of the following constituents:
 280     - multiple channels:
 281        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 282        - width of the chanel in bit       (4, 8, 16, ...)
 283     - data type                           (e.g. ub, us, ui)
 284     - number of elements of data types }
 285   TglBitmapFormat = (
 286     tfEmpty = 0,
 287
 288     tfAlpha4ub1,                //< 1 x unsigned byte
 289     tfAlpha8ub1,                //< 1 x unsigned byte
 290     tfAlpha16us1,               //< 1 x unsigned short
 291
 292     tfLuminance4ub1,            //< 1 x unsigned byte
 293     tfLuminance8ub1,            //< 1 x unsigned byte
 294     tfLuminance16us1,           //< 1 x unsigned short
 295
 296     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 297     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 298     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 299     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 300     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 301
 302     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 303     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 304     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 305     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 306     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 307     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 308     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 309     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 310     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 311     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 312     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 313     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 314
 315     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 316     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 317     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 318     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 319     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 320     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 321     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 322     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 323     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 324     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 325
 326     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 327     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 328     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 329     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 330     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 331     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 332     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 333     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 334     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 335     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 336     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 337
 338     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 339     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 340     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 341     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 342     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 343     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 344     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 345     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 346     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 347     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 348
 349     tfDepth16us1,               //< 1 x unsigned short (depth)
 350     tfDepth24ui1,               //< 1 x unsigned int (depth)
 351     tfDepth32ui1,               //< 1 x unsigned int (depth)
 352
 353     tfS3tcDtx1RGBA,
 354     tfS3tcDtx3RGBA,
 355     tfS3tcDtx5RGBA
 356   );
 357
 358   { type to define suitable file formats }
 359   TglBitmapFileType = (
 360      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 361      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 362      ftDDS,                                             //< Direct Draw Surface file (DDS)
 363      ftTGA,                                             //< Targa Image File (TGA)
 364      ftBMP,                                             //< Windows Bitmap File (BMP)
 365      ftRAW);                                            //< glBitmap RAW file format
 366    TglBitmapFileTypes = set of TglBitmapFileType;
 367
 368   { possible mipmap types }
 369   TglBitmapMipMap = (
 370      mmNone,                //< no mipmaps
 371      mmMipmap,              //< normal mipmaps
 372      mmMipmapGlu);          //< mipmaps generated with glu functions
 373
 374   { possible normal map functions }
 375    TglBitmapNormalMapFunc = (
 376      nm4Samples,
 377      nmSobel,
 378      nm3x3,
 379      nm5x5);
 380
 381  ////////////////////////////////////////////////////////////////////////////////////////////////////
 382    EglBitmap                  = class(Exception);   //< glBitmap exception
 383    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 384    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 385    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 386    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 387    public
 388      constructor Create(const aFormat: TglBitmapFormat); overload;
 389      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 390    end;
 391
 392 ////////////////////////////////////////////////////////////////////////////////////////////////////
 393   { record that stores 4 unsigned integer values }
 394   TglBitmapRec4ui = packed record
 395   case Integer of
 396     0: (r, g, b, a: Cardinal);
 397     1: (arr: array[0..3] of Cardinal);
 398   end;
 399
 400   { record that stores 4 unsigned byte values }
 401   TglBitmapRec4ub = packed record
 402   case Integer of
 403     0: (r, g, b, a: Byte);
 404     1: (arr: array[0..3] of Byte);
 405   end;
 406
 407   { record that stores 4 unsigned long integer values }
 408   TglBitmapRec4ul = packed record
 409   case Integer of
 410     0: (r, g, b, a: QWord);
 411     1: (arr: array[0..3] of QWord);
 412   end;
 413
 414   { describes the properties of a given texture data format }
 415   TglBitmapFormatDescriptor = class(TObject)
 416   private
 417     // cached properties
 418     fBytesPerPixel: Single;   //< number of bytes for each pixel
 419     fChannelCount: Integer;   //< number of color channels
 420     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 421     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 422
 423     { @return @true if the format has a red color channel, @false otherwise }
 424     function GetHasRed: Boolean;
 425
 426     { @return @true if the format has a green color channel, @false otherwise }
 427     function GetHasGreen: Boolean;
 428
 429     { @return @true if the format has a blue color channel, @false otherwise }
 430     function GetHasBlue: Boolean;
 431
 432     { @return @true if the format has a alpha color channel, @false otherwise }
 433     function GetHasAlpha: Boolean;
 434
 435     { @return @true if the format has any color color channel, @false otherwise }
 436     function GetHasColor: Boolean;
 437
 438     { @return @true if the format is a grayscale format, @false otherwise }
 439     function GetIsGrayscale: Boolean;
 440   protected
 441     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 442     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 443     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 444     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 445     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 446     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 447
 448     fBitsPerPixel: Integer;           //< number of bits per pixel
 449     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 450
 451     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 452     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 453
 454     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 455     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 456     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 457
 458     { set values for this format descriptor }
 459     procedure SetValues; virtual;
 460
 461     { calculate cached values }
 462     procedure CalcValues;
 463   public
 464     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 465     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 466     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 467     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 468     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 469
 470     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 471     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 472     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 473     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 474
 475     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 476     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 477     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 478     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 479     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 480
 481     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 482     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 483     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 484
 485     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 486     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 487     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 488     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 489     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 490     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 491
 492     { constructor }
 493     constructor Create;
 494   public
 495     { get the format descriptor by a given OpenGL internal format
 496         @param aInternalFormat  OpenGL internal format to get format descriptor for
 497         @returns                suitable format descriptor or tfEmpty-Descriptor }
 498     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 499   end;
 500
 501 ////////////////////////////////////////////////////////////////////////////////////////////////////
 502   { structure to store pixel data in }
 503   TglBitmapPixelData = packed record
 504     Data:   TglBitmapRec4ui;  //< color data for each color channel
 505     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 506     Format: TglBitmapFormat;  //< format of the pixel
 507   end;
 508   PglBitmapPixelData = ^TglBitmapPixelData;
 509
 510   TglBitmapSizeFields = set of (ffX, ffY);
 511   TglBitmapSize = packed record
 512     Fields: TglBitmapSizeFields;
 513     X: Word;
 514     Y: Word;
 515   end;
 516   TglBitmapPixelPosition = TglBitmapSize;
 517
 518 ////////////////////////////////////////////////////////////////////////////////////////////////////
 519   TglBitmap = class;
 520
 521   { structure to store data for converting in }
 522   TglBitmapFunctionRec = record
 523     Sender:   TglBitmap;              //< texture object that stores the data to convert
 524     Size:     TglBitmapSize;          //< size of the texture
 525     Position: TglBitmapPixelPosition; //< position of the currently pixel
 526     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 527     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 528     Args:     Pointer;                //< user defined args that was passed to the convert function
 529   end;
 530
 531   { callback to use for converting texture data }
 532   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 533
 534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 535   { base class for all glBitmap classes. used to manage OpenGL texture objects
 536     and to load, save and manipulate texture data }
 537   TglBitmap = class
 538   private
 539     { @returns format descriptor that describes the format of the stored data }
 540     function GetFormatDesc: TglBitmapFormatDescriptor;
 541   protected
 542     fID: GLuint;                          //< name of the OpenGL texture object
 543     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 544     fAnisotropic: Integer;                //< anisotropic level
 545     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 546     fFreeDataOnDestroy: Boolean;          //< free stored data when this object is destroyed
 547     fFreeDataAfterGenTexture: Boolean;    //< free stored data after data was uploaded to video card
 548     fData: PByte;                         //< data of this texture
 549 {$IFNDEF OPENGL_ES}
 550     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 551 {$ENDIF}
 552     fBorderColor: array[0..3] of Single;  //< color of the texture border
 553
 554     fDimension: TglBitmapSize;            //< size of this texture
 555     fMipMap: TglBitmapMipMap;             //< mipmap type
 556     fFormat: TglBitmapFormat;             //< format the texture data is stored in
 557
 558     // Mapping
 559     fPixelSize: Integer;                  //< size of one pixel (in byte)
 560     fRowSize: Integer;                    //< size of one pixel row (in byte)
 561
 562     // Filtering
 563     fFilterMin: GLenum;                   //< min filter to apply to the texture
 564     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 565
 566     // TexturWarp
 567     fWrapS: GLenum;                       //< texture wrapping for x axis
 568     fWrapT: GLenum;                       //< texture wrapping for y axis
 569     fWrapR: GLenum;                       //< texture wrapping for z axis
 570
 571 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 572     //Swizzle
 573     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 574 {$IFEND}
 575
 576     // CustomData
 577     fFilename: String;                    //< filename the texture was load from
 578     fCustomName: String;                  //< user defined name
 579     fCustomNameW: WideString;             //< user defined name
 580     fCustomData: Pointer;                 //< user defined data
 581
 582   protected
 583     { @returns the actual width of the texture }
 584     function GetWidth:  Integer; virtual;
 585
 586     { @returns the actual height of the texture }
 587     function GetHeight: Integer; virtual;
 588
 589     { @returns the width of the texture or 1 if the width is zero }
 590     function GetFileWidth:  Integer; virtual;
 591
 592     { @returns the height of the texture or 1 if the height is zero }
 593     function GetFileHeight: Integer; virtual;
 594
 595   protected
 596     { set a new value for fCustomData }
 597     procedure SetCustomData(const aValue: Pointer);
 598
 599     { set a new value for fCustomName }
 600     procedure SetCustomName(const aValue: String);
 601
 602     { set a new value for fCustomNameW }
 603     procedure SetCustomNameW(const aValue: WideString);
 604
 605     { set new value for fFreeDataOnDestroy }
 606     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 607
 608     { set new value for fDeleteTextureOnFree }
 609     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 610
 611     { set new value for the data format. only possible if new format has the same pixel size.
 612       if you want to convert the texture data, see ConvertTo function }
 613     procedure SetFormat(const aValue: TglBitmapFormat);
 614
 615     { set new value for fFreeDataAfterGenTexture }
 616     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 617
 618     { set name of OpenGL texture object }
 619     procedure SetID(const aValue: Cardinal);
 620
 621     { set new value for fMipMap }
 622     procedure SetMipMap(const aValue: TglBitmapMipMap);
 623
 624     { set new value for target }
 625     procedure SetTarget(const aValue: Cardinal);
 626
 627     { set new value for fAnisotrophic }
 628     procedure SetAnisotropic(const aValue: Integer);
 629
 630   protected
 631     { create OpenGL texture object (delete exisiting object if exists) }
 632     procedure CreateID;
 633
 634     { setup texture parameters }
 635     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
 636
 637     { set data pointer of texture data
 638         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
 639         @param aFormat  format of the data stored at aData
 640         @param aWidth   width of the texture data
 641         @param aHeight  height of the texture data }
 642     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 643       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 644
 645     { generate texture (upload texture data to video card)
 646         @param aTestTextureSize   test texture size before uploading and raise exception if something is wrong }
 647     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 648
 649     { flip texture horizontal
 650         @returns @true in success, @false otherwise }
 651     function FlipHorz: Boolean; virtual;
 652
 653     { flip texture vertical
 654         @returns @true in success, @false otherwise }
 655     function FlipVert: Boolean; virtual;
 656
 657   protected
 658     property Width:  Integer read GetWidth;             //< the actual width of the texture
 659     property Height: Integer read GetHeight;            //< the actual height of the texture
 660
 661     property FileWidth:  Integer read GetFileWidth;     //< the width of the texture or 1 if the width is zero
 662     property FileHeight: Integer read GetFileHeight;    //< the height of the texture or 1 if the height is zero
 663   public
 664     property ID:           Cardinal        read fID          write SetID;           //< name of the OpenGL texture object
 665     property Target:       Cardinal        read fTarget      write SetTarget;       //< texture target (e.g. GL_TEXTURE_2D)
 666     property Format:       TglBitmapFormat read fFormat      write SetFormat;       //< format the texture data is stored in
 667     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
 668     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
 669
 670     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;      //< format descriptor that describes the format of the stored data
 671
 672     property Filename:    String     read fFilename;                          //< filename the texture was load from
 673     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
 674     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
 675     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
 676
 677     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;     //< delete texture object when this object is destroyed
 678     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;       //< free stored data when this object is destroyed
 679     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card
 680
 681     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
 682     property Data:       PByte         read fData;          //< texture data (or @nil if unset)
 683 {$IFNDEF OPENGL_ES}
 684     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
 685 {$ENDIF}
 686
 687     { this method is called after the constructor and sets the default values of this object }
 688     procedure AfterConstruction; override;
 689
 690     { this method is called before the destructor and does some cleanup }
 691     procedure BeforeDestruction; override;
 692
 693     { splits a resource identifier into the resource and it's type
 694         @param aResource  resource identifier to split and store name in
 695         @param aResType   type of the resource }
 696     procedure PrepareResType(var aResource: String; var aResType: PChar);
 697
 698   public
 699     { load a texture from a file
 700         @param aFilename file to load texuture from }
 701     procedure LoadFromFile(const aFilename: String);
 702
 703     { load a texture from a stream
 704         @param aStream  stream to load texture from }
 705     procedure LoadFromStream(const aStream: TStream); virtual;
 706
 707     { use a function to generate texture data
 708         @param aSize    size of the texture
 709         @param aFunc    callback to use for generation
 710         @param aFormat  format of the texture data
 711         @param aArgs    user defined paramaters (use at will) }
 712     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
 713       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 714
 715     { load a texture from a resource
 716         @param aInstance  resource handle
 717         @param aResource  resource indentifier
 718         @param aResType   resource type (if known) }
 719     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 720
 721     { load a texture from a resource id
 722         @param aInstance  resource handle
 723         @param aResource  resource ID
 724         @param aResType   resource type }
 725     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 726
 727   public
 728     { save texture data to a file
 729         @param aFilename  filename to store texture in
 730         @param aFileType  file type to store data into }
 731     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 732
 733     { save texture data to a stream
 734         @param aFilename  filename to store texture in
 735         @param aFileType  file type to store data into }
 736     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 737
 738   public
 739     { convert texture data using a user defined callback
 740         @param aFunc        callback to use for converting
 741         @param aCreateTemp  create a temporary buffer to use for converting
 742         @param aArgs        user defined paramters (use at will)
 743         @returns            @true if converting was successful, @false otherwise }
 744     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 745
 746     { convert texture data using a user defined callback
 747         @param aSource      glBitmap to read data from
 748         @param aFunc        callback to use for converting
 749         @param aCreateTemp  create a temporary buffer to use for converting
 750         @param aFormat      format of the new data
 751         @param aArgs        user defined paramters (use at will)
 752         @returns            @true if converting was successful, @false otherwise }
 753     function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 754       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 755
 756     { convert texture data using a specific format
 757         @param aFormat  new format of texture data
 758         @returns        @true if converting was successful, @false otherwise }
 759     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 760
 761 {$IFDEF GLB_SDL}
 762   public
 763     { assign texture data to SDL surface
 764         @param aSurface SDL surface to write data to
 765         @returns        @true on success, @false otherwise }
 766     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 767
 768     { assign texture data from SDL surface
 769         @param aSurface SDL surface to read data from
 770         @returns        @true on success, @false otherwise }
 771     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 772
 773     { assign alpha channel data to SDL surface
 774         @param aSurface SDL surface to write alpha channel data to
 775         @returns        @true on success, @false otherwise }
 776     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 777
 778     { assign alpha channel data from SDL surface
 779         @param aSurface SDL surface to read data from
 780         @param aFunc    callback to use for converting
 781         @param aArgs    user defined parameters (use at will)
 782         @returns        @true on success, @false otherwise }
 783     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 784 {$ENDIF}
 785
 786 {$IFDEF GLB_DELPHI}
 787   public
 788     { assign texture data to TBitmap object
 789         @param aBitmap  TBitmap to write data to
 790         @returns        @true on success, @false otherwise }
 791     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 792
 793     { assign texture data from TBitmap object
 794         @param aBitmap  TBitmap to read data from
 795         @returns        @true on success, @false otherwise }
 796     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 797
 798     { assign alpha channel data to TBitmap object
 799         @param aBitmap  TBitmap to write data to
 800         @returns        @true on success, @false otherwise }
 801     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 802
 803     { assign alpha channel data from TBitmap object
 804         @param aBitmap  TBitmap to read data from
 805         @param aFunc    callback to use for converting
 806         @param aArgs    user defined parameters (use at will)
 807         @returns        @true on success, @false otherwise }
 808     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 809 {$ENDIF}
 810
 811 {$IFDEF GLB_LAZARUS}
 812   public
 813     { assign texture data to TLazIntfImage object
 814         @param aImage   TLazIntfImage to write data to
 815         @returns        @true on success, @false otherwise }
 816     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 817
 818     { assign texture data from TLazIntfImage object
 819         @param aImage   TLazIntfImage to read data from
 820         @returns        @true on success, @false otherwise }
 821     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 822
 823     { assign alpha channel data to TLazIntfImage object
 824         @param aImage   TLazIntfImage to write data to
 825         @returns        @true on success, @false otherwise }
 826     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 827
 828     { assign alpha channel data from TLazIntfImage object
 829         @param aImage   TLazIntfImage to read data from
 830         @param aFunc    callback to use for converting
 831         @param aArgs    user defined parameters (use at will)
 832         @returns        @true on success, @false otherwise }
 833     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 834 {$ENDIF}
 835
 836   public
 837     { load alpha channel data from resource
 838         @param aInstance  resource handle
 839         @param aResource  resource ID
 840         @param aResType   resource type
 841         @param aFunc      callback to use for converting
 842         @param aArgs      user defined parameters (use at will)
 843         @returns          @true on success, @false otherwise }
 844     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 845
 846     { load alpha channel data from resource ID
 847         @param aInstance    resource handle
 848         @param aResourceID  resource ID
 849         @param aResType     resource type
 850         @param aFunc        callback to use for converting
 851         @param aArgs        user defined parameters (use at will)
 852         @returns            @true on success, @false otherwise }
 853     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 854
 855     { add alpha channel data from function
 856         @param aFunc  callback to get data from
 857         @param aArgs  user defined parameters (use at will)
 858         @returns      @true on success, @false otherwise }
 859     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 860
 861     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 862         @param aFilename  file to load alpha channel data from
 863         @param aFunc      callback to use for converting
 864         @param aArgs      user defined parameters (use at will)
 865         @returns          @true on success, @false otherwise }
 866     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 867
 868     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 869         @param aStream  stream to load alpha channel data from
 870         @param aFunc    callback to use for converting
 871         @param aArgs    user defined parameters (use at will)
 872         @returns        @true on success, @false otherwise }
 873     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 874
 875     { add alpha channel data from existing glBitmap object
 876         @param aBitmap  TglBitmap to copy alpha channel data from
 877         @param aFunc    callback to use for converting
 878         @param aArgs    user defined parameters (use at will)
 879         @returns        @true on success, @false otherwise }
 880     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 881
 882     { add alpha to pixel if the pixels color is greter than the given color value
 883         @param aRed         red threshold (0-255)
 884         @param aGreen       green threshold (0-255)
 885         @param aBlue        blue threshold (0-255)
 886         @param aDeviatation accepted deviatation (0-255)
 887         @returns            @true on success, @false otherwise }
 888     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 889
 890     { add alpha to pixel if the pixels color is greter than the given color value
 891         @param aRed         red threshold (0-Range.r)
 892         @param aGreen       green threshold (0-Range.g)
 893         @param aBlue        blue threshold (0-Range.b)
 894         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 895         @returns            @true on success, @false otherwise }
 896     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 897
 898     { add alpha to pixel if the pixels color is greter than the given color value
 899         @param aRed         red threshold (0.0-1.0)
 900         @param aGreen       green threshold (0.0-1.0)
 901         @param aBlue        blue threshold (0.0-1.0)
 902         @param aDeviatation accepted deviatation (0.0-1.0)
 903         @returns            @true on success, @false otherwise }
 904     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 905
 906     { add a constand alpha value to all pixels
 907         @param aAlpha alpha value to add (0-255)
 908         @returns      @true on success, @false otherwise }
 909     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 910
 911     { add a constand alpha value to all pixels
 912         @param aAlpha alpha value to add (0-max(Range.rgb))
 913         @returns      @true on success, @false otherwise }
 914     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 915
 916     { add a constand alpha value to all pixels
 917         @param aAlpha alpha value to add (0.0-1.0)
 918         @returns      @true on success, @false otherwise }
 919     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 920
 921     { remove alpha channel
 922         @returns  @true on success, @false otherwise }
 923     function RemoveAlpha: Boolean; virtual;
 924
 925   public
 926     { create a clone of the current object
 927         @returns clone of this object}
 928     function Clone: TglBitmap;
 929
 930     { invert color data (xor)
 931         @param aUseRGB   xor each color channel
 932         @param aUseAlpha xor alpha channel }
 933     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 934
 935     { free texture stored data }
 936     procedure FreeData;
 937
 938 {$IFNDEF OPENGL_ES}
 939     { set the new value for texture border color
 940         @param aRed   red color for border (0.0-1.0)
 941         @param aGreen green color for border (0.0-1.0)
 942         @param aBlue  blue color for border (0.0-1.0)
 943         @param aAlpha alpha color for border (0.0-1.0) }
 944     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 945 {$ENDIF}
 946
 947   public
 948     { fill complete texture with one color
 949         @param aRed   red color for border (0-255)
 950         @param aGreen green color for border (0-255)
 951         @param aBlue  blue color for border (0-255)
 952         @param aAlpha alpha color for border (0-255) }
 953     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 954
 955     { fill complete texture with one color
 956         @param aRed   red color for border (0-Range.r)
 957         @param aGreen green color for border (0-Range.g)
 958         @param aBlue  blue color for border (0-Range.b)
 959         @param aAlpha alpha color for border (0-Range.a) }
 960     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 961
 962     { fill complete texture with one color
 963         @param aRed   red color for border (0.0-1.0)
 964         @param aGreen green color for border (0.0-1.0)
 965         @param aBlue  blue color for border (0.0-1.0)
 966         @param aAlpha alpha color for border (0.0-1.0) }
 967     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 968
 969   public
 970     { set new texture filer
 971         @param aMin   min filter
 972         @param aMag   mag filter }
 973     procedure SetFilter(const aMin, aMag: GLenum);
 974
 975     { set new texture wrapping
 976         @param S  texture wrapping for x axis
 977         @param T  texture wrapping for y axis
 978         @param R  texture wrapping for z axis }
 979     procedure SetWrap(
 980       const S: GLenum = GL_CLAMP_TO_EDGE;
 981       const T: GLenum = GL_CLAMP_TO_EDGE;
 982       const R: GLenum = GL_CLAMP_TO_EDGE);
 983
 984 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 985     { set new swizzle
 986         @param r  swizzle for red channel
 987         @param g  swizzle for green channel
 988         @param b  swizzle for blue channel
 989         @param a  swizzle for alpha channel }
 990     procedure SetSwizzle(const r, g, b, a: GLenum);
 991 {$IFEND}
 992
 993   public
 994     { bind texture
 995         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
 996     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 997
 998     { bind texture
 999         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1000     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1001
1002   public
1003     { constructor - created an empty texture }
1004     constructor Create; overload;
1005
1006     { constructor - creates a texture and load it from a file
1007         @param aFilename file to load texture from }
1008     constructor Create(const aFileName: String); overload;
1009
1010     { constructor - creates a texture and load it from a stream
1011         @param aStream stream to load texture from }
1012     constructor Create(const aStream: TStream); overload;
1013
1014     { constructor - creates a texture with the given size, format and data
1015         @param aSize    size of the texture
1016         @param aFormat  format of the given data
1017         @param aData    texture data - be carefull: the data will now be managed by the glBitmap object,
1018                         you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }
1019     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1020
1021     { constructor - creates a texture with the given size and format and uses the given callback to create the data
1022         @param aSize    size of the texture
1023         @param aFormat  format of the given data
1024         @param aFunc    callback to use for generating the data
1025         @param aArgs    user defined parameters (use at will) }
1026     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1027
1028     { constructor - creates a texture and loads it from a resource
1029         @param aInstance  resource handle
1030         @param aResource  resource indentifier
1031         @param aResType   resource type (if known) }
1032     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1033
1034     { constructor - creates a texture and loads it from a resource
1035         @param aInstance    resource handle
1036         @param aResourceID  resource ID
1037         @param aResType     resource type (if known) }
1038     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1039
1040   private
1041 {$IFDEF GLB_SUPPORT_PNG_READ}
1042     { try to load a PNG from a stream
1043         @param aStream  stream to load PNG from
1044         @returns        @true on success, @false otherwise }
1045     function  LoadPNG(const aStream: TStream): Boolean; virtual;
1046 {$ENDIF}
1047
1048 {$ifdef GLB_SUPPORT_PNG_WRITE}
1049     { save texture data as PNG to stream
1050         @param aStream stream to save data to}
1051     procedure SavePNG(const aStream: TStream); virtual;
1052 {$ENDIF}
1053
1054 {$IFDEF GLB_SUPPORT_JPEG_READ}
1055     { try to load a JPEG from a stream
1056         @param aStream  stream to load JPEG from
1057         @returns        @true on success, @false otherwise }
1058     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
1059 {$ENDIF}
1060
1061 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1062     { save texture data as JPEG to stream
1063         @param aStream stream to save data to}
1064     procedure SaveJPEG(const aStream: TStream); virtual;
1065 {$ENDIF}
1066
1067     { try to load a RAW image from a stream
1068         @param aStream  stream to load RAW image from
1069         @returns        @true on success, @false otherwise }
1070     function LoadRAW(const aStream: TStream): Boolean;
1071
1072     { save texture data as RAW image to stream
1073         @param aStream stream to save data to}
1074     procedure SaveRAW(const aStream: TStream);
1075
1076     { try to load a BMP from a stream
1077         @param aStream  stream to load BMP from
1078         @returns        @true on success, @false otherwise }
1079     function LoadBMP(const aStream: TStream): Boolean;
1080
1081     { save texture data as BMP to stream
1082         @param aStream stream to save data to}
1083     procedure SaveBMP(const aStream: TStream);
1084
1085     { try to load a TGA from a stream
1086         @param aStream  stream to load TGA from
1087         @returns        @true on success, @false otherwise }
1088     function LoadTGA(const aStream: TStream): Boolean;
1089
1090     { save texture data as TGA to stream
1091         @param aStream stream to save data to}
1092     procedure SaveTGA(const aStream: TStream);
1093
1094     { try to load a DDS from a stream
1095         @param aStream  stream to load DDS from
1096         @returns        @true on success, @false otherwise }
1097     function LoadDDS(const aStream: TStream): Boolean;
1098
1099     { save texture data as DDS to stream
1100         @param aStream stream to save data to}
1101     procedure SaveDDS(const aStream: TStream);
1102   end;
1103
1104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1105 {$IF NOT DEFINED(OPENGL_ES)}
1106   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }
1107   TglBitmap1D = class(TglBitmap)
1108   protected
1109     { set data pointer of texture data
1110         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1111         @param aFormat  format of the data stored at aData
1112         @param aWidth   width of the texture data
1113         @param aHeight  height of the texture data }
1114     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1115
1116     { upload the texture data to video card
1117         @param aBuildWithGlu  use glu functions to build mipmaps }
1118     procedure UploadData(const aBuildWithGlu: Boolean);
1119   public
1120     property Width; //< actual with of the texture
1121
1122     { this method is called after constructor and initializes the object }
1123     procedure AfterConstruction; override;
1124
1125     { flip texture horizontally
1126         @returns @true on success, @fals otherwise }
1127     function FlipHorz: Boolean; override;
1128
1129     { generate texture (create texture object if not exist, set texture parameters and upload data
1130         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1131     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1132   end;
1133 {$IFEND}
1134
1135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1136   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }
1137   TglBitmap2D = class(TglBitmap)
1138   protected
1139     fLines: array of PByte; //< array to store scanline entry points in
1140
1141     { get a specific scanline
1142         @param aIndex   index of the scanline to return
1143         @returns        scanline at position aIndex or @nil }
1144     function GetScanline(const aIndex: Integer): Pointer;
1145
1146     { set data pointer of texture data
1147         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1148         @param aFormat  format of the data stored at aData
1149         @param aWidth   width of the texture data
1150         @param aHeight  height of the texture data }
1151     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1152       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1153
1154     { upload the texture data to video card
1155         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1156         @param aBuildWithGlu  use glu functions to build mipmaps }
1157     procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1158   public
1159     property Width;                                                       //< actual width of the texture
1160     property Height;                                                      //< actual height of the texture
1161     property Scanline[const aIndex: Integer]: Pointer read GetScanline;   //< scanline to access texture data directly
1162
1163     { this method is called after constructor and initializes the object }
1164     procedure AfterConstruction; override;
1165
1166     { copy a part of the frame buffer top the texture
1167         @param aTop     topmost pixel to copy
1168         @param aLeft    leftmost pixel to copy
1169         @param aRight   rightmost pixel to copy
1170         @param aBottom  bottommost pixel to copy
1171         @param aFormat  format to store data in }
1172     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1173
1174 {$IFNDEF OPENGL_ES}
1175     { downlaod texture data from OpenGL texture object }
1176     procedure GetDataFromTexture;
1177 {$ENDIF}
1178
1179     { generate texture (create texture object if not exist, set texture parameters and upload data)
1180         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1181     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1182
1183     { flip texture horizontally
1184         @returns @true on success, @false otherwise }
1185     function FlipHorz: Boolean; override;
1186
1187     { flip texture vertically
1188         @returns @true on success, @false otherwise }
1189     function FlipVert: Boolean; override;
1190
1191     { create normal map from texture data
1192         @param aFunc      normal map function to generate normalmap with
1193         @param aScale     scale of the normale stored in the normal map
1194         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
1195     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1196       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1197   end;
1198
1199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1200 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1201   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }
1202   TglBitmapCubeMap = class(TglBitmap2D)
1203   protected
1204   {$IFNDEF OPENGL_ES}
1205     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1206   {$ENDIF}
1207
1208     { generate texture (create texture object if not exist, set texture parameters and upload data
1209       do not call directly for cubemaps, use GenerateCubeMap instead
1210         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1211     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1212   public
1213     { this method is called after constructor and initializes the object }
1214     procedure AfterConstruction; override;
1215
1216     { generate texture (create texture object if not exist, set texture parameters and upload data
1217         @param aCubeTarget        cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1218         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1219     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1220
1221     { bind texture
1222         @param aEnableTexCoordsGen  enable cube map generator
1223         @param aEnableTextureUnit   enable texture unit }
1224     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1225
1226     { unbind texture
1227         @param aDisableTexCoordsGen   disable cube map generator
1228         @param aDisableTextureUnit    disable texture unit }
1229     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1230   end;
1231 {$IFEND}
1232
1233 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1235   { wrapper class for cube normal maps }
1236   TglBitmapNormalMap = class(TglBitmapCubeMap)
1237   public
1238     { this method is called after constructor and initializes the object }
1239     procedure AfterConstruction; override;
1240
1241     { create cube normal map from texture data and upload it to video card
1242         @param aSize              size of each cube map texture
1243         @param aTestTextureSize   check texture size when uploading and throw exception if something is wrong  }
1244     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1245   end;
1246 {$IFEND}
1247
1248 const
1249   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1250
1251 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1252 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1253 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1254 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1255 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1256 procedure glBitmapSetDefaultWrap(
1257   const S: Cardinal = GL_CLAMP_TO_EDGE;
1258   const T: Cardinal = GL_CLAMP_TO_EDGE;
1259   const R: Cardinal = GL_CLAMP_TO_EDGE);
1260
1261 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1262 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1263 {$IFEND}
1264
1265 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1266 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1267 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1268 function glBitmapGetDefaultFormat: TglBitmapFormat;
1269 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1270 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1271 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1272 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1273 {$IFEND}
1274
1275 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1276 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1277 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1278 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1279 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1280 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1281 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1282
1283 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1284
1285 {$IFDEF GLB_DELPHI}
1286 function CreateGrayPalette: HPALETTE;
1287 {$ENDIF}
1288
1289 implementation
1290
1291 uses
1292   Math, syncobjs, typinfo
1293   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1294
1295
1296 var
1297   glBitmapDefaultDeleteTextureOnFree: Boolean;
1298   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1299   glBitmapDefaultFormat: TglBitmapFormat;
1300   glBitmapDefaultMipmap: TglBitmapMipMap;
1301   glBitmapDefaultFilterMin: Cardinal;
1302   glBitmapDefaultFilterMag: Cardinal;
1303   glBitmapDefaultWrapS: Cardinal;
1304   glBitmapDefaultWrapT: Cardinal;
1305   glBitmapDefaultWrapR: Cardinal;
1306   glDefaultSwizzle: array[0..3] of GLenum;
1307
1308 ////////////////////////////////////////////////////////////////////////////////////////////////////
1309 type
1310   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1311   public
1312     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1313     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1314
1315     function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
1316     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1317
1318     function CreateMappingData: Pointer; virtual;
1319     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1320
1321     function IsEmpty: Boolean; virtual;
1322     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1323
1324     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1325
1326     constructor Create; virtual;
1327   public
1328     class procedure Init;
1329     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1330     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1331     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1332     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1333     class procedure Clear;
1334     class procedure Finalize;
1335   end;
1336   TFormatDescriptorClass = class of TFormatDescriptor;
1337
1338   TfdEmpty = class(TFormatDescriptor);
1339
1340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1341   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1342     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1343     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1344   end;
1345
1346   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1347     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1348     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1349   end;
1350
1351   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354   end;
1355
1356   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1357     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1358     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1359   end;
1360
1361   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1362     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1363     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1364   end;
1365
1366   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369   end;
1370
1371   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374   end;
1375
1376   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379   end;
1380
1381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1382   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385   end;
1386
1387   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390   end;
1391
1392   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395   end;
1396
1397   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400   end;
1401
1402   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1403     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1404     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1405   end;
1406
1407   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1408     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1409     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1410   end;
1411
1412   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415   end;
1416
1417   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1418     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1419     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1420   end;
1421
1422   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1423     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1424     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1425   end;
1426
1427   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1428     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1429     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1430   end;
1431
1432   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435   end;
1436
1437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1438   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441   end;
1442
1443   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446   end;
1447
1448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1449   TfdAlpha4ub1 = class(TfdAlphaUB1)
1450     procedure SetValues; override;
1451   end;
1452
1453   TfdAlpha8ub1 = class(TfdAlphaUB1)
1454     procedure SetValues; override;
1455   end;
1456
1457   TfdAlpha16us1 = class(TfdAlphaUS1)
1458     procedure SetValues; override;
1459   end;
1460
1461   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1462     procedure SetValues; override;
1463   end;
1464
1465   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1466     procedure SetValues; override;
1467   end;
1468
1469   TfdLuminance16us1 = class(TfdLuminanceUS1)
1470     procedure SetValues; override;
1471   end;
1472
1473   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1474     procedure SetValues; override;
1475   end;
1476
1477   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1478     procedure SetValues; override;
1479   end;
1480
1481   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1482     procedure SetValues; override;
1483   end;
1484
1485   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1486     procedure SetValues; override;
1487   end;
1488
1489   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1490     procedure SetValues; override;
1491   end;
1492
1493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1494   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1495     procedure SetValues; override;
1496   end;
1497
1498   TfdRGBX4us1 = class(TfdUniversalUS1)
1499     procedure SetValues; override;
1500   end;
1501
1502   TfdXRGB4us1 = class(TfdUniversalUS1)
1503     procedure SetValues; override;
1504   end;
1505
1506   TfdR5G6B5us1 = class(TfdUniversalUS1)
1507     procedure SetValues; override;
1508   end;
1509
1510   TfdRGB5X1us1 = class(TfdUniversalUS1)
1511     procedure SetValues; override;
1512   end;
1513
1514   TfdX1RGB5us1 = class(TfdUniversalUS1)
1515     procedure SetValues; override;
1516   end;
1517
1518   TfdRGB8ub3 = class(TfdRGBub3)
1519     procedure SetValues; override;
1520   end;
1521
1522   TfdRGBX8ui1 = class(TfdUniversalUI1)
1523     procedure SetValues; override;
1524   end;
1525
1526   TfdXRGB8ui1 = class(TfdUniversalUI1)
1527     procedure SetValues; override;
1528   end;
1529
1530   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1531     procedure SetValues; override;
1532   end;
1533
1534   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1535     procedure SetValues; override;
1536   end;
1537
1538   TfdRGB16us3 = class(TfdRGBus3)
1539     procedure SetValues; override;
1540   end;
1541
1542   TfdRGBA4us1 = class(TfdUniversalUS1)
1543     procedure SetValues; override;
1544   end;
1545
1546   TfdARGB4us1 = class(TfdUniversalUS1)
1547     procedure SetValues; override;
1548   end;
1549
1550   TfdRGB5A1us1 = class(TfdUniversalUS1)
1551     procedure SetValues; override;
1552   end;
1553
1554   TfdA1RGB5us1 = class(TfdUniversalUS1)
1555     procedure SetValues; override;
1556   end;
1557
1558   TfdRGBA8ui1 = class(TfdUniversalUI1)
1559     procedure SetValues; override;
1560   end;
1561
1562   TfdARGB8ui1 = class(TfdUniversalUI1)
1563     procedure SetValues; override;
1564   end;
1565
1566   TfdRGBA8ub4 = class(TfdRGBAub4)
1567     procedure SetValues; override;
1568   end;
1569
1570   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1571     procedure SetValues; override;
1572   end;
1573
1574   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1575     procedure SetValues; override;
1576   end;
1577
1578   TfdRGBA16us4 = class(TfdRGBAus4)
1579     procedure SetValues; override;
1580   end;
1581
1582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1583   TfdBGRX4us1 = class(TfdUniversalUS1)
1584     procedure SetValues; override;
1585   end;
1586
1587   TfdXBGR4us1 = class(TfdUniversalUS1)
1588     procedure SetValues; override;
1589   end;
1590
1591   TfdB5G6R5us1 = class(TfdUniversalUS1)
1592     procedure SetValues; override;
1593   end;
1594
1595   TfdBGR5X1us1 = class(TfdUniversalUS1)
1596     procedure SetValues; override;
1597   end;
1598
1599   TfdX1BGR5us1 = class(TfdUniversalUS1)
1600     procedure SetValues; override;
1601   end;
1602
1603   TfdBGR8ub3 = class(TfdBGRub3)
1604     procedure SetValues; override;
1605   end;
1606
1607   TfdBGRX8ui1 = class(TfdUniversalUI1)
1608     procedure SetValues; override;
1609   end;
1610
1611   TfdXBGR8ui1 = class(TfdUniversalUI1)
1612     procedure SetValues; override;
1613   end;
1614
1615   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1616     procedure SetValues; override;
1617   end;
1618
1619   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1620     procedure SetValues; override;
1621   end;
1622
1623   TfdBGR16us3 = class(TfdBGRus3)
1624     procedure SetValues; override;
1625   end;
1626
1627   TfdBGRA4us1 = class(TfdUniversalUS1)
1628     procedure SetValues; override;
1629   end;
1630
1631   TfdABGR4us1 = class(TfdUniversalUS1)
1632     procedure SetValues; override;
1633   end;
1634
1635   TfdBGR5A1us1 = class(TfdUniversalUS1)
1636     procedure SetValues; override;
1637   end;
1638
1639   TfdA1BGR5us1 = class(TfdUniversalUS1)
1640     procedure SetValues; override;
1641   end;
1642
1643   TfdBGRA8ui1 = class(TfdUniversalUI1)
1644     procedure SetValues; override;
1645   end;
1646
1647   TfdABGR8ui1 = class(TfdUniversalUI1)
1648     procedure SetValues; override;
1649   end;
1650
1651   TfdBGRA8ub4 = class(TfdBGRAub4)
1652     procedure SetValues; override;
1653   end;
1654
1655   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1656     procedure SetValues; override;
1657   end;
1658
1659   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1660     procedure SetValues; override;
1661   end;
1662
1663   TfdBGRA16us4 = class(TfdBGRAus4)
1664     procedure SetValues; override;
1665   end;
1666
1667   TfdDepth16us1 = class(TfdDepthUS1)
1668     procedure SetValues; override;
1669   end;
1670
1671   TfdDepth24ui1 = class(TfdDepthUI1)
1672     procedure SetValues; override;
1673   end;
1674
1675   TfdDepth32ui1 = class(TfdDepthUI1)
1676     procedure SetValues; override;
1677   end;
1678
1679   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1680     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1681     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1682     procedure SetValues; override;
1683   end;
1684
1685   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1686     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1687     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1688     procedure SetValues; override;
1689   end;
1690
1691   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1692     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1693     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1694     procedure SetValues; override;
1695   end;
1696
1697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1698   TbmpBitfieldFormat = class(TFormatDescriptor)
1699   public
1700     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1701     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1702     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1703     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1704   end;
1705
1706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1707   TbmpColorTableEnty = packed record
1708     b, g, r, a: Byte;
1709   end;
1710   TbmpColorTable = array of TbmpColorTableEnty;
1711   TbmpColorTableFormat = class(TFormatDescriptor)
1712   private
1713     fBitsPerPixel: Integer;
1714     fColorTable: TbmpColorTable;
1715   protected
1716     procedure SetValues; override;
1717   public
1718     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1719     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1720
1721     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1722     procedure CalcValues;
1723     procedure CreateColorTable;
1724
1725     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1726     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1727     destructor Destroy; override;
1728   end;
1729
1730 const
1731   LUMINANCE_WEIGHT_R = 0.30;
1732   LUMINANCE_WEIGHT_G = 0.59;
1733   LUMINANCE_WEIGHT_B = 0.11;
1734
1735   ALPHA_WEIGHT_R = 0.30;
1736   ALPHA_WEIGHT_G = 0.59;
1737   ALPHA_WEIGHT_B = 0.11;
1738
1739   DEPTH_WEIGHT_R = 0.333333333;
1740   DEPTH_WEIGHT_G = 0.333333333;
1741   DEPTH_WEIGHT_B = 0.333333333;
1742
1743   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1744     TfdEmpty,
1745
1746     TfdAlpha4ub1,
1747     TfdAlpha8ub1,
1748     TfdAlpha16us1,
1749
1750     TfdLuminance4ub1,
1751     TfdLuminance8ub1,
1752     TfdLuminance16us1,
1753
1754     TfdLuminance4Alpha4ub2,
1755     TfdLuminance6Alpha2ub2,
1756     TfdLuminance8Alpha8ub2,
1757     TfdLuminance12Alpha4us2,
1758     TfdLuminance16Alpha16us2,
1759
1760     TfdR3G3B2ub1,
1761     TfdRGBX4us1,
1762     TfdXRGB4us1,
1763     TfdR5G6B5us1,
1764     TfdRGB5X1us1,
1765     TfdX1RGB5us1,
1766     TfdRGB8ub3,
1767     TfdRGBX8ui1,
1768     TfdXRGB8ui1,
1769     TfdRGB10X2ui1,
1770     TfdX2RGB10ui1,
1771     TfdRGB16us3,
1772
1773     TfdRGBA4us1,
1774     TfdARGB4us1,
1775     TfdRGB5A1us1,
1776     TfdA1RGB5us1,
1777     TfdRGBA8ui1,
1778     TfdARGB8ui1,
1779     TfdRGBA8ub4,
1780     TfdRGB10A2ui1,
1781     TfdA2RGB10ui1,
1782     TfdRGBA16us4,
1783
1784     TfdBGRX4us1,
1785     TfdXBGR4us1,
1786     TfdB5G6R5us1,
1787     TfdBGR5X1us1,
1788     TfdX1BGR5us1,
1789     TfdBGR8ub3,
1790     TfdBGRX8ui1,
1791     TfdXBGR8ui1,
1792     TfdBGR10X2ui1,
1793     TfdX2BGR10ui1,
1794     TfdBGR16us3,
1795
1796     TfdBGRA4us1,
1797     TfdABGR4us1,
1798     TfdBGR5A1us1,
1799     TfdA1BGR5us1,
1800     TfdBGRA8ui1,
1801     TfdABGR8ui1,
1802     TfdBGRA8ub4,
1803     TfdBGR10A2ui1,
1804     TfdA2BGR10ui1,
1805     TfdBGRA16us4,
1806
1807     TfdDepth16us1,
1808     TfdDepth24ui1,
1809     TfdDepth32ui1,
1810
1811     TfdS3tcDtx1RGBA,
1812     TfdS3tcDtx3RGBA,
1813     TfdS3tcDtx5RGBA
1814   );
1815
1816 var
1817   FormatDescriptorCS: TCriticalSection;
1818   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1819
1820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1821 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1822 begin
1823   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1824 end;
1825
1826 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1827 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1828 begin
1829   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1830 end;
1831
1832 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1833 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1834 begin
1835   result.Fields := [];
1836   if (X >= 0) then
1837     result.Fields := result.Fields + [ffX];
1838   if (Y >= 0) then
1839     result.Fields := result.Fields + [ffY];
1840   result.X := Max(0, X);
1841   result.Y := Max(0, Y);
1842 end;
1843
1844 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1846 begin
1847   result := glBitmapSize(X, Y);
1848 end;
1849
1850 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1851 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1852 begin
1853   result.r := r;
1854   result.g := g;
1855   result.b := b;
1856   result.a := a;
1857 end;
1858
1859 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1860 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1861 begin
1862   result.r := r;
1863   result.g := g;
1864   result.b := b;
1865   result.a := a;
1866 end;
1867
1868 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1869 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1870 begin
1871   result.r := r;
1872   result.g := g;
1873   result.b := b;
1874   result.a := a;
1875 end;
1876
1877 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1878 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1879 var
1880   i: Integer;
1881 begin
1882   result := false;
1883   for i := 0 to high(r1.arr) do
1884     if (r1.arr[i] <> r2.arr[i]) then
1885       exit;
1886   result := true;
1887 end;
1888
1889 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1890 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1891 var
1892   i: Integer;
1893 begin
1894   result := false;
1895   for i := 0 to high(r1.arr) do
1896     if (r1.arr[i] <> r2.arr[i]) then
1897       exit;
1898   result := true;
1899 end;
1900
1901 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1902 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1903 var
1904   desc: TFormatDescriptor;
1905   p, tmp: PByte;
1906   x, y, i: Integer;
1907   md: Pointer;
1908   px: TglBitmapPixelData;
1909 begin
1910   result := nil;
1911   desc := TFormatDescriptor.Get(aFormat);
1912   if (desc.IsCompressed) or (desc.glFormat = 0) then
1913     exit;
1914
1915   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1916   md := desc.CreateMappingData;
1917   try
1918     tmp := p;
1919     desc.PreparePixel(px);
1920     for y := 0 to 4 do
1921       for x := 0 to 4 do begin
1922         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1923         for i := 0 to 3 do begin
1924           if ((y < 3) and (y = i)) or
1925              ((y = 3) and (i < 3)) or
1926              ((y = 4) and (i = 3))
1927           then
1928             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1929           else if ((y < 4) and (i = 3)) or
1930                   ((y = 4) and (i < 3))
1931           then
1932             px.Data.arr[i] := px.Range.arr[i]
1933           else
1934             px.Data.arr[i] := 0; //px.Range.arr[i];
1935         end;
1936         desc.Map(px, tmp, md);
1937       end;
1938   finally
1939     desc.FreeMappingData(md);
1940   end;
1941
1942   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1943   result.FreeDataOnDestroy       := true;
1944   result.FreeDataAfterGenTexture := false;
1945   result.SetFilter(GL_NEAREST, GL_NEAREST);
1946 end;
1947
1948 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1950 begin
1951   result.r := r;
1952   result.g := g;
1953   result.b := b;
1954   result.a := a;
1955 end;
1956
1957 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1958 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1959 begin
1960   result := [];
1961
1962   if (aFormat in [
1963         //8bpp
1964         tfAlpha4ub1, tfAlpha8ub1,
1965         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1966
1967         //16bpp
1968         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1969         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1970         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1971
1972         //24bpp
1973         tfBGR8ub3, tfRGB8ub3,
1974
1975         //32bpp
1976         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1977         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1978   then
1979     result := result + [ ftBMP ];
1980
1981   if (aFormat in [
1982         //8bbp
1983         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1984
1985         //16bbp
1986         tfAlpha16us1, tfLuminance16us1,
1987         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1988         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1989
1990         //24bbp
1991         tfBGR8ub3,
1992
1993         //32bbp
1994         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1995         tfDepth24ui1, tfDepth32ui1])
1996   then
1997     result := result + [ftTGA];
1998
1999   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2000     result := result + [ftDDS];
2001
2002 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2003   if aFormat in [
2004       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2005       tfRGB8ub3, tfRGBA8ui1,
2006       tfBGR8ub3, tfBGRA8ui1] then
2007     result := result + [ftPNG];
2008 {$ENDIF}
2009
2010 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2011   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2012     result := result + [ftJPEG];
2013 {$ENDIF}
2014 end;
2015
2016 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2017 function IsPowerOfTwo(aNumber: Integer): Boolean;
2018 begin
2019   while (aNumber and 1) = 0 do
2020     aNumber := aNumber shr 1;
2021   result := aNumber = 1;
2022 end;
2023
2024 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2025 function GetTopMostBit(aBitSet: QWord): Integer;
2026 begin
2027   result := 0;
2028   while aBitSet > 0 do begin
2029     inc(result);
2030     aBitSet := aBitSet shr 1;
2031   end;
2032 end;
2033
2034 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2035 function CountSetBits(aBitSet: QWord): Integer;
2036 begin
2037   result := 0;
2038   while aBitSet > 0 do begin
2039     if (aBitSet and 1) = 1 then
2040       inc(result);
2041     aBitSet := aBitSet shr 1;
2042   end;
2043 end;
2044
2045 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2046 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2047 begin
2048   result := Trunc(
2049     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2050     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2051     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2052 end;
2053
2054 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2055 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2056 begin
2057   result := Trunc(
2058     DEPTH_WEIGHT_R * aPixel.Data.r +
2059     DEPTH_WEIGHT_G * aPixel.Data.g +
2060     DEPTH_WEIGHT_B * aPixel.Data.b);
2061 end;
2062
2063 {$IFDEF GLB_SDL_IMAGE}
2064 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2065 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2066 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2067 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2068 begin
2069   result := TStream(context^.unknown.data1).Seek(offset, whence);
2070 end;
2071
2072 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2073 begin
2074   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2075 end;
2076
2077 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2078 begin
2079   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2080 end;
2081
2082 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2083 begin
2084   result := 0;
2085 end;
2086
2087 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2088 begin
2089   result := SDL_AllocRW;
2090
2091   if result = nil then
2092     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2093
2094   result^.seek := glBitmapRWseek;
2095   result^.read := glBitmapRWread;
2096   result^.write := glBitmapRWwrite;
2097   result^.close := glBitmapRWclose;
2098   result^.unknown.data1 := Stream;
2099 end;
2100 {$ENDIF}
2101
2102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2103 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2104 begin
2105   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2106 end;
2107
2108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2109 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2110 begin
2111   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2112 end;
2113
2114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2115 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2116 begin
2117   glBitmapDefaultMipmap := aValue;
2118 end;
2119
2120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2122 begin
2123   glBitmapDefaultFormat := aFormat;
2124 end;
2125
2126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2127 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2128 begin
2129   glBitmapDefaultFilterMin := aMin;
2130   glBitmapDefaultFilterMag := aMag;
2131 end;
2132
2133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2134 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2135 begin
2136   glBitmapDefaultWrapS := S;
2137   glBitmapDefaultWrapT := T;
2138   glBitmapDefaultWrapR := R;
2139 end;
2140
2141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2142 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2143 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2144 begin
2145   glDefaultSwizzle[0] := r;
2146   glDefaultSwizzle[1] := g;
2147   glDefaultSwizzle[2] := b;
2148   glDefaultSwizzle[3] := a;
2149 end;
2150 {$IFEND}
2151
2152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2153 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2154 begin
2155   result := glBitmapDefaultDeleteTextureOnFree;
2156 end;
2157
2158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2159 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2160 begin
2161   result := glBitmapDefaultFreeDataAfterGenTextures;
2162 end;
2163
2164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2165 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2166 begin
2167   result := glBitmapDefaultMipmap;
2168 end;
2169
2170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2171 function glBitmapGetDefaultFormat: TglBitmapFormat;
2172 begin
2173   result := glBitmapDefaultFormat;
2174 end;
2175
2176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2177 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2178 begin
2179   aMin := glBitmapDefaultFilterMin;
2180   aMag := glBitmapDefaultFilterMag;
2181 end;
2182
2183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2184 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2185 begin
2186   S := glBitmapDefaultWrapS;
2187   T := glBitmapDefaultWrapT;
2188   R := glBitmapDefaultWrapR;
2189 end;
2190
2191 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2193 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2194 begin
2195   r := glDefaultSwizzle[0];
2196   g := glDefaultSwizzle[1];
2197   b := glDefaultSwizzle[2];
2198   a := glDefaultSwizzle[3];
2199 end;
2200 {$ENDIF}
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2205 function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
2206 var
2207   w, h: Integer;
2208 begin
2209   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2210     w := Max(1, aSize.X);
2211     h := Max(1, aSize.Y);
2212     result := GetSize(w, h);
2213   end else
2214     result := 0;
2215 end;
2216
2217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2218 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2219 begin
2220   result := 0;
2221   if (aWidth <= 0) or (aHeight <= 0) then
2222     exit;
2223   result := Ceil(aWidth * aHeight * BytesPerPixel);
2224 end;
2225
2226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2227 function TFormatDescriptor.CreateMappingData: Pointer;
2228 begin
2229   result := nil;
2230 end;
2231
2232 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2233 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2234 begin
2235   //DUMMY
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 function TFormatDescriptor.IsEmpty: Boolean;
2240 begin
2241   result := (fFormat = tfEmpty);
2242 end;
2243
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2246 var
2247   i: Integer;
2248   m: TglBitmapRec4ul;
2249 begin
2250   result := false;
2251   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2252     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2253   m := Mask;
2254   for i := 0 to 3 do
2255     if (aMask.arr[i] <> m.arr[i]) then
2256       exit;
2257   result := true;
2258 end;
2259
2260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2261 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2262 begin
2263   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2264   aPixel.Data   := Range;
2265   aPixel.Format := fFormat;
2266   aPixel.Range  := Range;
2267 end;
2268
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 constructor TFormatDescriptor.Create;
2271 begin
2272   inherited Create;
2273 end;
2274
2275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2276 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2278 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2279 begin
2280   aData^ := aPixel.Data.a;
2281   inc(aData);
2282 end;
2283
2284 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2285 begin
2286   aPixel.Data.r := 0;
2287   aPixel.Data.g := 0;
2288   aPixel.Data.b := 0;
2289   aPixel.Data.a := aData^;
2290   inc(aData);
2291 end;
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2297 begin
2298   aData^ := LuminanceWeight(aPixel);
2299   inc(aData);
2300 end;
2301
2302 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2303 begin
2304   aPixel.Data.r := aData^;
2305   aPixel.Data.g := aData^;
2306   aPixel.Data.b := aData^;
2307   aPixel.Data.a := 0;
2308   inc(aData);
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2314 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2315 var
2316   i: Integer;
2317 begin
2318   aData^ := 0;
2319   for i := 0 to 3 do
2320     if (Range.arr[i] > 0) then
2321       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2322   inc(aData);
2323 end;
2324
2325 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2326 var
2327   i: Integer;
2328 begin
2329   for i := 0 to 3 do
2330     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2331   inc(aData);
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2337 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2338 begin
2339   inherited Map(aPixel, aData, aMapData);
2340   aData^ := aPixel.Data.a;
2341   inc(aData);
2342 end;
2343
2344 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2345 begin
2346   inherited Unmap(aData, aPixel, aMapData);
2347   aPixel.Data.a := aData^;
2348   inc(aData);
2349 end;
2350
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2355 begin
2356   aData^ := aPixel.Data.r;
2357   inc(aData);
2358   aData^ := aPixel.Data.g;
2359   inc(aData);
2360   aData^ := aPixel.Data.b;
2361   inc(aData);
2362 end;
2363
2364 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2365 begin
2366   aPixel.Data.r := aData^;
2367   inc(aData);
2368   aPixel.Data.g := aData^;
2369   inc(aData);
2370   aPixel.Data.b := aData^;
2371   inc(aData);
2372   aPixel.Data.a := 0;
2373 end;
2374
2375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2379 begin
2380   aData^ := aPixel.Data.b;
2381   inc(aData);
2382   aData^ := aPixel.Data.g;
2383   inc(aData);
2384   aData^ := aPixel.Data.r;
2385   inc(aData);
2386 end;
2387
2388 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2389 begin
2390   aPixel.Data.b := aData^;
2391   inc(aData);
2392   aPixel.Data.g := aData^;
2393   inc(aData);
2394   aPixel.Data.r := aData^;
2395   inc(aData);
2396   aPixel.Data.a := 0;
2397 end;
2398
2399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2400 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2403 begin
2404   inherited Map(aPixel, aData, aMapData);
2405   aData^ := aPixel.Data.a;
2406   inc(aData);
2407 end;
2408
2409 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2410 begin
2411   inherited Unmap(aData, aPixel, aMapData);
2412   aPixel.Data.a := aData^;
2413   inc(aData);
2414 end;
2415
2416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2417 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2420 begin
2421   inherited Map(aPixel, aData, aMapData);
2422   aData^ := aPixel.Data.a;
2423   inc(aData);
2424 end;
2425
2426 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2427 begin
2428   inherited Unmap(aData, aPixel, aMapData);
2429   aPixel.Data.a := aData^;
2430   inc(aData);
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2436 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2437 begin
2438   PWord(aData)^ := aPixel.Data.a;
2439   inc(aData, 2);
2440 end;
2441
2442 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2443 begin
2444   aPixel.Data.r := 0;
2445   aPixel.Data.g := 0;
2446   aPixel.Data.b := 0;
2447   aPixel.Data.a := PWord(aData)^;
2448   inc(aData, 2);
2449 end;
2450
2451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2452 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2455 begin
2456   PWord(aData)^ := LuminanceWeight(aPixel);
2457   inc(aData, 2);
2458 end;
2459
2460 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2461 begin
2462   aPixel.Data.r := PWord(aData)^;
2463   aPixel.Data.g := PWord(aData)^;
2464   aPixel.Data.b := PWord(aData)^;
2465   aPixel.Data.a := 0;
2466   inc(aData, 2);
2467 end;
2468
2469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2470 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2473 var
2474   i: Integer;
2475 begin
2476   PWord(aData)^ := 0;
2477   for i := 0 to 3 do
2478     if (Range.arr[i] > 0) then
2479       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2480   inc(aData, 2);
2481 end;
2482
2483 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2484 var
2485   i: Integer;
2486 begin
2487   for i := 0 to 3 do
2488     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2489   inc(aData, 2);
2490 end;
2491
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2495 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2496 begin
2497   PWord(aData)^ := DepthWeight(aPixel);
2498   inc(aData, 2);
2499 end;
2500
2501 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2502 begin
2503   aPixel.Data.r := PWord(aData)^;
2504   aPixel.Data.g := PWord(aData)^;
2505   aPixel.Data.b := PWord(aData)^;
2506   aPixel.Data.a := PWord(aData)^;;
2507   inc(aData, 2);
2508 end;
2509
2510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2511 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2513 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2514 begin
2515   inherited Map(aPixel, aData, aMapData);
2516   PWord(aData)^ := aPixel.Data.a;
2517   inc(aData, 2);
2518 end;
2519
2520 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2521 begin
2522   inherited Unmap(aData, aPixel, aMapData);
2523   aPixel.Data.a := PWord(aData)^;
2524   inc(aData, 2);
2525 end;
2526
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2531 begin
2532   PWord(aData)^ := aPixel.Data.r;
2533   inc(aData, 2);
2534   PWord(aData)^ := aPixel.Data.g;
2535   inc(aData, 2);
2536   PWord(aData)^ := aPixel.Data.b;
2537   inc(aData, 2);
2538 end;
2539
2540 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2541 begin
2542   aPixel.Data.r := PWord(aData)^;
2543   inc(aData, 2);
2544   aPixel.Data.g := PWord(aData)^;
2545   inc(aData, 2);
2546   aPixel.Data.b := PWord(aData)^;
2547   inc(aData, 2);
2548   aPixel.Data.a := 0;
2549 end;
2550
2551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2552 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2555 begin
2556   PWord(aData)^ := aPixel.Data.b;
2557   inc(aData, 2);
2558   PWord(aData)^ := aPixel.Data.g;
2559   inc(aData, 2);
2560   PWord(aData)^ := aPixel.Data.r;
2561   inc(aData, 2);
2562 end;
2563
2564 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2565 begin
2566   aPixel.Data.b := PWord(aData)^;
2567   inc(aData, 2);
2568   aPixel.Data.g := PWord(aData)^;
2569   inc(aData, 2);
2570   aPixel.Data.r := PWord(aData)^;
2571   inc(aData, 2);
2572   aPixel.Data.a := 0;
2573 end;
2574
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2579 begin
2580   inherited Map(aPixel, aData, aMapData);
2581   PWord(aData)^ := aPixel.Data.a;
2582   inc(aData, 2);
2583 end;
2584
2585 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2586 begin
2587   inherited Unmap(aData, aPixel, aMapData);
2588   aPixel.Data.a := PWord(aData)^;
2589   inc(aData, 2);
2590 end;
2591
2592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2593 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2594 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2595 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2596 begin
2597   PWord(aData)^ := aPixel.Data.a;
2598   inc(aData, 2);
2599   inherited Map(aPixel, aData, aMapData);
2600 end;
2601
2602 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2603 begin
2604   aPixel.Data.a := PWord(aData)^;
2605   inc(aData, 2);
2606   inherited Unmap(aData, aPixel, aMapData);
2607 end;
2608
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2613 begin
2614   inherited Map(aPixel, aData, aMapData);
2615   PWord(aData)^ := aPixel.Data.a;
2616   inc(aData, 2);
2617 end;
2618
2619 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2620 begin
2621   inherited Unmap(aData, aPixel, aMapData);
2622   aPixel.Data.a := PWord(aData)^;
2623   inc(aData, 2);
2624 end;
2625
2626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2627 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2629 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2630 begin
2631   PWord(aData)^ := aPixel.Data.a;
2632   inc(aData, 2);
2633   inherited Map(aPixel, aData, aMapData);
2634 end;
2635
2636 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2637 begin
2638   aPixel.Data.a := PWord(aData)^;
2639   inc(aData, 2);
2640   inherited Unmap(aData, aPixel, aMapData);
2641 end;
2642
2643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2647 var
2648   i: Integer;
2649 begin
2650   PCardinal(aData)^ := 0;
2651   for i := 0 to 3 do
2652     if (Range.arr[i] > 0) then
2653       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2654   inc(aData, 4);
2655 end;
2656
2657 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2658 var
2659   i: Integer;
2660 begin
2661   for i := 0 to 3 do
2662     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2663   inc(aData, 2);
2664 end;
2665
2666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2669 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2670 begin
2671   PCardinal(aData)^ := DepthWeight(aPixel);
2672   inc(aData, 4);
2673 end;
2674
2675 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2676 begin
2677   aPixel.Data.r := PCardinal(aData)^;
2678   aPixel.Data.g := PCardinal(aData)^;
2679   aPixel.Data.b := PCardinal(aData)^;
2680   aPixel.Data.a := PCardinal(aData)^;
2681   inc(aData, 4);
2682 end;
2683
2684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 procedure TfdAlpha4ub1.SetValues;
2688 begin
2689   inherited SetValues;
2690   fBitsPerPixel     := 8;
2691   fFormat           := tfAlpha4ub1;
2692   fWithAlpha        := tfAlpha4ub1;
2693   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2694   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2695 {$IFNDEF OPENGL_ES}
2696   fOpenGLFormat     := tfAlpha4ub1;
2697   fglFormat         := GL_ALPHA;
2698   fglInternalFormat := GL_ALPHA4;
2699   fglDataFormat     := GL_UNSIGNED_BYTE;
2700 {$ELSE}
2701   fOpenGLFormat     := tfAlpha8ub1;
2702 {$ENDIF}
2703 end;
2704
2705 procedure TfdAlpha8ub1.SetValues;
2706 begin
2707   inherited SetValues;
2708   fBitsPerPixel     := 8;
2709   fFormat           := tfAlpha8ub1;
2710   fWithAlpha        := tfAlpha8ub1;
2711   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2712   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2713   fOpenGLFormat     := tfAlpha8ub1;
2714   fglFormat         := GL_ALPHA;
2715   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2716   fglDataFormat     := GL_UNSIGNED_BYTE;
2717 end;
2718
2719 procedure TfdAlpha16us1.SetValues;
2720 begin
2721   inherited SetValues;
2722   fBitsPerPixel     := 16;
2723   fFormat           := tfAlpha16us1;
2724   fWithAlpha        := tfAlpha16us1;
2725   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2726   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2727 {$IFNDEF OPENGL_ES}
2728   fOpenGLFormat     := tfAlpha16us1;
2729   fglFormat         := GL_ALPHA;
2730   fglInternalFormat := GL_ALPHA16;
2731   fglDataFormat     := GL_UNSIGNED_SHORT;
2732 {$ELSE}
2733   fOpenGLFormat     := tfAlpha8ub1;
2734 {$ENDIF}
2735 end;
2736
2737 procedure TfdLuminance4ub1.SetValues;
2738 begin
2739   inherited SetValues;
2740   fBitsPerPixel     := 8;
2741   fFormat           := tfLuminance4ub1;
2742   fWithAlpha        := tfLuminance4Alpha4ub2;
2743   fWithoutAlpha     := tfLuminance4ub1;
2744   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2745   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2746 {$IFNDEF OPENGL_ES}
2747   fOpenGLFormat     := tfLuminance4ub1;
2748   fglFormat         := GL_LUMINANCE;
2749   fglInternalFormat := GL_LUMINANCE4;
2750   fglDataFormat     := GL_UNSIGNED_BYTE;
2751 {$ELSE}
2752   fOpenGLFormat     := tfLuminance8ub1;
2753 {$ENDIF}
2754 end;
2755
2756 procedure TfdLuminance8ub1.SetValues;
2757 begin
2758   inherited SetValues;
2759   fBitsPerPixel     := 8;
2760   fFormat           := tfLuminance8ub1;
2761   fWithAlpha        := tfLuminance8Alpha8ub2;
2762   fWithoutAlpha     := tfLuminance8ub1;
2763   fOpenGLFormat     := tfLuminance8ub1;
2764   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2765   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2766   fglFormat         := GL_LUMINANCE;
2767   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2768   fglDataFormat     := GL_UNSIGNED_BYTE;
2769 end;
2770
2771 procedure TfdLuminance16us1.SetValues;
2772 begin
2773   inherited SetValues;
2774   fBitsPerPixel     := 16;
2775   fFormat           := tfLuminance16us1;
2776   fWithAlpha        := tfLuminance16Alpha16us2;
2777   fWithoutAlpha     := tfLuminance16us1;
2778   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2779   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2780 {$IFNDEF OPENGL_ES}
2781   fOpenGLFormat     := tfLuminance16us1;
2782   fglFormat         := GL_LUMINANCE;
2783   fglInternalFormat := GL_LUMINANCE16;
2784   fglDataFormat     := GL_UNSIGNED_SHORT;
2785 {$ELSE}
2786   fOpenGLFormat     := tfLuminance8ub1;
2787 {$ENDIF}
2788 end;
2789
2790 procedure TfdLuminance4Alpha4ub2.SetValues;
2791 begin
2792   inherited SetValues;
2793   fBitsPerPixel     := 16;
2794   fFormat           := tfLuminance4Alpha4ub2;
2795   fWithAlpha        := tfLuminance4Alpha4ub2;
2796   fWithoutAlpha     := tfLuminance4ub1;
2797   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2798   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2799 {$IFNDEF OPENGL_ES}
2800   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2801   fglFormat         := GL_LUMINANCE_ALPHA;
2802   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2803   fglDataFormat     := GL_UNSIGNED_BYTE;
2804 {$ELSE}
2805   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2806 {$ENDIF}
2807 end;
2808
2809 procedure TfdLuminance6Alpha2ub2.SetValues;
2810 begin
2811   inherited SetValues;
2812   fBitsPerPixel     := 16;
2813   fFormat           := tfLuminance6Alpha2ub2;
2814   fWithAlpha        := tfLuminance6Alpha2ub2;
2815   fWithoutAlpha     := tfLuminance8ub1;
2816   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2817   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2818 {$IFNDEF OPENGL_ES}
2819   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2820   fglFormat         := GL_LUMINANCE_ALPHA;
2821   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2822   fglDataFormat     := GL_UNSIGNED_BYTE;
2823 {$ELSE}
2824   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2825 {$ENDIF}
2826 end;
2827
2828 procedure TfdLuminance8Alpha8ub2.SetValues;
2829 begin
2830   inherited SetValues;
2831   fBitsPerPixel     := 16;
2832   fFormat           := tfLuminance8Alpha8ub2;
2833   fWithAlpha        := tfLuminance8Alpha8ub2;
2834   fWithoutAlpha     := tfLuminance8ub1;
2835   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2836   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2837   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2838   fglFormat         := GL_LUMINANCE_ALPHA;
2839   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2840   fglDataFormat     := GL_UNSIGNED_BYTE;
2841 end;
2842
2843 procedure TfdLuminance12Alpha4us2.SetValues;
2844 begin
2845   inherited SetValues;
2846   fBitsPerPixel     := 32;
2847   fFormat           := tfLuminance12Alpha4us2;
2848   fWithAlpha        := tfLuminance12Alpha4us2;
2849   fWithoutAlpha     := tfLuminance16us1;
2850   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2851   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2852 {$IFNDEF OPENGL_ES}
2853   fOpenGLFormat     := tfLuminance12Alpha4us2;
2854   fglFormat         := GL_LUMINANCE_ALPHA;
2855   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2856   fglDataFormat     := GL_UNSIGNED_SHORT;
2857 {$ELSE}
2858   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2859 {$ENDIF}
2860 end;
2861
2862 procedure TfdLuminance16Alpha16us2.SetValues;
2863 begin
2864   inherited SetValues;
2865   fBitsPerPixel     := 32;
2866   fFormat           := tfLuminance16Alpha16us2;
2867   fWithAlpha        := tfLuminance16Alpha16us2;
2868   fWithoutAlpha     := tfLuminance16us1;
2869   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2870   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2871 {$IFNDEF OPENGL_ES}
2872   fOpenGLFormat     := tfLuminance16Alpha16us2;
2873   fglFormat         := GL_LUMINANCE_ALPHA;
2874   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2875   fglDataFormat     := GL_UNSIGNED_SHORT;
2876 {$ELSE}
2877   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2878 {$ENDIF}
2879 end;
2880
2881 procedure TfdR3G3B2ub1.SetValues;
2882 begin
2883   inherited SetValues;
2884   fBitsPerPixel     := 8;
2885   fFormat           := tfR3G3B2ub1;
2886   fWithAlpha        := tfRGBA4us1;
2887   fWithoutAlpha     := tfR3G3B2ub1;
2888   fRGBInverted      := tfEmpty;
2889   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2890   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2891 {$IFNDEF OPENGL_ES}
2892   fOpenGLFormat     := tfR3G3B2ub1;
2893   fglFormat         := GL_RGB;
2894   fglInternalFormat := GL_R3_G3_B2;
2895   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2896 {$ELSE}
2897   fOpenGLFormat     := tfR5G6B5us1;
2898 {$ENDIF}
2899 end;
2900
2901 procedure TfdRGBX4us1.SetValues;
2902 begin
2903   inherited SetValues;
2904   fBitsPerPixel     := 16;
2905   fFormat           := tfRGBX4us1;
2906   fWithAlpha        := tfRGBA4us1;
2907   fWithoutAlpha     := tfRGBX4us1;
2908   fRGBInverted      := tfBGRX4us1;
2909   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2910   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2911 {$IFNDEF OPENGL_ES}
2912   fOpenGLFormat     := tfRGBX4us1;
2913   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2914   fglInternalFormat := GL_RGB4;
2915   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2916 {$ELSE}
2917   fOpenGLFormat     := tfR5G6B5us1;
2918 {$ENDIF}
2919 end;
2920
2921 procedure TfdXRGB4us1.SetValues;
2922 begin
2923   inherited SetValues;
2924   fBitsPerPixel     := 16;
2925   fFormat           := tfXRGB4us1;
2926   fWithAlpha        := tfARGB4us1;
2927   fWithoutAlpha     := tfXRGB4us1;
2928   fRGBInverted      := tfXBGR4us1;
2929   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2930   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2931 {$IFNDEF OPENGL_ES}
2932   fOpenGLFormat     := tfXRGB4us1;
2933   fglFormat         := GL_BGRA;
2934   fglInternalFormat := GL_RGB4;
2935   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2936 {$ELSE}
2937   fOpenGLFormat     := tfR5G6B5us1;
2938 {$ENDIF}
2939 end;
2940
2941 procedure TfdR5G6B5us1.SetValues;
2942 begin
2943   inherited SetValues;
2944   fBitsPerPixel     := 16;
2945   fFormat           := tfR5G6B5us1;
2946   fWithAlpha        := tfRGB5A1us1;
2947   fWithoutAlpha     := tfR5G6B5us1;
2948   fRGBInverted      := tfB5G6R5us1;
2949   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2950   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2951 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2952   fOpenGLFormat     := tfR5G6B5us1;
2953   fglFormat         := GL_RGB;
2954   fglInternalFormat := GL_RGB565;
2955   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2956 {$ELSE}
2957   fOpenGLFormat     := tfRGB8ub3;
2958 {$IFEND}
2959 end;
2960
2961 procedure TfdRGB5X1us1.SetValues;
2962 begin
2963   inherited SetValues;
2964   fBitsPerPixel     := 16;
2965   fFormat           := tfRGB5X1us1;
2966   fWithAlpha        := tfRGB5A1us1;
2967   fWithoutAlpha     := tfRGB5X1us1;
2968   fRGBInverted      := tfBGR5X1us1;
2969   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2970   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2971 {$IFNDEF OPENGL_ES}
2972   fOpenGLFormat     := tfRGB5X1us1;
2973   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2974   fglInternalFormat := GL_RGB5;
2975   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2976 {$ELSE}
2977   fOpenGLFormat     := tfR5G6B5us1;
2978 {$ENDIF}
2979 end;
2980
2981 procedure TfdX1RGB5us1.SetValues;
2982 begin
2983   inherited SetValues;
2984   fBitsPerPixel     := 16;
2985   fFormat           := tfX1RGB5us1;
2986   fWithAlpha        := tfA1RGB5us1;
2987   fWithoutAlpha     := tfX1RGB5us1;
2988   fRGBInverted      := tfX1BGR5us1;
2989   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2990   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2991 {$IFNDEF OPENGL_ES}
2992   fOpenGLFormat     := tfX1RGB5us1;
2993   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2994   fglInternalFormat := GL_RGB5;
2995   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2996 {$ELSE}
2997   fOpenGLFormat     := tfR5G6B5us1;
2998 {$ENDIF}
2999 end;
3000
3001 procedure TfdRGB8ub3.SetValues;
3002 begin
3003   inherited SetValues;
3004   fBitsPerPixel     := 24;
3005   fFormat           := tfRGB8ub3;
3006   fWithAlpha        := tfRGBA8ub4;
3007   fWithoutAlpha     := tfRGB8ub3;
3008   fRGBInverted      := tfBGR8ub3;
3009   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3010   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3011   fOpenGLFormat     := tfRGB8ub3;
3012   fglFormat         := GL_RGB;
3013   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
3014   fglDataFormat     := GL_UNSIGNED_BYTE;
3015 end;
3016
3017 procedure TfdRGBX8ui1.SetValues;
3018 begin
3019   inherited SetValues;
3020   fBitsPerPixel     := 32;
3021   fFormat           := tfRGBX8ui1;
3022   fWithAlpha        := tfRGBA8ui1;
3023   fWithoutAlpha     := tfRGBX8ui1;
3024   fRGBInverted      := tfBGRX8ui1;
3025   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3026   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3027 {$IFNDEF OPENGL_ES}
3028   fOpenGLFormat     := tfRGBX8ui1;
3029   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3030   fglInternalFormat := GL_RGB8;
3031   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3032 {$ELSE}
3033   fOpenGLFormat     := tfRGB8ub3;
3034 {$ENDIF}
3035 end;
3036
3037 procedure TfdXRGB8ui1.SetValues;
3038 begin
3039   inherited SetValues;
3040   fBitsPerPixel     := 32;
3041   fFormat           := tfXRGB8ui1;
3042   fWithAlpha        := tfXRGB8ui1;
3043   fWithoutAlpha     := tfXRGB8ui1;
3044   fOpenGLFormat     := tfXRGB8ui1;
3045   fRGBInverted      := tfXBGR8ui1;
3046   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3047   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3048 {$IFNDEF OPENGL_ES}
3049   fOpenGLFormat     := tfXRGB8ui1;
3050   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3051   fglInternalFormat := GL_RGB8;
3052   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3053 {$ELSE}
3054   fOpenGLFormat     := tfRGB8ub3;
3055 {$ENDIF}
3056 end;
3057
3058 procedure TfdRGB10X2ui1.SetValues;
3059 begin
3060   inherited SetValues;
3061   fBitsPerPixel     := 32;
3062   fFormat           := tfRGB10X2ui1;
3063   fWithAlpha        := tfRGB10A2ui1;
3064   fWithoutAlpha     := tfRGB10X2ui1;
3065   fRGBInverted      := tfBGR10X2ui1;
3066   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3067   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3068 {$IFNDEF OPENGL_ES}
3069   fOpenGLFormat     := tfRGB10X2ui1;
3070   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3071   fglInternalFormat := GL_RGB10;
3072   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3073 {$ELSE}
3074   fOpenGLFormat     := tfRGB16us3;
3075 {$ENDIF}
3076 end;
3077
3078 procedure TfdX2RGB10ui1.SetValues;
3079 begin
3080   inherited SetValues;
3081   fBitsPerPixel     := 32;
3082   fFormat           := tfX2RGB10ui1;
3083   fWithAlpha        := tfA2RGB10ui1;
3084   fWithoutAlpha     := tfX2RGB10ui1;
3085   fRGBInverted      := tfX2BGR10ui1;
3086   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3087   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3088 {$IFNDEF OPENGL_ES}
3089   fOpenGLFormat     := tfX2RGB10ui1;
3090   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3091   fglInternalFormat := GL_RGB10;
3092   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3093 {$ELSE}
3094   fOpenGLFormat     := tfRGB16us3;
3095 {$ENDIF}
3096 end;
3097
3098 procedure TfdRGB16us3.SetValues;
3099 begin
3100   inherited SetValues;
3101   fBitsPerPixel     := 48;
3102   fFormat           := tfRGB16us3;
3103   fWithAlpha        := tfRGBA16us4;
3104   fWithoutAlpha     := tfRGB16us3;
3105   fRGBInverted      := tfBGR16us3;
3106   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3107   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3108 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3109   fOpenGLFormat     := tfRGB16us3;
3110   fglFormat         := GL_RGB;
3111   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3112   fglDataFormat     := GL_UNSIGNED_SHORT;
3113 {$ELSE}
3114   fOpenGLFormat     := tfRGB8ub3;
3115 {$IFEND}
3116 end;
3117
3118 procedure TfdRGBA4us1.SetValues;
3119 begin
3120   inherited SetValues;
3121   fBitsPerPixel     := 16;
3122   fFormat           := tfRGBA4us1;
3123   fWithAlpha        := tfRGBA4us1;
3124   fWithoutAlpha     := tfRGBX4us1;
3125   fOpenGLFormat     := tfRGBA4us1;
3126   fRGBInverted      := tfBGRA4us1;
3127   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3128   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3129   fglFormat         := GL_RGBA;
3130   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3131   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3132 end;
3133
3134 procedure TfdARGB4us1.SetValues;
3135 begin
3136   inherited SetValues;
3137   fBitsPerPixel     := 16;
3138   fFormat           := tfARGB4us1;
3139   fWithAlpha        := tfARGB4us1;
3140   fWithoutAlpha     := tfXRGB4us1;
3141   fRGBInverted      := tfABGR4us1;
3142   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3143   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3144 {$IFNDEF OPENGL_ES}
3145   fOpenGLFormat     := tfARGB4us1;
3146   fglFormat         := GL_BGRA;
3147   fglInternalFormat := GL_RGBA4;
3148   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3149 {$ELSE}
3150   fOpenGLFormat     := tfRGBA4us1;
3151 {$ENDIF}
3152 end;
3153
3154 procedure TfdRGB5A1us1.SetValues;
3155 begin
3156   inherited SetValues;
3157   fBitsPerPixel     := 16;
3158   fFormat           := tfRGB5A1us1;
3159   fWithAlpha        := tfRGB5A1us1;
3160   fWithoutAlpha     := tfRGB5X1us1;
3161   fOpenGLFormat     := tfRGB5A1us1;
3162   fRGBInverted      := tfBGR5A1us1;
3163   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3164   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3165   fglFormat         := GL_RGBA;
3166   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3167   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3168 end;
3169
3170 procedure TfdA1RGB5us1.SetValues;
3171 begin
3172   inherited SetValues;
3173   fBitsPerPixel     := 16;
3174   fFormat           := tfA1RGB5us1;
3175   fWithAlpha        := tfA1RGB5us1;
3176   fWithoutAlpha     := tfX1RGB5us1;
3177   fRGBInverted      := tfA1BGR5us1;
3178   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3179   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3180 {$IFNDEF OPENGL_ES}
3181   fOpenGLFormat     := tfA1RGB5us1;
3182   fglFormat         := GL_BGRA;
3183   fglInternalFormat := GL_RGB5_A1;
3184   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3185 {$ELSE}
3186   fOpenGLFormat     := tfRGB5A1us1;
3187 {$ENDIF}
3188 end;
3189
3190 procedure TfdRGBA8ui1.SetValues;
3191 begin
3192   inherited SetValues;
3193   fBitsPerPixel     := 32;
3194   fFormat           := tfRGBA8ui1;
3195   fWithAlpha        := tfRGBA8ui1;
3196   fWithoutAlpha     := tfRGBX8ui1;
3197   fRGBInverted      := tfBGRA8ui1;
3198   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3199   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3200 {$IFNDEF OPENGL_ES}
3201   fOpenGLFormat     := tfRGBA8ui1;
3202   fglFormat         := GL_RGBA;
3203   fglInternalFormat := GL_RGBA8;
3204   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3205 {$ELSE}
3206   fOpenGLFormat     := tfRGBA8ub4;
3207 {$ENDIF}
3208 end;
3209
3210 procedure TfdARGB8ui1.SetValues;
3211 begin
3212   inherited SetValues;
3213   fBitsPerPixel     := 32;
3214   fFormat           := tfARGB8ui1;
3215   fWithAlpha        := tfARGB8ui1;
3216   fWithoutAlpha     := tfXRGB8ui1;
3217   fRGBInverted      := tfABGR8ui1;
3218   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3219   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3220 {$IFNDEF OPENGL_ES}
3221   fOpenGLFormat     := tfARGB8ui1;
3222   fglFormat         := GL_BGRA;
3223   fglInternalFormat := GL_RGBA8;
3224   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3225 {$ELSE}
3226   fOpenGLFormat     := tfRGBA8ub4;
3227 {$ENDIF}
3228 end;
3229
3230 procedure TfdRGBA8ub4.SetValues;
3231 begin
3232   inherited SetValues;
3233   fBitsPerPixel     := 32;
3234   fFormat           := tfRGBA8ub4;
3235   fWithAlpha        := tfRGBA8ub4;
3236   fWithoutAlpha     := tfRGB8ub3;
3237   fOpenGLFormat     := tfRGBA8ub4;
3238   fRGBInverted      := tfBGRA8ub4;
3239   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3240   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3241   fglFormat         := GL_RGBA;
3242   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3243   fglDataFormat     := GL_UNSIGNED_BYTE;
3244 end;
3245
3246 procedure TfdRGB10A2ui1.SetValues;
3247 begin
3248   inherited SetValues;
3249   fBitsPerPixel     := 32;
3250   fFormat           := tfRGB10A2ui1;
3251   fWithAlpha        := tfRGB10A2ui1;
3252   fWithoutAlpha     := tfRGB10X2ui1;
3253   fRGBInverted      := tfBGR10A2ui1;
3254   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3255   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3256 {$IFNDEF OPENGL_ES}
3257   fOpenGLFormat     := tfRGB10A2ui1;
3258   fglFormat         := GL_RGBA;
3259   fglInternalFormat := GL_RGB10_A2;
3260   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3261 {$ELSE}
3262   fOpenGLFormat     := tfA2RGB10ui1;
3263 {$ENDIF}
3264 end;
3265
3266 procedure TfdA2RGB10ui1.SetValues;
3267 begin
3268   inherited SetValues;
3269   fBitsPerPixel     := 32;
3270   fFormat           := tfA2RGB10ui1;
3271   fWithAlpha        := tfA2RGB10ui1;
3272   fWithoutAlpha     := tfX2RGB10ui1;
3273   fRGBInverted      := tfA2BGR10ui1;
3274   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3275   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3276 {$IF NOT DEFINED(OPENGL_ES)}
3277   fOpenGLFormat     := tfA2RGB10ui1;
3278   fglFormat         := GL_BGRA;
3279   fglInternalFormat := GL_RGB10_A2;
3280   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3281 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3282   fOpenGLFormat     := tfA2RGB10ui1;
3283   fglFormat         := GL_RGBA;
3284   fglInternalFormat := GL_RGB10_A2;
3285   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3286 {$ELSE}
3287   fOpenGLFormat     := tfRGBA8ui1;
3288 {$IFEND}
3289 end;
3290
3291 procedure TfdRGBA16us4.SetValues;
3292 begin
3293   inherited SetValues;
3294   fBitsPerPixel     := 64;
3295   fFormat           := tfRGBA16us4;
3296   fWithAlpha        := tfRGBA16us4;
3297   fWithoutAlpha     := tfRGB16us3;
3298   fRGBInverted      := tfBGRA16us4;
3299   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3300   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3301 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3302   fOpenGLFormat     := tfRGBA16us4;
3303   fglFormat         := GL_RGBA;
3304   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3305   fglDataFormat     := GL_UNSIGNED_SHORT;
3306 {$ELSE}
3307   fOpenGLFormat     := tfRGBA8ub4;
3308 {$IFEND}
3309 end;
3310
3311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3314 procedure TfdBGRX4us1.SetValues;
3315 begin
3316   inherited SetValues;
3317   fBitsPerPixel     := 16;
3318   fFormat           := tfBGRX4us1;
3319   fWithAlpha        := tfBGRA4us1;
3320   fWithoutAlpha     := tfBGRX4us1;
3321   fRGBInverted      := tfRGBX4us1;
3322   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3323   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3324 {$IFNDEF OPENGL_ES}
3325   fOpenGLFormat     := tfBGRX4us1;
3326   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3327   fglInternalFormat := GL_RGB4;
3328   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3329 {$ELSE}
3330   fOpenGLFormat     := tfR5G6B5us1;
3331 {$ENDIF}
3332 end;
3333
3334 procedure TfdXBGR4us1.SetValues;
3335 begin
3336   inherited SetValues;
3337   fBitsPerPixel     := 16;
3338   fFormat           := tfXBGR4us1;
3339   fWithAlpha        := tfABGR4us1;
3340   fWithoutAlpha     := tfXBGR4us1;
3341   fRGBInverted      := tfXRGB4us1;
3342   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3343   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3344 {$IFNDEF OPENGL_ES}
3345   fOpenGLFormat     := tfXBGR4us1;
3346   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3347   fglInternalFormat := GL_RGB4;
3348   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3349 {$ELSE}
3350   fOpenGLFormat     := tfR5G6B5us1;
3351 {$ENDIF}
3352 end;
3353
3354 procedure TfdB5G6R5us1.SetValues;
3355 begin
3356   inherited SetValues;
3357   fBitsPerPixel     := 16;
3358   fFormat           := tfB5G6R5us1;
3359   fWithAlpha        := tfBGR5A1us1;
3360   fWithoutAlpha     := tfB5G6R5us1;
3361   fRGBInverted      := tfR5G6B5us1;
3362   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3363   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3364 {$IFNDEF OPENGL_ES}
3365   fOpenGLFormat     := tfB5G6R5us1;
3366   fglFormat         := GL_RGB;
3367   fglInternalFormat := GL_RGB565;
3368   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3369 {$ELSE}
3370   fOpenGLFormat     := tfR5G6B5us1;
3371 {$ENDIF}
3372 end;
3373
3374 procedure TfdBGR5X1us1.SetValues;
3375 begin
3376   inherited SetValues;
3377   fBitsPerPixel     := 16;
3378   fFormat           := tfBGR5X1us1;
3379   fWithAlpha        := tfBGR5A1us1;
3380   fWithoutAlpha     := tfBGR5X1us1;
3381   fRGBInverted      := tfRGB5X1us1;
3382   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3383   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3384 {$IFNDEF OPENGL_ES}
3385   fOpenGLFormat     := tfBGR5X1us1;
3386   fglFormat         := GL_BGRA;
3387   fglInternalFormat := GL_RGB5;
3388   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3389 {$ELSE}
3390   fOpenGLFormat     := tfR5G6B5us1;
3391 {$ENDIF}
3392 end;
3393
3394 procedure TfdX1BGR5us1.SetValues;
3395 begin
3396   inherited SetValues;
3397   fBitsPerPixel     := 16;
3398   fFormat           := tfX1BGR5us1;
3399   fWithAlpha        := tfA1BGR5us1;
3400   fWithoutAlpha     := tfX1BGR5us1;
3401   fRGBInverted      := tfX1RGB5us1;
3402   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3403   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3404 {$IFNDEF OPENGL_ES}
3405   fOpenGLFormat     := tfX1BGR5us1;
3406   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3407   fglInternalFormat := GL_RGB5;
3408   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3409 {$ELSE}
3410   fOpenGLFormat     := tfR5G6B5us1;
3411 {$ENDIF}
3412 end;
3413
3414 procedure TfdBGR8ub3.SetValues;
3415 begin
3416   inherited SetValues;
3417   fBitsPerPixel     := 24;
3418   fFormat           := tfBGR8ub3;
3419   fWithAlpha        := tfBGRA8ub4;
3420   fWithoutAlpha     := tfBGR8ub3;
3421   fRGBInverted      := tfRGB8ub3;
3422   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3423   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3424 {$IFNDEF OPENGL_ES}
3425   fOpenGLFormat     := tfBGR8ub3;
3426   fglFormat         := GL_BGR;
3427   fglInternalFormat := GL_RGB8;
3428   fglDataFormat     := GL_UNSIGNED_BYTE;
3429 {$ELSE}
3430   fOpenGLFormat     := tfRGB8ub3;
3431 {$ENDIF}
3432 end;
3433
3434 procedure TfdBGRX8ui1.SetValues;
3435 begin
3436   inherited SetValues;
3437   fBitsPerPixel     := 32;
3438   fFormat           := tfBGRX8ui1;
3439   fWithAlpha        := tfBGRA8ui1;
3440   fWithoutAlpha     := tfBGRX8ui1;
3441   fRGBInverted      := tfRGBX8ui1;
3442   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3443   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3444 {$IFNDEF OPENGL_ES}
3445   fOpenGLFormat     := tfBGRX8ui1;
3446   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3447   fglInternalFormat := GL_RGB8;
3448   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3449 {$ELSE}
3450   fOpenGLFormat     := tfRGB8ub3;
3451 {$ENDIF}
3452 end;
3453
3454 procedure TfdXBGR8ui1.SetValues;
3455 begin
3456   inherited SetValues;
3457   fBitsPerPixel     := 32;
3458   fFormat           := tfXBGR8ui1;
3459   fWithAlpha        := tfABGR8ui1;
3460   fWithoutAlpha     := tfXBGR8ui1;
3461   fRGBInverted      := tfXRGB8ui1;
3462   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3463   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3464 {$IFNDEF OPENGL_ES}
3465   fOpenGLFormat     := tfXBGR8ui1;
3466   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3467   fglInternalFormat := GL_RGB8;
3468   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3469 {$ELSE}
3470   fOpenGLFormat     := tfRGB8ub3;
3471 {$ENDIF}
3472 end;
3473
3474 procedure TfdBGR10X2ui1.SetValues;
3475 begin
3476   inherited SetValues;
3477   fBitsPerPixel     := 32;
3478   fFormat           := tfBGR10X2ui1;
3479   fWithAlpha        := tfBGR10A2ui1;
3480   fWithoutAlpha     := tfBGR10X2ui1;
3481   fRGBInverted      := tfRGB10X2ui1;
3482   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3483   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3484 {$IFNDEF OPENGL_ES}
3485   fOpenGLFormat     := tfBGR10X2ui1;
3486   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3487   fglInternalFormat := GL_RGB10;
3488   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3489 {$ELSE}
3490   fOpenGLFormat     := tfRGB16us3;
3491 {$ENDIF}
3492 end;
3493
3494 procedure TfdX2BGR10ui1.SetValues;
3495 begin
3496   inherited SetValues;
3497   fBitsPerPixel     := 32;
3498   fFormat           := tfX2BGR10ui1;
3499   fWithAlpha        := tfA2BGR10ui1;
3500   fWithoutAlpha     := tfX2BGR10ui1;
3501   fRGBInverted      := tfX2RGB10ui1;
3502   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3503   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3504 {$IFNDEF OPENGL_ES}
3505   fOpenGLFormat     := tfX2BGR10ui1;
3506   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3507   fglInternalFormat := GL_RGB10;
3508   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3509 {$ELSE}
3510   fOpenGLFormat     := tfRGB16us3;
3511 {$ENDIF}
3512 end;
3513
3514 procedure TfdBGR16us3.SetValues;
3515 begin
3516   inherited SetValues;
3517   fBitsPerPixel     := 48;
3518   fFormat           := tfBGR16us3;
3519   fWithAlpha        := tfBGRA16us4;
3520   fWithoutAlpha     := tfBGR16us3;
3521   fRGBInverted      := tfRGB16us3;
3522   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3523   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3524 {$IFNDEF OPENGL_ES}
3525   fOpenGLFormat     := tfBGR16us3;
3526   fglFormat         := GL_BGR;
3527   fglInternalFormat := GL_RGB16;
3528   fglDataFormat     := GL_UNSIGNED_SHORT;
3529 {$ELSE}
3530   fOpenGLFormat     := tfRGB16us3;
3531 {$ENDIF}
3532 end;
3533
3534 procedure TfdBGRA4us1.SetValues;
3535 begin
3536   inherited SetValues;
3537   fBitsPerPixel     := 16;
3538   fFormat           := tfBGRA4us1;
3539   fWithAlpha        := tfBGRA4us1;
3540   fWithoutAlpha     := tfBGRX4us1;
3541   fRGBInverted      := tfRGBA4us1;
3542   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3543   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3544 {$IFNDEF OPENGL_ES}
3545   fOpenGLFormat     := tfBGRA4us1;
3546   fglFormat         := GL_BGRA;
3547   fglInternalFormat := GL_RGBA4;
3548   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3549 {$ELSE}
3550   fOpenGLFormat     := tfRGBA4us1;
3551 {$ENDIF}
3552 end;
3553
3554 procedure TfdABGR4us1.SetValues;
3555 begin
3556   inherited SetValues;
3557   fBitsPerPixel     := 16;
3558   fFormat           := tfABGR4us1;
3559   fWithAlpha        := tfABGR4us1;
3560   fWithoutAlpha     := tfXBGR4us1;
3561   fRGBInverted      := tfARGB4us1;
3562   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3563   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3564 {$IFNDEF OPENGL_ES}
3565   fOpenGLFormat     := tfABGR4us1;
3566   fglFormat         := GL_RGBA;
3567   fglInternalFormat := GL_RGBA4;
3568   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3569 {$ELSE}
3570   fOpenGLFormat     := tfRGBA4us1;
3571 {$ENDIF}
3572 end;
3573
3574 procedure TfdBGR5A1us1.SetValues;
3575 begin
3576   inherited SetValues;
3577   fBitsPerPixel     := 16;
3578   fFormat           := tfBGR5A1us1;
3579   fWithAlpha        := tfBGR5A1us1;
3580   fWithoutAlpha     := tfBGR5X1us1;
3581   fRGBInverted      := tfRGB5A1us1;
3582   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3583   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3584 {$IFNDEF OPENGL_ES}
3585   fOpenGLFormat     := tfBGR5A1us1;
3586   fglFormat         := GL_BGRA;
3587   fglInternalFormat := GL_RGB5_A1;
3588   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3589 {$ELSE}
3590   fOpenGLFormat     := tfRGB5A1us1;
3591 {$ENDIF}
3592 end;
3593
3594 procedure TfdA1BGR5us1.SetValues;
3595 begin
3596   inherited SetValues;
3597   fBitsPerPixel     := 16;
3598   fFormat           := tfA1BGR5us1;
3599   fWithAlpha        := tfA1BGR5us1;
3600   fWithoutAlpha     := tfX1BGR5us1;
3601   fRGBInverted      := tfA1RGB5us1;
3602   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3603   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3604 {$IFNDEF OPENGL_ES}
3605   fOpenGLFormat     := tfA1BGR5us1;
3606   fglFormat         := GL_RGBA;
3607   fglInternalFormat := GL_RGB5_A1;
3608   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3609 {$ELSE}
3610   fOpenGLFormat     := tfRGB5A1us1;
3611 {$ENDIF}
3612 end;
3613
3614 procedure TfdBGRA8ui1.SetValues;
3615 begin
3616   inherited SetValues;
3617   fBitsPerPixel     := 32;
3618   fFormat           := tfBGRA8ui1;
3619   fWithAlpha        := tfBGRA8ui1;
3620   fWithoutAlpha     := tfBGRX8ui1;
3621   fRGBInverted      := tfRGBA8ui1;
3622   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3623   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3624 {$IFNDEF OPENGL_ES}
3625   fOpenGLFormat     := tfBGRA8ui1;
3626   fglFormat         := GL_BGRA;
3627   fglInternalFormat := GL_RGBA8;
3628   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3629 {$ELSE}
3630   fOpenGLFormat     := tfRGBA8ub4;
3631 {$ENDIF}
3632 end;
3633
3634 procedure TfdABGR8ui1.SetValues;
3635 begin
3636   inherited SetValues;
3637   fBitsPerPixel     := 32;
3638   fFormat           := tfABGR8ui1;
3639   fWithAlpha        := tfABGR8ui1;
3640   fWithoutAlpha     := tfXBGR8ui1;
3641   fRGBInverted      := tfARGB8ui1;
3642   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3643   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3644 {$IFNDEF OPENGL_ES}
3645   fOpenGLFormat     := tfABGR8ui1;
3646   fglFormat         := GL_RGBA;
3647   fglInternalFormat := GL_RGBA8;
3648   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3649 {$ELSE}
3650   fOpenGLFormat     := tfRGBA8ub4
3651 {$ENDIF}
3652 end;
3653
3654 procedure TfdBGRA8ub4.SetValues;
3655 begin
3656   inherited SetValues;
3657   fBitsPerPixel     := 32;
3658   fFormat           := tfBGRA8ub4;
3659   fWithAlpha        := tfBGRA8ub4;
3660   fWithoutAlpha     := tfBGR8ub3;
3661   fRGBInverted      := tfRGBA8ub4;
3662   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3663   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3664 {$IFNDEF OPENGL_ES}
3665   fOpenGLFormat     := tfBGRA8ub4;
3666   fglFormat         := GL_BGRA;
3667   fglInternalFormat := GL_RGBA8;
3668   fglDataFormat     := GL_UNSIGNED_BYTE;
3669 {$ELSE}
3670   fOpenGLFormat     := tfRGBA8ub4;
3671 {$ENDIF}
3672 end;
3673
3674 procedure TfdBGR10A2ui1.SetValues;
3675 begin
3676   inherited SetValues;
3677   fBitsPerPixel     := 32;
3678   fFormat           := tfBGR10A2ui1;
3679   fWithAlpha        := tfBGR10A2ui1;
3680   fWithoutAlpha     := tfBGR10X2ui1;
3681   fRGBInverted      := tfRGB10A2ui1;
3682   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3683   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3684 {$IFNDEF OPENGL_ES}
3685   fOpenGLFormat     := tfBGR10A2ui1;
3686   fglFormat         := GL_BGRA;
3687   fglInternalFormat := GL_RGB10_A2;
3688   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3689 {$ELSE}
3690   fOpenGLFormat     := tfA2RGB10ui1;
3691 {$ENDIF}
3692 end;
3693
3694 procedure TfdA2BGR10ui1.SetValues;
3695 begin
3696   inherited SetValues;
3697   fBitsPerPixel     := 32;
3698   fFormat           := tfA2BGR10ui1;
3699   fWithAlpha        := tfA2BGR10ui1;
3700   fWithoutAlpha     := tfX2BGR10ui1;
3701   fRGBInverted      := tfA2RGB10ui1;
3702   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3703   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3704 {$IFNDEF OPENGL_ES}
3705   fOpenGLFormat     := tfA2BGR10ui1;
3706   fglFormat         := GL_RGBA;
3707   fglInternalFormat := GL_RGB10_A2;
3708   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3709 {$ELSE}
3710   fOpenGLFormat     := tfA2RGB10ui1;
3711 {$ENDIF}
3712 end;
3713
3714 procedure TfdBGRA16us4.SetValues;
3715 begin
3716   inherited SetValues;
3717   fBitsPerPixel     := 64;
3718   fFormat           := tfBGRA16us4;
3719   fWithAlpha        := tfBGRA16us4;
3720   fWithoutAlpha     := tfBGR16us3;
3721   fRGBInverted      := tfRGBA16us4;
3722   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3723   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3724 {$IFNDEF OPENGL_ES}
3725   fOpenGLFormat     := tfBGRA16us4;
3726   fglFormat         := GL_BGRA;
3727   fglInternalFormat := GL_RGBA16;
3728   fglDataFormat     := GL_UNSIGNED_SHORT;
3729 {$ELSE}
3730   fOpenGLFormat     := tfRGBA16us4;
3731 {$ENDIF}
3732 end;
3733
3734 procedure TfdDepth16us1.SetValues;
3735 begin
3736   inherited SetValues;
3737   fBitsPerPixel     := 16;
3738   fFormat           := tfDepth16us1;
3739   fWithoutAlpha     := tfDepth16us1;
3740   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3741   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3742 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3743   fOpenGLFormat     := tfDepth16us1;
3744   fglFormat         := GL_DEPTH_COMPONENT;
3745   fglInternalFormat := GL_DEPTH_COMPONENT16;
3746   fglDataFormat     := GL_UNSIGNED_SHORT;
3747 {$IFEND}
3748 end;
3749
3750 procedure TfdDepth24ui1.SetValues;
3751 begin
3752   inherited SetValues;
3753   fBitsPerPixel     := 32;
3754   fFormat           := tfDepth24ui1;
3755   fWithoutAlpha     := tfDepth24ui1;
3756   fOpenGLFormat     := tfDepth24ui1;
3757   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3758   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3759 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3760   fOpenGLFormat     := tfDepth24ui1;
3761   fglFormat         := GL_DEPTH_COMPONENT;
3762   fglInternalFormat := GL_DEPTH_COMPONENT24;
3763   fglDataFormat     := GL_UNSIGNED_INT;
3764 {$IFEND}
3765 end;
3766
3767 procedure TfdDepth32ui1.SetValues;
3768 begin
3769   inherited SetValues;
3770   fBitsPerPixel     := 32;
3771   fFormat           := tfDepth32ui1;
3772   fWithoutAlpha     := tfDepth32ui1;
3773   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3774   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3775 {$IF NOT DEFINED(OPENGL_ES)}
3776   fOpenGLFormat     := tfDepth32ui1;
3777   fglFormat         := GL_DEPTH_COMPONENT;
3778   fglInternalFormat := GL_DEPTH_COMPONENT32;
3779   fglDataFormat     := GL_UNSIGNED_INT;
3780 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3781   fOpenGLFormat     := tfDepth24ui1;
3782 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3783   fOpenGLFormat     := tfDepth16us1;
3784 {$IFEND}
3785 end;
3786
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3790 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3791 begin
3792   raise EglBitmap.Create('mapping for compressed formats is not supported');
3793 end;
3794
3795 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3796 begin
3797   raise EglBitmap.Create('mapping for compressed formats is not supported');
3798 end;
3799
3800 procedure TfdS3tcDtx1RGBA.SetValues;
3801 begin
3802   inherited SetValues;
3803   fFormat           := tfS3tcDtx1RGBA;
3804   fWithAlpha        := tfS3tcDtx1RGBA;
3805   fUncompressed     := tfRGB5A1us1;
3806   fBitsPerPixel     := 4;
3807   fIsCompressed     := true;
3808 {$IFNDEF OPENGL_ES}
3809   fOpenGLFormat     := tfS3tcDtx1RGBA;
3810   fglFormat         := GL_COMPRESSED_RGBA;
3811   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3812   fglDataFormat     := GL_UNSIGNED_BYTE;
3813 {$ELSE}
3814   fOpenGLFormat     := fUncompressed;
3815 {$ENDIF}
3816 end;
3817
3818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3819 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3821 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3822 begin
3823   raise EglBitmap.Create('mapping for compressed formats is not supported');
3824 end;
3825
3826 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3827 begin
3828   raise EglBitmap.Create('mapping for compressed formats is not supported');
3829 end;
3830
3831 procedure TfdS3tcDtx3RGBA.SetValues;
3832 begin
3833   inherited SetValues;
3834   fFormat           := tfS3tcDtx3RGBA;
3835   fWithAlpha        := tfS3tcDtx3RGBA;
3836   fUncompressed     := tfRGBA8ub4;
3837   fBitsPerPixel     := 8;
3838   fIsCompressed     := true;
3839 {$IFNDEF OPENGL_ES}
3840   fOpenGLFormat     := tfS3tcDtx3RGBA;
3841   fglFormat         := GL_COMPRESSED_RGBA;
3842   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3843   fglDataFormat     := GL_UNSIGNED_BYTE;
3844 {$ELSE}
3845   fOpenGLFormat     := fUncompressed;
3846 {$ENDIF}
3847 end;
3848
3849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3850 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3852 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3853 begin
3854   raise EglBitmap.Create('mapping for compressed formats is not supported');
3855 end;
3856
3857 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3858 begin
3859   raise EglBitmap.Create('mapping for compressed formats is not supported');
3860 end;
3861
3862 procedure TfdS3tcDtx5RGBA.SetValues;
3863 begin
3864   inherited SetValues;
3865   fFormat           := tfS3tcDtx3RGBA;
3866   fWithAlpha        := tfS3tcDtx3RGBA;
3867   fUncompressed     := tfRGBA8ub4;
3868   fBitsPerPixel     := 8;
3869   fIsCompressed     := true;
3870 {$IFNDEF OPENGL_ES}
3871   fOpenGLFormat     := tfS3tcDtx3RGBA;
3872   fglFormat         := GL_COMPRESSED_RGBA;
3873   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3874   fglDataFormat     := GL_UNSIGNED_BYTE;
3875 {$ELSE}
3876   fOpenGLFormat     := fUncompressed;
3877 {$ENDIF}
3878 end;
3879
3880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3881 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3884 begin
3885   result := (fPrecision.r > 0);
3886 end;
3887
3888 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3889 begin
3890   result := (fPrecision.g > 0);
3891 end;
3892
3893 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3894 begin
3895   result := (fPrecision.b > 0);
3896 end;
3897
3898 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3899 begin
3900   result := (fPrecision.a > 0);
3901 end;
3902
3903 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3904 begin
3905   result := HasRed or HasGreen or HasBlue;
3906 end;
3907
3908 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3909 begin
3910   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3911 end;
3912
3913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3914 procedure TglBitmapFormatDescriptor.SetValues;
3915 begin
3916   fFormat       := tfEmpty;
3917   fWithAlpha    := tfEmpty;
3918   fWithoutAlpha := tfEmpty;
3919   fOpenGLFormat := tfEmpty;
3920   fRGBInverted  := tfEmpty;
3921   fUncompressed := tfEmpty;
3922
3923   fBitsPerPixel := 0;
3924   fIsCompressed := false;
3925
3926   fglFormat         := 0;
3927   fglInternalFormat := 0;
3928   fglDataFormat     := 0;
3929
3930   FillChar(fPrecision, 0, SizeOf(fPrecision));
3931   FillChar(fShift,     0, SizeOf(fShift));
3932 end;
3933
3934 procedure TglBitmapFormatDescriptor.CalcValues;
3935 var
3936   i: Integer;
3937 begin
3938   fBytesPerPixel := fBitsPerPixel / 8;
3939   fChannelCount  := 0;
3940   for i := 0 to 3 do begin
3941     if (fPrecision.arr[i] > 0) then
3942       inc(fChannelCount);
3943     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3944     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3945   end;
3946 end;
3947
3948 constructor TglBitmapFormatDescriptor.Create;
3949 begin
3950   inherited Create;
3951   SetValues;
3952   CalcValues;
3953 end;
3954
3955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3957 var
3958   f: TglBitmapFormat;
3959 begin
3960   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3961     result := TFormatDescriptor.Get(f);
3962     if (result.glInternalFormat = aInternalFormat) then
3963       exit;
3964   end;
3965   result := TFormatDescriptor.Get(tfEmpty);
3966 end;
3967
3968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3969 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3971 class procedure TFormatDescriptor.Init;
3972 begin
3973   if not Assigned(FormatDescriptorCS) then
3974     FormatDescriptorCS := TCriticalSection.Create;
3975 end;
3976
3977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3978 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3979 begin
3980   FormatDescriptorCS.Enter;
3981   try
3982     result := FormatDescriptors[aFormat];
3983     if not Assigned(result) then begin
3984       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3985       FormatDescriptors[aFormat] := result;
3986     end;
3987   finally
3988     FormatDescriptorCS.Leave;
3989   end;
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3994 begin
3995   result := Get(Get(aFormat).WithAlpha);
3996 end;
3997
3998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3999 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4000 var
4001   ft: TglBitmapFormat;
4002 begin
4003   // find matching format with OpenGL support
4004   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4005     result := Get(ft);
4006     if (result.MaskMatch(aMask))      and
4007        (result.glFormat <> 0)         and
4008        (result.glInternalFormat <> 0) and
4009        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4010     then
4011       exit;
4012   end;
4013
4014   // find matching format without OpenGL Support
4015   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4016     result := Get(ft);
4017     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4018       exit;
4019   end;
4020
4021   result := TFormatDescriptor.Get(tfEmpty);
4022 end;
4023
4024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4025 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4026 var
4027   ft: TglBitmapFormat;
4028 begin
4029   // find matching format with OpenGL support
4030   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4031     result := Get(ft);
4032     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4033        glBitmapRec4ubCompare(result.Precision, aPrec) and
4034        (result.glFormat <> 0)         and
4035        (result.glInternalFormat <> 0) and
4036        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4037     then
4038       exit;
4039   end;
4040
4041   // find matching format without OpenGL Support
4042   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4043     result := Get(ft);
4044     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4045        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4046        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4047       exit;
4048   end;
4049
4050   result := TFormatDescriptor.Get(tfEmpty);
4051 end;
4052
4053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4054 class procedure TFormatDescriptor.Clear;
4055 var
4056   f: TglBitmapFormat;
4057 begin
4058   FormatDescriptorCS.Enter;
4059   try
4060     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4061       FreeAndNil(FormatDescriptors[f]);
4062   finally
4063     FormatDescriptorCS.Leave;
4064   end;
4065 end;
4066
4067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4068 class procedure TFormatDescriptor.Finalize;
4069 begin
4070   Clear;
4071   FreeAndNil(FormatDescriptorCS);
4072 end;
4073
4074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4075 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4077 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4078 var
4079   i: Integer;
4080 begin
4081   for i := 0 to 3 do begin
4082     fShift.arr[i] := 0;
4083     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4084       aMask.arr[i] := aMask.arr[i] shr 1;
4085       inc(fShift.arr[i]);
4086     end;
4087     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4088   end;
4089   CalcValues;
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4094 begin
4095   fBitsPerPixel := aBBP;
4096   fPrecision    := aPrec;
4097   fShift        := aShift;
4098   CalcValues;
4099 end;
4100
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4103 var
4104   data: QWord;
4105 begin
4106   data :=
4107     ((aPixel.Data.r and Range.r) shl Shift.r) or
4108     ((aPixel.Data.g and Range.g) shl Shift.g) or
4109     ((aPixel.Data.b and Range.b) shl Shift.b) or
4110     ((aPixel.Data.a and Range.a) shl Shift.a);
4111   case BitsPerPixel of
4112     8:           aData^  := data;
4113    16:     PWord(aData)^ := data;
4114    32: PCardinal(aData)^ := data;
4115    64:    PQWord(aData)^ := data;
4116   else
4117     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4118   end;
4119   inc(aData, Round(BytesPerPixel));
4120 end;
4121
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4124 var
4125   data: QWord;
4126   i: Integer;
4127 begin
4128   case BitsPerPixel of
4129      8: data :=           aData^;
4130     16: data :=     PWord(aData)^;
4131     32: data := PCardinal(aData)^;
4132     64: data :=    PQWord(aData)^;
4133   else
4134     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4135   end;
4136   for i := 0 to 3 do
4137     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4138   inc(aData, Round(BytesPerPixel));
4139 end;
4140
4141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4142 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4144 procedure TbmpColorTableFormat.SetValues;
4145 begin
4146   inherited SetValues;
4147   fShift := glBitmapRec4ub(8, 8, 8, 0);
4148 end;
4149
4150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4151 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4152 begin
4153   fFormat       := aFormat;
4154   fBitsPerPixel := aBPP;
4155   fPrecision    := aPrec;
4156   fShift        := aShift;
4157   CalcValues;
4158 end;
4159
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 procedure TbmpColorTableFormat.CalcValues;
4162 begin
4163   inherited CalcValues;
4164 end;
4165
4166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4167 procedure TbmpColorTableFormat.CreateColorTable;
4168 var
4169   i: Integer;
4170 begin
4171   SetLength(fColorTable, 256);
4172   if not HasColor then begin
4173     // alpha
4174     for i := 0 to High(fColorTable) do begin
4175       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4176       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4177       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4178       fColorTable[i].a := 0;
4179     end;
4180   end else begin
4181     // normal
4182     for i := 0 to High(fColorTable) do begin
4183       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4184       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4185       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4186       fColorTable[i].a := 0;
4187     end;
4188   end;
4189 end;
4190
4191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4192 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4193 begin
4194   if (BitsPerPixel <> 8) then
4195     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4196   if not HasColor then
4197     // alpha
4198     aData^ := aPixel.Data.a
4199   else
4200     // normal
4201     aData^ := Round(
4202       ((aPixel.Data.r and Range.r) shl Shift.r) or
4203       ((aPixel.Data.g and Range.g) shl Shift.g) or
4204       ((aPixel.Data.b and Range.b) shl Shift.b));
4205   inc(aData);
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4210 begin
4211   if (BitsPerPixel <> 8) then
4212     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4213   with fColorTable[aData^] do begin
4214     aPixel.Data.r := r;
4215     aPixel.Data.g := g;
4216     aPixel.Data.b := b;
4217     aPixel.Data.a := a;
4218   end;
4219   inc(aData, 1);
4220 end;
4221
4222 destructor TbmpColorTableFormat.Destroy;
4223 begin
4224   SetLength(fColorTable, 0);
4225   inherited Destroy;
4226 end;
4227
4228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4229 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4231 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4232 var
4233   i: Integer;
4234 begin
4235   for i := 0 to 3 do begin
4236     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4237       if (aSourceFD.Range.arr[i] > 0) then
4238         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4239       else
4240         aPixel.Data.arr[i] := 0;
4241     end;
4242   end;
4243 end;
4244
4245 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4246 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4247 begin
4248   with aFuncRec do begin
4249     if (Source.Range.r   > 0) then
4250       Dest.Data.r := Source.Data.r;
4251     if (Source.Range.g > 0) then
4252       Dest.Data.g := Source.Data.g;
4253     if (Source.Range.b  > 0) then
4254       Dest.Data.b := Source.Data.b;
4255     if (Source.Range.a > 0) then
4256       Dest.Data.a := Source.Data.a;
4257   end;
4258 end;
4259
4260 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4261 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4262 var
4263   i: Integer;
4264 begin
4265   with aFuncRec do begin
4266     for i := 0 to 3 do
4267       if (Source.Range.arr[i] > 0) then
4268         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4269   end;
4270 end;
4271
4272 type
4273   TShiftData = packed record
4274     case Integer of
4275       0: (r, g, b, a: SmallInt);
4276       1: (arr: array[0..3] of SmallInt);
4277   end;
4278   PShiftData = ^TShiftData;
4279
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4282 var
4283   i: Integer;
4284 begin
4285   with aFuncRec do
4286     for i := 0 to 3 do
4287       if (Source.Range.arr[i] > 0) then
4288         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4289 end;
4290
4291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4292 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4293 begin
4294   with aFuncRec do begin
4295     Dest.Data := Source.Data;
4296     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4297       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4298       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4299       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4300     end;
4301     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4302       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4303     end;
4304   end;
4305 end;
4306
4307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4308 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4309 var
4310   i: Integer;
4311 begin
4312   with aFuncRec do begin
4313     for i := 0 to 3 do
4314       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4315   end;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4320 var
4321   Temp: Single;
4322 begin
4323   with FuncRec do begin
4324     if (FuncRec.Args = nil) then begin //source has no alpha
4325       Temp :=
4326         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4327         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4328         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4329       Dest.Data.a := Round(Dest.Range.a * Temp);
4330     end else
4331       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4332   end;
4333 end;
4334
4335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4336 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4337 type
4338   PglBitmapPixelData = ^TglBitmapPixelData;
4339 begin
4340   with FuncRec do begin
4341     Dest.Data.r := Source.Data.r;
4342     Dest.Data.g := Source.Data.g;
4343     Dest.Data.b := Source.Data.b;
4344
4345     with PglBitmapPixelData(Args)^ do
4346       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4347           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4348           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4349         Dest.Data.a := 0
4350       else
4351         Dest.Data.a := Dest.Range.a;
4352   end;
4353 end;
4354
4355 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4356 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4357 begin
4358   with FuncRec do begin
4359     Dest.Data.r := Source.Data.r;
4360     Dest.Data.g := Source.Data.g;
4361     Dest.Data.b := Source.Data.b;
4362     Dest.Data.a := PCardinal(Args)^;
4363   end;
4364 end;
4365
4366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4367 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4368 type
4369   PRGBPix = ^TRGBPix;
4370   TRGBPix = array [0..2] of byte;
4371 var
4372   Temp: Byte;
4373 begin
4374   while aWidth > 0 do begin
4375     Temp := PRGBPix(aData)^[0];
4376     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4377     PRGBPix(aData)^[2] := Temp;
4378
4379     if aHasAlpha then
4380       Inc(aData, 4)
4381     else
4382       Inc(aData, 3);
4383     dec(aWidth);
4384   end;
4385 end;
4386
4387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4388 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4390 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4391 begin
4392   result := TFormatDescriptor.Get(Format);
4393 end;
4394
4395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4396 function TglBitmap.GetWidth: Integer;
4397 begin
4398   if (ffX in fDimension.Fields) then
4399     result := fDimension.X
4400   else
4401     result := -1;
4402 end;
4403
4404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4405 function TglBitmap.GetHeight: Integer;
4406 begin
4407   if (ffY in fDimension.Fields) then
4408     result := fDimension.Y
4409   else
4410     result := -1;
4411 end;
4412
4413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4414 function TglBitmap.GetFileWidth: Integer;
4415 begin
4416   result := Max(1, Width);
4417 end;
4418
4419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4420 function TglBitmap.GetFileHeight: Integer;
4421 begin
4422   result := Max(1, Height);
4423 end;
4424
4425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4426 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4427 begin
4428   if fCustomData = aValue then
4429     exit;
4430   fCustomData := aValue;
4431 end;
4432
4433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4434 procedure TglBitmap.SetCustomName(const aValue: String);
4435 begin
4436   if fCustomName = aValue then
4437     exit;
4438   fCustomName := aValue;
4439 end;
4440
4441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4442 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4443 begin
4444   if fCustomNameW = aValue then
4445     exit;
4446   fCustomNameW := aValue;
4447 end;
4448
4449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4450 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4451 begin
4452   if fFreeDataOnDestroy = aValue then
4453     exit;
4454   fFreeDataOnDestroy := aValue;
4455 end;
4456
4457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4458 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4459 begin
4460   if fDeleteTextureOnFree = aValue then
4461     exit;
4462   fDeleteTextureOnFree := aValue;
4463 end;
4464
4465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4466 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4467 begin
4468   if fFormat = aValue then
4469     exit;
4470   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4471     raise EglBitmapUnsupportedFormat.Create(Format);
4472   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4473 end;
4474
4475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4476 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4477 begin
4478   if fFreeDataAfterGenTexture = aValue then
4479     exit;
4480   fFreeDataAfterGenTexture := aValue;
4481 end;
4482
4483 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4484 procedure TglBitmap.SetID(const aValue: Cardinal);
4485 begin
4486   if fID = aValue then
4487     exit;
4488   fID := aValue;
4489 end;
4490
4491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4492 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4493 begin
4494   if fMipMap = aValue then
4495     exit;
4496   fMipMap := aValue;
4497 end;
4498
4499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4500 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4501 begin
4502   if fTarget = aValue then
4503     exit;
4504   fTarget := aValue;
4505 end;
4506
4507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4508 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4509 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4510 var
4511   MaxAnisotropic: Integer;
4512 {$IFEND}
4513 begin
4514   fAnisotropic := aValue;
4515   if (ID > 0) then begin
4516 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4517     if GL_EXT_texture_filter_anisotropic then begin
4518       if fAnisotropic > 0 then begin
4519         Bind(false);
4520         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4521         if aValue > MaxAnisotropic then
4522           fAnisotropic := MaxAnisotropic;
4523         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4524       end;
4525     end else begin
4526       fAnisotropic := 0;
4527     end;
4528 {$ELSE}
4529     fAnisotropic := 0;
4530 {$IFEND}
4531   end;
4532 end;
4533
4534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4535 procedure TglBitmap.CreateID;
4536 begin
4537   if (ID <> 0) then
4538     glDeleteTextures(1, @fID);
4539   glGenTextures(1, @fID);
4540   Bind(false);
4541 end;
4542
4543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4544 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
4545 begin
4546   // Set Up Parameters
4547   SetWrap(fWrapS, fWrapT, fWrapR);
4548   SetFilter(fFilterMin, fFilterMag);
4549   SetAnisotropic(fAnisotropic);
4550
4551 {$IFNDEF OPENGL_ES}
4552   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4553   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4554     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4555 {$ENDIF}
4556
4557 {$IFNDEF OPENGL_ES}
4558   // Mip Maps Generation Mode
4559   aBuildWithGlu := false;
4560   if (MipMap = mmMipmap) then begin
4561     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4562       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4563     else
4564       aBuildWithGlu := true;
4565   end else if (MipMap = mmMipmapGlu) then
4566     aBuildWithGlu := true;
4567 {$ELSE}
4568   if (MipMap = mmMipmap) then
4569     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
4570 {$ENDIF}
4571 end;
4572
4573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4574 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4575   const aWidth: Integer; const aHeight: Integer);
4576 var
4577   s: Single;
4578 begin
4579   if (Data <> aData) then begin
4580     if (Assigned(Data)) then
4581       FreeMem(Data);
4582     fData := aData;
4583   end;
4584
4585   if not Assigned(fData) then begin
4586     fPixelSize := 0;
4587     fRowSize   := 0;
4588   end else begin
4589     FillChar(fDimension, SizeOf(fDimension), 0);
4590     if aWidth <> -1 then begin
4591       fDimension.Fields := fDimension.Fields + [ffX];
4592       fDimension.X := aWidth;
4593     end;
4594
4595     if aHeight <> -1 then begin
4596       fDimension.Fields := fDimension.Fields + [ffY];
4597       fDimension.Y := aHeight;
4598     end;
4599
4600     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4601     fFormat    := aFormat;
4602     fPixelSize := Ceil(s);
4603     fRowSize   := Ceil(s * aWidth);
4604   end;
4605 end;
4606
4607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4608 function TglBitmap.FlipHorz: Boolean;
4609 begin
4610   result := false;
4611 end;
4612
4613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4614 function TglBitmap.FlipVert: Boolean;
4615 begin
4616   result := false;
4617 end;
4618
4619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4620 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4622 procedure TglBitmap.AfterConstruction;
4623 begin
4624   inherited AfterConstruction;
4625
4626   fID         := 0;
4627   fTarget     := 0;
4628 {$IFNDEF OPENGL_ES}
4629   fIsResident := false;
4630 {$ENDIF}
4631
4632   fMipMap                  := glBitmapDefaultMipmap;
4633   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4634   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4635
4636   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4637   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4638 {$IFNDEF OPENGL_ES}
4639   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4640 {$ENDIF}
4641 end;
4642
4643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4644 procedure TglBitmap.BeforeDestruction;
4645 var
4646   NewData: PByte;
4647 begin
4648   if fFreeDataOnDestroy then begin
4649     NewData := nil;
4650     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4651   end;
4652   if (fID > 0) and fDeleteTextureOnFree then
4653     glDeleteTextures(1, @fID);
4654   inherited BeforeDestruction;
4655 end;
4656
4657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4658 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4659 var
4660   TempPos: Integer;
4661 begin
4662   if not Assigned(aResType) then begin
4663     TempPos   := Pos('.', aResource);
4664     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4665     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4666   end;
4667 end;
4668
4669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4670 procedure TglBitmap.LoadFromFile(const aFilename: String);
4671 var
4672   fs: TFileStream;
4673 begin
4674   if not FileExists(aFilename) then
4675     raise EglBitmap.Create('file does not exist: ' + aFilename);
4676   fFilename := aFilename;
4677   fs := TFileStream.Create(fFilename, fmOpenRead);
4678   try
4679     fs.Position := 0;
4680     LoadFromStream(fs);
4681   finally
4682     fs.Free;
4683   end;
4684 end;
4685
4686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4687 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4688 begin
4689   {$IFDEF GLB_SUPPORT_PNG_READ}
4690   if not LoadPNG(aStream) then
4691   {$ENDIF}
4692   {$IFDEF GLB_SUPPORT_JPEG_READ}
4693   if not LoadJPEG(aStream) then
4694   {$ENDIF}
4695   if not LoadDDS(aStream) then
4696   if not LoadTGA(aStream) then
4697   if not LoadBMP(aStream) then
4698   if not LoadRAW(aStream) then
4699     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4700 end;
4701
4702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4703 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
4704   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4705 var
4706   tmpData: PByte;
4707   size: Integer;
4708 begin
4709   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4710   GetMem(tmpData, size);
4711   try
4712     FillChar(tmpData^, size, #$FF);
4713     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4714   except
4715     if Assigned(tmpData) then
4716       FreeMem(tmpData);
4717     raise;
4718   end;
4719   Convert(Self, aFunc, false, aFormat, aArgs);
4720 end;
4721
4722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4723 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4724 var
4725   rs: TResourceStream;
4726 begin
4727   PrepareResType(aResource, aResType);
4728   rs := TResourceStream.Create(aInstance, aResource, aResType);
4729   try
4730     LoadFromStream(rs);
4731   finally
4732     rs.Free;
4733   end;
4734 end;
4735
4736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4737 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4738 var
4739   rs: TResourceStream;
4740 begin
4741   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4742   try
4743     LoadFromStream(rs);
4744   finally
4745     rs.Free;
4746   end;
4747 end;
4748
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
4751 var
4752   fs: TFileStream;
4753 begin
4754   fs := TFileStream.Create(aFileName, fmCreate);
4755   try
4756     fs.Position := 0;
4757     SaveToStream(fs, aFileType);
4758   finally
4759     fs.Free;
4760   end;
4761 end;
4762
4763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4764 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4765 begin
4766   case aFileType of
4767     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4768     ftPNG:  SavePNG(aStream);
4769     {$ENDIF}
4770     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4771     ftJPEG: SaveJPEG(aStream);
4772     {$ENDIF}
4773     ftDDS:  SaveDDS(aStream);
4774     ftTGA:  SaveTGA(aStream);
4775     ftBMP:  SaveBMP(aStream);
4776     ftRAW:  SaveRAW(aStream);
4777   end;
4778 end;
4779
4780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4781 function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4782 begin
4783   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
4784 end;
4785
4786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4787 function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4788   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4789 var
4790   DestData, TmpData, SourceData: pByte;
4791   TempHeight, TempWidth: Integer;
4792   SourceFD, DestFD: TFormatDescriptor;
4793   SourceMD, DestMD: Pointer;
4794
4795   FuncRec: TglBitmapFunctionRec;
4796 begin
4797   Assert(Assigned(Data));
4798   Assert(Assigned(aSource));
4799   Assert(Assigned(aSource.Data));
4800
4801   result := false;
4802   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4803     SourceFD := TFormatDescriptor.Get(aSource.Format);
4804     DestFD   := TFormatDescriptor.Get(aFormat);
4805
4806     if (SourceFD.IsCompressed) then
4807       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4808     if (DestFD.IsCompressed) then
4809       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4810
4811     // inkompatible Formats so CreateTemp
4812     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
4813       aCreateTemp := true;
4814
4815     // Values
4816     TempHeight := Max(1, aSource.Height);
4817     TempWidth  := Max(1, aSource.Width);
4818
4819     FuncRec.Sender := Self;
4820     FuncRec.Args   := aArgs;
4821
4822     TmpData := nil;
4823     if aCreateTemp then begin
4824       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4825       DestData := TmpData;
4826     end else
4827       DestData := Data;
4828
4829     try
4830       SourceFD.PreparePixel(FuncRec.Source);
4831       DestFD.PreparePixel  (FuncRec.Dest);
4832
4833       SourceMD := SourceFD.CreateMappingData;
4834       DestMD   := DestFD.CreateMappingData;
4835
4836       FuncRec.Size            := aSource.Dimension;
4837       FuncRec.Position.Fields := FuncRec.Size.Fields;
4838
4839       try
4840         SourceData := aSource.Data;
4841         FuncRec.Position.Y := 0;
4842         while FuncRec.Position.Y < TempHeight do begin
4843           FuncRec.Position.X := 0;
4844           while FuncRec.Position.X < TempWidth do begin
4845             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4846             aFunc(FuncRec);
4847             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4848             inc(FuncRec.Position.X);
4849           end;
4850           inc(FuncRec.Position.Y);
4851         end;
4852
4853         // Updating Image or InternalFormat
4854         if aCreateTemp then
4855           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4856         else if (aFormat <> fFormat) then
4857           Format := aFormat;
4858
4859         result := true;
4860       finally
4861         SourceFD.FreeMappingData(SourceMD);
4862         DestFD.FreeMappingData(DestMD);
4863       end;
4864     except
4865       if aCreateTemp and Assigned(TmpData) then
4866         FreeMem(TmpData);
4867       raise;
4868     end;
4869   end;
4870 end;
4871
4872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4873 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
4874 var
4875   SourceFD, DestFD: TFormatDescriptor;
4876   SourcePD, DestPD: TglBitmapPixelData;
4877   ShiftData: TShiftData;
4878
4879   function DataIsIdentical: Boolean;
4880   begin
4881     result := SourceFD.MaskMatch(DestFD.Mask);
4882   end;
4883
4884   function CanCopyDirect: Boolean;
4885   begin
4886     result :=
4887       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4888       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4889       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4890       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4891   end;
4892
4893   function CanShift: Boolean;
4894   begin
4895     result :=
4896       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4897       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4898       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4899       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4900   end;
4901
4902   function GetShift(aSource, aDest: Cardinal) : ShortInt;
4903   begin
4904     result := 0;
4905     while (aSource > aDest) and (aSource > 0) do begin
4906       inc(result);
4907       aSource := aSource shr 1;
4908     end;
4909   end;
4910
4911 begin
4912   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
4913     SourceFD := TFormatDescriptor.Get(Format);
4914     DestFD   := TFormatDescriptor.Get(aFormat);
4915
4916     if DataIsIdentical then begin
4917       result := true;
4918       Format := aFormat;
4919       exit;
4920     end;
4921
4922     SourceFD.PreparePixel(SourcePD);
4923     DestFD.PreparePixel  (DestPD);
4924
4925     if CanCopyDirect then
4926       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
4927     else if CanShift then begin
4928       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
4929       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
4930       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
4931       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
4932       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
4933     end else
4934       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
4935   end else
4936     result := true;
4937 end;
4938
4939 {$IFDEF GLB_SDL}
4940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4941 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4942 var
4943   Row, RowSize: Integer;
4944   SourceData, TmpData: PByte;
4945   TempDepth: Integer;
4946   FormatDesc: TFormatDescriptor;
4947
4948   function GetRowPointer(Row: Integer): pByte;
4949   begin
4950     result := aSurface.pixels;
4951     Inc(result, Row * RowSize);
4952   end;
4953
4954 begin
4955   result := false;
4956
4957   FormatDesc := TFormatDescriptor.Get(Format);
4958   if FormatDesc.IsCompressed then
4959     raise EglBitmapUnsupportedFormat.Create(Format);
4960
4961   if Assigned(Data) then begin
4962     case Trunc(FormatDesc.PixelSize) of
4963       1: TempDepth :=  8;
4964       2: TempDepth := 16;
4965       3: TempDepth := 24;
4966       4: TempDepth := 32;
4967     else
4968       raise EglBitmapUnsupportedFormat.Create(Format);
4969     end;
4970
4971     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4972       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4973     SourceData := Data;
4974     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4975
4976     for Row := 0 to FileHeight-1 do begin
4977       TmpData := GetRowPointer(Row);
4978       if Assigned(TmpData) then begin
4979         Move(SourceData^, TmpData^, RowSize);
4980         inc(SourceData, RowSize);
4981       end;
4982     end;
4983     result := true;
4984   end;
4985 end;
4986
4987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4988 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4989 var
4990   pSource, pData, pTempData: PByte;
4991   Row, RowSize, TempWidth, TempHeight: Integer;
4992   IntFormat: TglBitmapFormat;
4993   fd: TFormatDescriptor;
4994   Mask: TglBitmapMask;
4995
4996   function GetRowPointer(Row: Integer): pByte;
4997   begin
4998     result := aSurface^.pixels;
4999     Inc(result, Row * RowSize);
5000   end;
5001
5002 begin
5003   result := false;
5004   if (Assigned(aSurface)) then begin
5005     with aSurface^.format^ do begin
5006       Mask.r := RMask;
5007       Mask.g := GMask;
5008       Mask.b := BMask;
5009       Mask.a := AMask;
5010       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
5011       if (IntFormat = tfEmpty) then
5012         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
5013     end;
5014
5015     fd := TFormatDescriptor.Get(IntFormat);
5016     TempWidth  := aSurface^.w;
5017     TempHeight := aSurface^.h;
5018     RowSize := fd.GetSize(TempWidth, 1);
5019     GetMem(pData, TempHeight * RowSize);
5020     try
5021       pTempData := pData;
5022       for Row := 0 to TempHeight -1 do begin
5023         pSource := GetRowPointer(Row);
5024         if (Assigned(pSource)) then begin
5025           Move(pSource^, pTempData^, RowSize);
5026           Inc(pTempData, RowSize);
5027         end;
5028       end;
5029       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5030       result := true;
5031     except
5032       if Assigned(pData) then
5033         FreeMem(pData);
5034       raise;
5035     end;
5036   end;
5037 end;
5038
5039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5040 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
5041 var
5042   Row, Col, AlphaInterleave: Integer;
5043   pSource, pDest: PByte;
5044
5045   function GetRowPointer(Row: Integer): pByte;
5046   begin
5047     result := aSurface.pixels;
5048     Inc(result, Row * Width);
5049   end;
5050
5051 begin
5052   result := false;
5053   if Assigned(Data) then begin
5054     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
5055       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
5056
5057       AlphaInterleave := 0;
5058       case Format of
5059         tfLuminance8Alpha8ub2:
5060           AlphaInterleave := 1;
5061         tfBGRA8ub4, tfRGBA8ub4:
5062           AlphaInterleave := 3;
5063       end;
5064
5065       pSource := Data;
5066       for Row := 0 to Height -1 do begin
5067         pDest := GetRowPointer(Row);
5068         if Assigned(pDest) then begin
5069           for Col := 0 to Width -1 do begin
5070             Inc(pSource, AlphaInterleave);
5071             pDest^ := pSource^;
5072             Inc(pDest);
5073             Inc(pSource);
5074           end;
5075         end;
5076       end;
5077       result := true;
5078     end;
5079   end;
5080 end;
5081
5082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5083 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5084 var
5085   bmp: TglBitmap2D;
5086 begin
5087   bmp := TglBitmap2D.Create;
5088   try
5089     bmp.AssignFromSurface(aSurface);
5090     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5091   finally
5092     bmp.Free;
5093   end;
5094 end;
5095 {$ENDIF}
5096
5097 {$IFDEF GLB_DELPHI}
5098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5099 function CreateGrayPalette: HPALETTE;
5100 var
5101   Idx: Integer;
5102   Pal: PLogPalette;
5103 begin
5104   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5105
5106   Pal.palVersion := $300;
5107   Pal.palNumEntries := 256;
5108
5109   for Idx := 0 to Pal.palNumEntries - 1 do begin
5110     Pal.palPalEntry[Idx].peRed   := Idx;
5111     Pal.palPalEntry[Idx].peGreen := Idx;
5112     Pal.palPalEntry[Idx].peBlue  := Idx;
5113     Pal.palPalEntry[Idx].peFlags := 0;
5114   end;
5115   Result := CreatePalette(Pal^);
5116   FreeMem(Pal);
5117 end;
5118
5119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5120 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5121 var
5122   Row: Integer;
5123   pSource, pData: PByte;
5124 begin
5125   result := false;
5126   if Assigned(Data) then begin
5127     if Assigned(aBitmap) then begin
5128       aBitmap.Width  := Width;
5129       aBitmap.Height := Height;
5130
5131       case Format of
5132         tfAlpha8ub1, tfLuminance8ub1: begin
5133           aBitmap.PixelFormat := pf8bit;
5134           aBitmap.Palette     := CreateGrayPalette;
5135         end;
5136         tfRGB5A1us1:
5137           aBitmap.PixelFormat := pf15bit;
5138         tfR5G6B5us1:
5139           aBitmap.PixelFormat := pf16bit;
5140         tfRGB8ub3, tfBGR8ub3:
5141           aBitmap.PixelFormat := pf24bit;
5142         tfRGBA8ub4, tfBGRA8ub4:
5143           aBitmap.PixelFormat := pf32bit;
5144       else
5145         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5146       end;
5147
5148       pSource := Data;
5149       for Row := 0 to FileHeight -1 do begin
5150         pData := aBitmap.Scanline[Row];
5151         Move(pSource^, pData^, fRowSize);
5152         Inc(pSource, fRowSize);
5153         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5154           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5155       end;
5156       result := true;
5157     end;
5158   end;
5159 end;
5160
5161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5162 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5163 var
5164   pSource, pData, pTempData: PByte;
5165   Row, RowSize, TempWidth, TempHeight: Integer;
5166   IntFormat: TglBitmapFormat;
5167 begin
5168   result := false;
5169
5170   if (Assigned(aBitmap)) then begin
5171     case aBitmap.PixelFormat of
5172       pf8bit:
5173         IntFormat := tfLuminance8ub1;
5174       pf15bit:
5175         IntFormat := tfRGB5A1us1;
5176       pf16bit:
5177         IntFormat := tfR5G6B5us1;
5178       pf24bit:
5179         IntFormat := tfBGR8ub3;
5180       pf32bit:
5181         IntFormat := tfBGRA8ub4;
5182     else
5183       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5184     end;
5185
5186     TempWidth  := aBitmap.Width;
5187     TempHeight := aBitmap.Height;
5188     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5189     GetMem(pData, TempHeight * RowSize);
5190     try
5191       pTempData := pData;
5192       for Row := 0 to TempHeight -1 do begin
5193         pSource := aBitmap.Scanline[Row];
5194         if (Assigned(pSource)) then begin
5195           Move(pSource^, pTempData^, RowSize);
5196           Inc(pTempData, RowSize);
5197         end;
5198       end;
5199       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5200       result := true;
5201     except
5202       if Assigned(pData) then
5203         FreeMem(pData);
5204       raise;
5205     end;
5206   end;
5207 end;
5208
5209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5210 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5211 var
5212   Row, Col, AlphaInterleave: Integer;
5213   pSource, pDest: PByte;
5214 begin
5215   result := false;
5216
5217   if Assigned(Data) then begin
5218     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5219       if Assigned(aBitmap) then begin
5220         aBitmap.PixelFormat := pf8bit;
5221         aBitmap.Palette     := CreateGrayPalette;
5222         aBitmap.Width       := Width;
5223         aBitmap.Height      := Height;
5224
5225         case Format of
5226           tfLuminance8Alpha8ub2:
5227             AlphaInterleave := 1;
5228           tfRGBA8ub4, tfBGRA8ub4:
5229             AlphaInterleave := 3;
5230           else
5231             AlphaInterleave := 0;
5232         end;
5233
5234         // Copy Data
5235         pSource := Data;
5236
5237         for Row := 0 to Height -1 do begin
5238           pDest := aBitmap.Scanline[Row];
5239           if Assigned(pDest) then begin
5240             for Col := 0 to Width -1 do begin
5241               Inc(pSource, AlphaInterleave);
5242               pDest^ := pSource^;
5243               Inc(pDest);
5244               Inc(pSource);
5245             end;
5246           end;
5247         end;
5248         result := true;
5249       end;
5250     end;
5251   end;
5252 end;
5253
5254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5255 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5256 var
5257   tex: TglBitmap2D;
5258 begin
5259   tex := TglBitmap2D.Create;
5260   try
5261     tex.AssignFromBitmap(ABitmap);
5262     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5263   finally
5264     tex.Free;
5265   end;
5266 end;
5267 {$ENDIF}
5268
5269 {$IFDEF GLB_LAZARUS}
5270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5271 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5272 var
5273   rid: TRawImageDescription;
5274   FormatDesc: TFormatDescriptor;
5275 begin
5276   if not Assigned(Data) then
5277     raise EglBitmap.Create('no pixel data assigned. load data before save');
5278
5279   result := false;
5280   if not Assigned(aImage) or (Format = tfEmpty) then
5281     exit;
5282   FormatDesc := TFormatDescriptor.Get(Format);
5283   if FormatDesc.IsCompressed then
5284     exit;
5285
5286   FillChar(rid{%H-}, SizeOf(rid), 0);
5287   if FormatDesc.IsGrayscale then
5288     rid.Format := ricfGray
5289   else
5290     rid.Format := ricfRGBA;
5291
5292   rid.Width        := Width;
5293   rid.Height       := Height;
5294   rid.Depth        := FormatDesc.BitsPerPixel;
5295   rid.BitOrder     := riboBitsInOrder;
5296   rid.ByteOrder    := riboLSBFirst;
5297   rid.LineOrder    := riloTopToBottom;
5298   rid.LineEnd      := rileTight;
5299   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5300   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5301   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5302   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5303   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5304   rid.RedShift     := FormatDesc.Shift.r;
5305   rid.GreenShift   := FormatDesc.Shift.g;
5306   rid.BlueShift    := FormatDesc.Shift.b;
5307   rid.AlphaShift   := FormatDesc.Shift.a;
5308
5309   rid.MaskBitsPerPixel  := 0;
5310   rid.PaletteColorCount := 0;
5311
5312   aImage.DataDescription := rid;
5313   aImage.CreateData;
5314
5315   if not Assigned(aImage.PixelData) then
5316     raise EglBitmap.Create('error while creating LazIntfImage');
5317   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5318
5319   result := true;
5320 end;
5321
5322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5323 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5324 var
5325   f: TglBitmapFormat;
5326   FormatDesc: TFormatDescriptor;
5327   ImageData: PByte;
5328   ImageSize: Integer;
5329   CanCopy: Boolean;
5330   Mask: TglBitmapRec4ul;
5331
5332   procedure CopyConvert;
5333   var
5334     bfFormat: TbmpBitfieldFormat;
5335     pSourceLine, pDestLine: PByte;
5336     pSourceMD, pDestMD: Pointer;
5337     Shift, Prec: TglBitmapRec4ub;
5338     x, y: Integer;
5339     pixel: TglBitmapPixelData;
5340   begin
5341     bfFormat  := TbmpBitfieldFormat.Create;
5342     with aImage.DataDescription do begin
5343       Prec.r := RedPrec;
5344       Prec.g := GreenPrec;
5345       Prec.b := BluePrec;
5346       Prec.a := AlphaPrec;
5347       Shift.r := RedShift;
5348       Shift.g := GreenShift;
5349       Shift.b := BlueShift;
5350       Shift.a := AlphaShift;
5351       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5352     end;
5353     pSourceMD := bfFormat.CreateMappingData;
5354     pDestMD   := FormatDesc.CreateMappingData;
5355     try
5356       for y := 0 to aImage.Height-1 do begin
5357         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5358         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5359         for x := 0 to aImage.Width-1 do begin
5360           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5361           FormatDesc.Map(pixel, pDestLine, pDestMD);
5362         end;
5363       end;
5364     finally
5365       FormatDesc.FreeMappingData(pDestMD);
5366       bfFormat.FreeMappingData(pSourceMD);
5367       bfFormat.Free;
5368     end;
5369   end;
5370
5371 begin
5372   result := false;
5373   if not Assigned(aImage) then
5374     exit;
5375
5376   with aImage.DataDescription do begin
5377     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5378     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5379     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5380     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5381   end;
5382   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5383   f          := FormatDesc.Format;
5384   if (f = tfEmpty) then
5385     exit;
5386
5387   CanCopy :=
5388     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5389     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5390
5391   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5392   ImageData := GetMem(ImageSize);
5393   try
5394     if CanCopy then
5395       Move(aImage.PixelData^, ImageData^, ImageSize)
5396     else
5397       CopyConvert;
5398     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5399   except
5400     if Assigned(ImageData) then
5401       FreeMem(ImageData);
5402     raise;
5403   end;
5404
5405   result := true;
5406 end;
5407
5408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5409 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5410 var
5411   rid: TRawImageDescription;
5412   FormatDesc: TFormatDescriptor;
5413   Pixel: TglBitmapPixelData;
5414   x, y: Integer;
5415   srcMD: Pointer;
5416   src, dst: PByte;
5417 begin
5418   result := false;
5419   if not Assigned(aImage) or (Format = tfEmpty) then
5420     exit;
5421   FormatDesc := TFormatDescriptor.Get(Format);
5422   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5423     exit;
5424
5425   FillChar(rid{%H-}, SizeOf(rid), 0);
5426   rid.Format       := ricfGray;
5427   rid.Width        := Width;
5428   rid.Height       := Height;
5429   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5430   rid.BitOrder     := riboBitsInOrder;
5431   rid.ByteOrder    := riboLSBFirst;
5432   rid.LineOrder    := riloTopToBottom;
5433   rid.LineEnd      := rileTight;
5434   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5435   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5436   rid.GreenPrec    := 0;
5437   rid.BluePrec     := 0;
5438   rid.AlphaPrec    := 0;
5439   rid.RedShift     := 0;
5440   rid.GreenShift   := 0;
5441   rid.BlueShift    := 0;
5442   rid.AlphaShift   := 0;
5443
5444   rid.MaskBitsPerPixel  := 0;
5445   rid.PaletteColorCount := 0;
5446
5447   aImage.DataDescription := rid;
5448   aImage.CreateData;
5449
5450   srcMD := FormatDesc.CreateMappingData;
5451   try
5452     FormatDesc.PreparePixel(Pixel);
5453     src := Data;
5454     dst := aImage.PixelData;
5455     for y := 0 to Height-1 do
5456       for x := 0 to Width-1 do begin
5457         FormatDesc.Unmap(src, Pixel, srcMD);
5458         case rid.BitsPerPixel of
5459            8: begin
5460             dst^ := Pixel.Data.a;
5461             inc(dst);
5462           end;
5463           16: begin
5464             PWord(dst)^ := Pixel.Data.a;
5465             inc(dst, 2);
5466           end;
5467           24: begin
5468             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5469             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5470             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5471             inc(dst, 3);
5472           end;
5473           32: begin
5474             PCardinal(dst)^ := Pixel.Data.a;
5475             inc(dst, 4);
5476           end;
5477         else
5478           raise EglBitmapUnsupportedFormat.Create(Format);
5479         end;
5480       end;
5481   finally
5482     FormatDesc.FreeMappingData(srcMD);
5483   end;
5484   result := true;
5485 end;
5486
5487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5488 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5489 var
5490   tex: TglBitmap2D;
5491 begin
5492   tex := TglBitmap2D.Create;
5493   try
5494     tex.AssignFromLazIntfImage(aImage);
5495     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5496   finally
5497     tex.Free;
5498   end;
5499 end;
5500 {$ENDIF}
5501
5502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5503 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5504   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5505 var
5506   rs: TResourceStream;
5507 begin
5508   PrepareResType(aResource, aResType);
5509   rs := TResourceStream.Create(aInstance, aResource, aResType);
5510   try
5511     result := AddAlphaFromStream(rs, aFunc, aArgs);
5512   finally
5513     rs.Free;
5514   end;
5515 end;
5516
5517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5518 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5519   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5520 var
5521   rs: TResourceStream;
5522 begin
5523   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5524   try
5525     result := AddAlphaFromStream(rs, aFunc, aArgs);
5526   finally
5527     rs.Free;
5528   end;
5529 end;
5530
5531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5532 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5533 begin
5534   if TFormatDescriptor.Get(Format).IsCompressed then
5535     raise EglBitmapUnsupportedFormat.Create(Format);
5536   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5537 end;
5538
5539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5540 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5541 var
5542   FS: TFileStream;
5543 begin
5544   FS := TFileStream.Create(aFileName, fmOpenRead);
5545   try
5546     result := AddAlphaFromStream(FS, aFunc, aArgs);
5547   finally
5548     FS.Free;
5549   end;
5550 end;
5551
5552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5553 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5554 var
5555   tex: TglBitmap2D;
5556 begin
5557   tex := TglBitmap2D.Create(aStream);
5558   try
5559     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5560   finally
5561     tex.Free;
5562   end;
5563 end;
5564
5565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5566 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5567 var
5568   DestData, DestData2, SourceData: pByte;
5569   TempHeight, TempWidth: Integer;
5570   SourceFD, DestFD: TFormatDescriptor;
5571   SourceMD, DestMD, DestMD2: Pointer;
5572
5573   FuncRec: TglBitmapFunctionRec;
5574 begin
5575   result := false;
5576
5577   Assert(Assigned(Data));
5578   Assert(Assigned(aBitmap));
5579   Assert(Assigned(aBitmap.Data));
5580
5581   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5582     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5583
5584     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5585     DestFD   := TFormatDescriptor.Get(Format);
5586
5587     if not Assigned(aFunc) then begin
5588       aFunc        := glBitmapAlphaFunc;
5589       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5590     end else
5591       FuncRec.Args := aArgs;
5592
5593     // Values
5594     TempHeight := aBitmap.FileHeight;
5595     TempWidth  := aBitmap.FileWidth;
5596
5597     FuncRec.Sender          := Self;
5598     FuncRec.Size            := Dimension;
5599     FuncRec.Position.Fields := FuncRec.Size.Fields;
5600
5601     DestData   := Data;
5602     DestData2  := Data;
5603     SourceData := aBitmap.Data;
5604
5605     // Mapping
5606     SourceFD.PreparePixel(FuncRec.Source);
5607     DestFD.PreparePixel  (FuncRec.Dest);
5608
5609     SourceMD := SourceFD.CreateMappingData;
5610     DestMD   := DestFD.CreateMappingData;
5611     DestMD2  := DestFD.CreateMappingData;
5612     try
5613       FuncRec.Position.Y := 0;
5614       while FuncRec.Position.Y < TempHeight do begin
5615         FuncRec.Position.X := 0;
5616         while FuncRec.Position.X < TempWidth do begin
5617           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5618           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5619           aFunc(FuncRec);
5620           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5621           inc(FuncRec.Position.X);
5622         end;
5623         inc(FuncRec.Position.Y);
5624       end;
5625     finally
5626       SourceFD.FreeMappingData(SourceMD);
5627       DestFD.FreeMappingData(DestMD);
5628       DestFD.FreeMappingData(DestMD2);
5629     end;
5630   end;
5631 end;
5632
5633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5634 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5635 begin
5636   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5637 end;
5638
5639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5640 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5641 var
5642   PixelData: TglBitmapPixelData;
5643 begin
5644   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5645   result := AddAlphaFromColorKeyFloat(
5646     aRed   / PixelData.Range.r,
5647     aGreen / PixelData.Range.g,
5648     aBlue  / PixelData.Range.b,
5649     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5650 end;
5651
5652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5653 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5654 var
5655   values: array[0..2] of Single;
5656   tmp: Cardinal;
5657   i: Integer;
5658   PixelData: TglBitmapPixelData;
5659 begin
5660   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5661   with PixelData do begin
5662     values[0] := aRed;
5663     values[1] := aGreen;
5664     values[2] := aBlue;
5665
5666     for i := 0 to 2 do begin
5667       tmp          := Trunc(Range.arr[i] * aDeviation);
5668       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5669       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5670     end;
5671     Data.a  := 0;
5672     Range.a := 0;
5673   end;
5674   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5675 end;
5676
5677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5678 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5679 begin
5680   result := AddAlphaFromValueFloat(aAlpha / $FF);
5681 end;
5682
5683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5684 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5685 var
5686   PixelData: TglBitmapPixelData;
5687 begin
5688   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5689   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5690 end;
5691
5692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5693 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5694 var
5695   PixelData: TglBitmapPixelData;
5696 begin
5697   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5698   with PixelData do
5699     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5700   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5701 end;
5702
5703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5704 function TglBitmap.RemoveAlpha: Boolean;
5705 var
5706   FormatDesc: TFormatDescriptor;
5707 begin
5708   result := false;
5709   FormatDesc := TFormatDescriptor.Get(Format);
5710   if Assigned(Data) then begin
5711     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5712       raise EglBitmapUnsupportedFormat.Create(Format);
5713     result := ConvertTo(FormatDesc.WithoutAlpha);
5714   end;
5715 end;
5716
5717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5718 function TglBitmap.Clone: TglBitmap;
5719 var
5720   Temp: TglBitmap;
5721   TempPtr: PByte;
5722   Size: Integer;
5723 begin
5724   result := nil;
5725   Temp := (ClassType.Create as TglBitmap);
5726   try
5727     // copy texture data if assigned
5728     if Assigned(Data) then begin
5729       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5730       GetMem(TempPtr, Size);
5731       try
5732         Move(Data^, TempPtr^, Size);
5733         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5734       except
5735         if Assigned(TempPtr) then
5736           FreeMem(TempPtr);
5737         raise;
5738       end;
5739     end else begin
5740       TempPtr := nil;
5741       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5742     end;
5743
5744         // copy properties
5745     Temp.fID                      := ID;
5746     Temp.fTarget                  := Target;
5747     Temp.fFormat                  := Format;
5748     Temp.fMipMap                  := MipMap;
5749     Temp.fAnisotropic             := Anisotropic;
5750     Temp.fBorderColor             := fBorderColor;
5751     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5752     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5753     Temp.fFilterMin               := fFilterMin;
5754     Temp.fFilterMag               := fFilterMag;
5755     Temp.fWrapS                   := fWrapS;
5756     Temp.fWrapT                   := fWrapT;
5757     Temp.fWrapR                   := fWrapR;
5758     Temp.fFilename                := fFilename;
5759     Temp.fCustomName              := fCustomName;
5760     Temp.fCustomNameW             := fCustomNameW;
5761     Temp.fCustomData              := fCustomData;
5762
5763     result := Temp;
5764   except
5765     FreeAndNil(Temp);
5766     raise;
5767   end;
5768 end;
5769
5770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5771 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5772 begin
5773   if aUseRGB or aUseAlpha then
5774     Convert(glBitmapInvertFunc, false, {%H-}Pointer(
5775       ((Byte(aUseAlpha) and 1) shl 1) or
5776        (Byte(aUseRGB)   and 1)      ));
5777 end;
5778
5779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5780 procedure TglBitmap.FreeData;
5781 var
5782   TempPtr: PByte;
5783 begin
5784   TempPtr := nil;
5785   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5786 end;
5787
5788 {$IFNDEF OPENGL_ES}
5789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5790 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5791 begin
5792   fBorderColor[0] := aRed;
5793   fBorderColor[1] := aGreen;
5794   fBorderColor[2] := aBlue;
5795   fBorderColor[3] := aAlpha;
5796   if (ID > 0) then begin
5797     Bind(false);
5798     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5799   end;
5800 end;
5801 {$ENDIF}
5802
5803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5804 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5805   const aAlpha: Byte);
5806 begin
5807   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5808 end;
5809
5810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5811 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5812 var
5813   PixelData: TglBitmapPixelData;
5814 begin
5815   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5816   FillWithColorFloat(
5817     aRed   / PixelData.Range.r,
5818     aGreen / PixelData.Range.g,
5819     aBlue  / PixelData.Range.b,
5820     aAlpha / PixelData.Range.a);
5821 end;
5822
5823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5824 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5825 var
5826   PixelData: TglBitmapPixelData;
5827 begin
5828   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5829   with PixelData do begin
5830     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5831     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5832     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5833     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5834   end;
5835   Convert(glBitmapFillWithColorFunc, false, @PixelData);
5836 end;
5837
5838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5839 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5840 begin
5841   //check MIN filter
5842   case aMin of
5843     GL_NEAREST:
5844       fFilterMin := GL_NEAREST;
5845     GL_LINEAR:
5846       fFilterMin := GL_LINEAR;
5847     GL_NEAREST_MIPMAP_NEAREST:
5848       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5849     GL_LINEAR_MIPMAP_NEAREST:
5850       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5851     GL_NEAREST_MIPMAP_LINEAR:
5852       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5853     GL_LINEAR_MIPMAP_LINEAR:
5854       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5855     else
5856       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5857   end;
5858
5859   //check MAG filter
5860   case aMag of
5861     GL_NEAREST:
5862       fFilterMag := GL_NEAREST;
5863     GL_LINEAR:
5864       fFilterMag := GL_LINEAR;
5865     else
5866       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5867   end;
5868
5869   //apply filter
5870   if (ID > 0) then begin
5871     Bind(false);
5872     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5873
5874     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
5875       case fFilterMin of
5876         GL_NEAREST, GL_LINEAR:
5877           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5878         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5879           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5880         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5881           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5882       end;
5883     end else
5884       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5885   end;
5886 end;
5887
5888 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5889 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5890
5891   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5892   begin
5893     case aValue of
5894 {$IFNDEF OPENGL_ES}
5895       GL_CLAMP:
5896         aTarget := GL_CLAMP;
5897 {$ENDIF}
5898
5899       GL_REPEAT:
5900         aTarget := GL_REPEAT;
5901
5902       GL_CLAMP_TO_EDGE: begin
5903 {$IFNDEF OPENGL_ES}
5904         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
5905           aTarget := GL_CLAMP
5906         else
5907 {$ENDIF}
5908           aTarget := GL_CLAMP_TO_EDGE;
5909       end;
5910
5911 {$IFNDEF OPENGL_ES}
5912       GL_CLAMP_TO_BORDER: begin
5913         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5914           aTarget := GL_CLAMP_TO_BORDER
5915         else
5916           aTarget := GL_CLAMP;
5917       end;
5918 {$ENDIF}
5919
5920 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
5921       GL_MIRRORED_REPEAT: begin
5922   {$IFNDEF OPENGL_ES}
5923         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5924   {$ELSE}
5925         if GL_VERSION_2_0 then
5926   {$ENDIF}
5927           aTarget := GL_MIRRORED_REPEAT
5928         else
5929           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5930       end;
5931 {$IFEND}
5932     else
5933       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5934     end;
5935   end;
5936
5937 begin
5938   CheckAndSetWrap(S, fWrapS);
5939   CheckAndSetWrap(T, fWrapT);
5940   CheckAndSetWrap(R, fWrapR);
5941
5942   if (ID > 0) then begin
5943     Bind(false);
5944     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5945     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5946 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
5947     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
5948     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5949 {$IFEND}
5950   end;
5951 end;
5952
5953 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
5954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5955 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5956
5957   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5958   begin
5959     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5960        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5961       fSwizzle[aIndex] := aValue
5962     else
5963       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5964   end;
5965
5966 begin
5967 {$IFNDEF OPENGL_ES}
5968   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5969     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5970 {$ELSE}
5971   if not GL_VERSION_3_0 then
5972     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5973 {$ENDIF}
5974   CheckAndSetValue(r, 0);
5975   CheckAndSetValue(g, 1);
5976   CheckAndSetValue(b, 2);
5977   CheckAndSetValue(a, 3);
5978
5979   if (ID > 0) then begin
5980     Bind(false);
5981 {$IFNDEF OPENGL_ES}
5982     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5983 {$ELSE}
5984     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
5985     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
5986     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
5987     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
5988 {$ENDIF}
5989   end;
5990 end;
5991 {$IFEND}
5992
5993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5994 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5995 begin
5996   if aEnableTextureUnit then
5997     glEnable(Target);
5998   if (ID > 0) then
5999     glBindTexture(Target, ID);
6000 end;
6001
6002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6003 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
6004 begin
6005   if aDisableTextureUnit then
6006     glDisable(Target);
6007   glBindTexture(Target, 0);
6008 end;
6009
6010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6011 constructor TglBitmap.Create;
6012 begin
6013   if (ClassType = TglBitmap) then
6014     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
6015   inherited Create;
6016   fFormat            := glBitmapGetDefaultFormat;
6017   fFreeDataOnDestroy := true;
6018 end;
6019
6020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6021 constructor TglBitmap.Create(const aFileName: String);
6022 begin
6023   Create;
6024   LoadFromFile(aFileName);
6025 end;
6026
6027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6028 constructor TglBitmap.Create(const aStream: TStream);
6029 begin
6030   Create;
6031   LoadFromStream(aStream);
6032 end;
6033
6034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6035 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
6036 var
6037   ImageSize: Integer;
6038 begin
6039   Create;
6040   if not Assigned(aData) then begin
6041     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6042     GetMem(aData, ImageSize);
6043     try
6044       FillChar(aData^, ImageSize, #$FF);
6045       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6046     except
6047       if Assigned(aData) then
6048         FreeMem(aData);
6049       raise;
6050     end;
6051   end else begin
6052     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
6053   end;
6054 end;
6055
6056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6057 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
6058 begin
6059   Create;
6060   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
6061 end;
6062
6063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6064 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6065 begin
6066   Create;
6067   LoadFromResource(aInstance, aResource, aResType);
6068 end;
6069
6070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6071 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6072 begin
6073   Create;
6074   LoadFromResourceID(aInstance, aResourceID, aResType);
6075 end;
6076
6077 {$IFDEF GLB_SUPPORT_PNG_READ}
6078 {$IF DEFINED(GLB_LAZ_PNG)}
6079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6080 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6082 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6083 const
6084   MAGIC_LEN = 8;
6085   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6086 var
6087   reader: TLazReaderPNG;
6088   intf: TLazIntfImage;
6089   StreamPos: Int64;
6090   magic: String[MAGIC_LEN];
6091 begin
6092   result := true;
6093   StreamPos := aStream.Position;
6094
6095   SetLength(magic, MAGIC_LEN);
6096   aStream.Read(magic[1], MAGIC_LEN);
6097   aStream.Position := StreamPos;
6098   if (magic <> PNG_MAGIC) then begin
6099     result := false;
6100     exit;
6101   end;
6102
6103   intf   := TLazIntfImage.Create(0, 0);
6104   reader := TLazReaderPNG.Create;
6105   try try
6106     reader.UpdateDescription := true;
6107     reader.ImageRead(aStream, intf);
6108     AssignFromLazIntfImage(intf);
6109   except
6110     result := false;
6111     aStream.Position := StreamPos;
6112     exit;
6113   end;
6114   finally
6115     reader.Free;
6116     intf.Free;
6117   end;
6118 end;
6119
6120 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6122 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6123 var
6124   Surface: PSDL_Surface;
6125   RWops: PSDL_RWops;
6126 begin
6127   result := false;
6128   RWops := glBitmapCreateRWops(aStream);
6129   try
6130     if IMG_isPNG(RWops) > 0 then begin
6131       Surface := IMG_LoadPNG_RW(RWops);
6132       try
6133         AssignFromSurface(Surface);
6134         result := true;
6135       finally
6136         SDL_FreeSurface(Surface);
6137       end;
6138     end;
6139   finally
6140     SDL_FreeRW(RWops);
6141   end;
6142 end;
6143
6144 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6146 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6147 begin
6148   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6149 end;
6150
6151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6152 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6153 var
6154   StreamPos: Int64;
6155   signature: array [0..7] of byte;
6156   png: png_structp;
6157   png_info: png_infop;
6158
6159   TempHeight, TempWidth: Integer;
6160   Format: TglBitmapFormat;
6161
6162   png_data: pByte;
6163   png_rows: array of pByte;
6164   Row, LineSize: Integer;
6165 begin
6166   result := false;
6167
6168   if not init_libPNG then
6169     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6170
6171   try
6172     // signature
6173     StreamPos := aStream.Position;
6174     aStream.Read(signature{%H-}, 8);
6175     aStream.Position := StreamPos;
6176
6177     if png_check_sig(@signature, 8) <> 0 then begin
6178       // png read struct
6179       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6180       if png = nil then
6181         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6182
6183       // png info
6184       png_info := png_create_info_struct(png);
6185       if png_info = nil then begin
6186         png_destroy_read_struct(@png, nil, nil);
6187         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6188       end;
6189
6190       // set read callback
6191       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6192
6193       // read informations
6194       png_read_info(png, png_info);
6195
6196       // size
6197       TempHeight := png_get_image_height(png, png_info);
6198       TempWidth := png_get_image_width(png, png_info);
6199
6200       // format
6201       case png_get_color_type(png, png_info) of
6202         PNG_COLOR_TYPE_GRAY:
6203           Format := tfLuminance8ub1;
6204         PNG_COLOR_TYPE_GRAY_ALPHA:
6205           Format := tfLuminance8Alpha8us1;
6206         PNG_COLOR_TYPE_RGB:
6207           Format := tfRGB8ub3;
6208         PNG_COLOR_TYPE_RGB_ALPHA:
6209           Format := tfRGBA8ub4;
6210         else
6211           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6212       end;
6213
6214       // cut upper 8 bit from 16 bit formats
6215       if png_get_bit_depth(png, png_info) > 8 then
6216         png_set_strip_16(png);
6217
6218       // expand bitdepth smaller than 8
6219       if png_get_bit_depth(png, png_info) < 8 then
6220         png_set_expand(png);
6221
6222       // allocating mem for scanlines
6223       LineSize := png_get_rowbytes(png, png_info);
6224       GetMem(png_data, TempHeight * LineSize);
6225       try
6226         SetLength(png_rows, TempHeight);
6227         for Row := Low(png_rows) to High(png_rows) do begin
6228           png_rows[Row] := png_data;
6229           Inc(png_rows[Row], Row * LineSize);
6230         end;
6231
6232         // read complete image into scanlines
6233         png_read_image(png, @png_rows[0]);
6234
6235         // read end
6236         png_read_end(png, png_info);
6237
6238         // destroy read struct
6239         png_destroy_read_struct(@png, @png_info, nil);
6240
6241         SetLength(png_rows, 0);
6242
6243         // set new data
6244         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6245
6246         result := true;
6247       except
6248         if Assigned(png_data) then
6249           FreeMem(png_data);
6250         raise;
6251       end;
6252     end;
6253   finally
6254     quit_libPNG;
6255   end;
6256 end;
6257
6258 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6260 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6261 var
6262   StreamPos: Int64;
6263   Png: TPNGObject;
6264   Header: String[8];
6265   Row, Col, PixSize, LineSize: Integer;
6266   NewImage, pSource, pDest, pAlpha: pByte;
6267   PngFormat: TglBitmapFormat;
6268   FormatDesc: TFormatDescriptor;
6269
6270 const
6271   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6272
6273 begin
6274   result := false;
6275
6276   StreamPos := aStream.Position;
6277   aStream.Read(Header[0], SizeOf(Header));
6278   aStream.Position := StreamPos;
6279
6280   {Test if the header matches}
6281   if Header = PngHeader then begin
6282     Png := TPNGObject.Create;
6283     try
6284       Png.LoadFromStream(aStream);
6285
6286       case Png.Header.ColorType of
6287         COLOR_GRAYSCALE:
6288           PngFormat := tfLuminance8ub1;
6289         COLOR_GRAYSCALEALPHA:
6290           PngFormat := tfLuminance8Alpha8us1;
6291         COLOR_RGB:
6292           PngFormat := tfBGR8ub3;
6293         COLOR_RGBALPHA:
6294           PngFormat := tfBGRA8ub4;
6295         else
6296           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6297       end;
6298
6299       FormatDesc := TFormatDescriptor.Get(PngFormat);
6300       PixSize    := Round(FormatDesc.PixelSize);
6301       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6302
6303       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6304       try
6305         pDest := NewImage;
6306
6307         case Png.Header.ColorType of
6308           COLOR_RGB, COLOR_GRAYSCALE:
6309             begin
6310               for Row := 0 to Png.Height -1 do begin
6311                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6312                 Inc(pDest, LineSize);
6313               end;
6314             end;
6315           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6316             begin
6317               PixSize := PixSize -1;
6318
6319               for Row := 0 to Png.Height -1 do begin
6320                 pSource := Png.Scanline[Row];
6321                 pAlpha := pByte(Png.AlphaScanline[Row]);
6322
6323                 for Col := 0 to Png.Width -1 do begin
6324                   Move (pSource^, pDest^, PixSize);
6325                   Inc(pSource, PixSize);
6326                   Inc(pDest, PixSize);
6327
6328                   pDest^ := pAlpha^;
6329                   inc(pAlpha);
6330                   Inc(pDest);
6331                 end;
6332               end;
6333             end;
6334           else
6335             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6336         end;
6337
6338         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6339
6340         result := true;
6341       except
6342         if Assigned(NewImage) then
6343           FreeMem(NewImage);
6344         raise;
6345       end;
6346     finally
6347       Png.Free;
6348     end;
6349   end;
6350 end;
6351 {$IFEND}
6352 {$ENDIF}
6353
6354 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6355 {$IFDEF GLB_LIB_PNG}
6356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6357 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6358 begin
6359   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6360 end;
6361 {$ENDIF}
6362
6363 {$IF DEFINED(GLB_LAZ_PNG)}
6364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6365 procedure TglBitmap.SavePNG(const aStream: TStream);
6366 var
6367   png: TPortableNetworkGraphic;
6368   intf: TLazIntfImage;
6369   raw: TRawImage;
6370 begin
6371   png  := TPortableNetworkGraphic.Create;
6372   intf := TLazIntfImage.Create(0, 0);
6373   try
6374     if not AssignToLazIntfImage(intf) then
6375       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6376     intf.GetRawImage(raw);
6377     png.LoadFromRawImage(raw, false);
6378     png.SaveToStream(aStream);
6379   finally
6380     png.Free;
6381     intf.Free;
6382   end;
6383 end;
6384
6385 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6387 procedure TglBitmap.SavePNG(const aStream: TStream);
6388 var
6389   png: png_structp;
6390   png_info: png_infop;
6391   png_rows: array of pByte;
6392   LineSize: Integer;
6393   ColorType: Integer;
6394   Row: Integer;
6395   FormatDesc: TFormatDescriptor;
6396 begin
6397   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6398     raise EglBitmapUnsupportedFormat.Create(Format);
6399
6400   if not init_libPNG then
6401     raise Exception.Create('unable to initialize libPNG.');
6402
6403   try
6404     case Format of
6405       tfAlpha8ub1, tfLuminance8ub1:
6406         ColorType := PNG_COLOR_TYPE_GRAY;
6407       tfLuminance8Alpha8us1:
6408         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6409       tfBGR8ub3, tfRGB8ub3:
6410         ColorType := PNG_COLOR_TYPE_RGB;
6411       tfBGRA8ub4, tfRGBA8ub4:
6412         ColorType := PNG_COLOR_TYPE_RGBA;
6413       else
6414         raise EglBitmapUnsupportedFormat.Create(Format);
6415     end;
6416
6417     FormatDesc := TFormatDescriptor.Get(Format);
6418     LineSize := FormatDesc.GetSize(Width, 1);
6419
6420     // creating array for scanline
6421     SetLength(png_rows, Height);
6422     try
6423       for Row := 0 to Height - 1 do begin
6424         png_rows[Row] := Data;
6425         Inc(png_rows[Row], Row * LineSize)
6426       end;
6427
6428       // write struct
6429       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6430       if png = nil then
6431         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6432
6433       // create png info
6434       png_info := png_create_info_struct(png);
6435       if png_info = nil then begin
6436         png_destroy_write_struct(@png, nil);
6437         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6438       end;
6439
6440       // set read callback
6441       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6442
6443       // set compression
6444       png_set_compression_level(png, 6);
6445
6446       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6447         png_set_bgr(png);
6448
6449       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6450       png_write_info(png, png_info);
6451       png_write_image(png, @png_rows[0]);
6452       png_write_end(png, png_info);
6453       png_destroy_write_struct(@png, @png_info);
6454     finally
6455       SetLength(png_rows, 0);
6456     end;
6457   finally
6458     quit_libPNG;
6459   end;
6460 end;
6461
6462 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6464 procedure TglBitmap.SavePNG(const aStream: TStream);
6465 var
6466   Png: TPNGObject;
6467
6468   pSource, pDest: pByte;
6469   X, Y, PixSize: Integer;
6470   ColorType: Cardinal;
6471   Alpha: Boolean;
6472
6473   pTemp: pByte;
6474   Temp: Byte;
6475 begin
6476   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6477     raise EglBitmapUnsupportedFormat.Create(Format);
6478
6479   case Format of
6480     tfAlpha8ub1, tfLuminance8ub1: begin
6481       ColorType := COLOR_GRAYSCALE;
6482       PixSize   := 1;
6483       Alpha     := false;
6484     end;
6485     tfLuminance8Alpha8us1: begin
6486       ColorType := COLOR_GRAYSCALEALPHA;
6487       PixSize   := 1;
6488       Alpha     := true;
6489     end;
6490     tfBGR8ub3, tfRGB8ub3: begin
6491       ColorType := COLOR_RGB;
6492       PixSize   := 3;
6493       Alpha     := false;
6494     end;
6495     tfBGRA8ub4, tfRGBA8ub4: begin
6496       ColorType := COLOR_RGBALPHA;
6497       PixSize   := 3;
6498       Alpha     := true
6499     end;
6500   else
6501     raise EglBitmapUnsupportedFormat.Create(Format);
6502   end;
6503
6504   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6505   try
6506     // Copy ImageData
6507     pSource := Data;
6508     for Y := 0 to Height -1 do begin
6509       pDest := png.ScanLine[Y];
6510       for X := 0 to Width -1 do begin
6511         Move(pSource^, pDest^, PixSize);
6512         Inc(pDest, PixSize);
6513         Inc(pSource, PixSize);
6514         if Alpha then begin
6515           png.AlphaScanline[Y]^[X] := pSource^;
6516           Inc(pSource);
6517         end;
6518       end;
6519
6520       // convert RGB line to BGR
6521       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6522         pTemp := png.ScanLine[Y];
6523         for X := 0 to Width -1 do begin
6524           Temp := pByteArray(pTemp)^[0];
6525           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6526           pByteArray(pTemp)^[2] := Temp;
6527           Inc(pTemp, 3);
6528         end;
6529       end;
6530     end;
6531
6532     // Save to Stream
6533     Png.CompressionLevel := 6;
6534     Png.SaveToStream(aStream);
6535   finally
6536     FreeAndNil(Png);
6537   end;
6538 end;
6539 {$IFEND}
6540 {$ENDIF}
6541
6542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6543 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6545 {$IFDEF GLB_LIB_JPEG}
6546 type
6547   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6548   glBitmap_libJPEG_source_mgr = record
6549     pub: jpeg_source_mgr;
6550
6551     SrcStream: TStream;
6552     SrcBuffer: array [1..4096] of byte;
6553   end;
6554
6555   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6556   glBitmap_libJPEG_dest_mgr = record
6557     pub: jpeg_destination_mgr;
6558
6559     DestStream: TStream;
6560     DestBuffer: array [1..4096] of byte;
6561   end;
6562
6563 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6564 begin
6565   //DUMMY
6566 end;
6567
6568
6569 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6570 begin
6571   //DUMMY
6572 end;
6573
6574
6575 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6576 begin
6577   //DUMMY
6578 end;
6579
6580 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6581 begin
6582   //DUMMY
6583 end;
6584
6585
6586 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6587 begin
6588   //DUMMY
6589 end;
6590
6591
6592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6593 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6594 var
6595   src: glBitmap_libJPEG_source_mgr_ptr;
6596   bytes: integer;
6597 begin
6598   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6599
6600   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6601         if (bytes <= 0) then begin
6602                 src^.SrcBuffer[1] := $FF;
6603                 src^.SrcBuffer[2] := JPEG_EOI;
6604                 bytes := 2;
6605         end;
6606
6607         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6608         src^.pub.bytes_in_buffer := bytes;
6609
6610   result := true;
6611 end;
6612
6613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6614 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6615 var
6616   src: glBitmap_libJPEG_source_mgr_ptr;
6617 begin
6618   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6619
6620   if num_bytes > 0 then begin
6621     // wanted byte isn't in buffer so set stream position and read buffer
6622     if num_bytes > src^.pub.bytes_in_buffer then begin
6623       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6624       src^.pub.fill_input_buffer(cinfo);
6625     end else begin
6626       // wanted byte is in buffer so only skip
6627                 inc(src^.pub.next_input_byte, num_bytes);
6628                 dec(src^.pub.bytes_in_buffer, num_bytes);
6629     end;
6630   end;
6631 end;
6632
6633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6634 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6635 var
6636   dest: glBitmap_libJPEG_dest_mgr_ptr;
6637 begin
6638   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6639
6640   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6641     // write complete buffer
6642     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6643
6644     // reset buffer
6645     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6646     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6647   end;
6648
6649   result := true;
6650 end;
6651
6652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6653 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6654 var
6655   Idx: Integer;
6656   dest: glBitmap_libJPEG_dest_mgr_ptr;
6657 begin
6658   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6659
6660   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6661     // check for endblock
6662     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6663       // write endblock
6664       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6665
6666       // leave
6667       break;
6668     end else
6669       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6670   end;
6671 end;
6672 {$ENDIF}
6673
6674 {$IFDEF GLB_SUPPORT_JPEG_READ}
6675 {$IF DEFINED(GLB_LAZ_JPEG)}
6676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6677 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6678 const
6679   MAGIC_LEN = 2;
6680   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6681 var
6682   intf: TLazIntfImage;
6683   reader: TFPReaderJPEG;
6684   StreamPos: Int64;
6685   magic: String[MAGIC_LEN];
6686 begin
6687   result := true;
6688   StreamPos := aStream.Position;
6689
6690   SetLength(magic, MAGIC_LEN);
6691   aStream.Read(magic[1], MAGIC_LEN);
6692   aStream.Position := StreamPos;
6693   if (magic <> JPEG_MAGIC) then begin
6694     result := false;
6695     exit;
6696   end;
6697
6698   reader := TFPReaderJPEG.Create;
6699   intf := TLazIntfImage.Create(0, 0);
6700   try try
6701     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6702     reader.ImageRead(aStream, intf);
6703     AssignFromLazIntfImage(intf);
6704   except
6705     result := false;
6706     aStream.Position := StreamPos;
6707     exit;
6708   end;
6709   finally
6710     reader.Free;
6711     intf.Free;
6712   end;
6713 end;
6714
6715 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6717 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6718 var
6719   Surface: PSDL_Surface;
6720   RWops: PSDL_RWops;
6721 begin
6722   result := false;
6723
6724   RWops := glBitmapCreateRWops(aStream);
6725   try
6726     if IMG_isJPG(RWops) > 0 then begin
6727       Surface := IMG_LoadJPG_RW(RWops);
6728       try
6729         AssignFromSurface(Surface);
6730         result := true;
6731       finally
6732         SDL_FreeSurface(Surface);
6733       end;
6734     end;
6735   finally
6736     SDL_FreeRW(RWops);
6737   end;
6738 end;
6739
6740 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6742 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6743 var
6744   StreamPos: Int64;
6745   Temp: array[0..1]of Byte;
6746
6747   jpeg: jpeg_decompress_struct;
6748   jpeg_err: jpeg_error_mgr;
6749
6750   IntFormat: TglBitmapFormat;
6751   pImage: pByte;
6752   TempHeight, TempWidth: Integer;
6753
6754   pTemp: pByte;
6755   Row: Integer;
6756
6757   FormatDesc: TFormatDescriptor;
6758 begin
6759   result := false;
6760
6761   if not init_libJPEG then
6762     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6763
6764   try
6765     // reading first two bytes to test file and set cursor back to begin
6766     StreamPos := aStream.Position;
6767     aStream.Read({%H-}Temp[0], 2);
6768     aStream.Position := StreamPos;
6769
6770     // if Bitmap then read file.
6771     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6772       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6773       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6774
6775       // error managment
6776       jpeg.err := jpeg_std_error(@jpeg_err);
6777       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6778       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6779
6780       // decompression struct
6781       jpeg_create_decompress(@jpeg);
6782
6783       // allocation space for streaming methods
6784       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6785
6786       // seeting up custom functions
6787       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6788         pub.init_source       := glBitmap_libJPEG_init_source;
6789         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6790         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6791         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6792         pub.term_source       := glBitmap_libJPEG_term_source;
6793
6794         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6795         pub.next_input_byte := nil;   // until buffer loaded
6796
6797         SrcStream := aStream;
6798       end;
6799
6800       // set global decoding state
6801       jpeg.global_state := DSTATE_START;
6802
6803       // read header of jpeg
6804       jpeg_read_header(@jpeg, false);
6805
6806       // setting output parameter
6807       case jpeg.jpeg_color_space of
6808         JCS_GRAYSCALE:
6809           begin
6810             jpeg.out_color_space := JCS_GRAYSCALE;
6811             IntFormat := tfLuminance8ub1;
6812           end;
6813         else
6814           jpeg.out_color_space := JCS_RGB;
6815           IntFormat := tfRGB8ub3;
6816       end;
6817
6818       // reading image
6819       jpeg_start_decompress(@jpeg);
6820
6821       TempHeight := jpeg.output_height;
6822       TempWidth := jpeg.output_width;
6823
6824       FormatDesc := TFormatDescriptor.Get(IntFormat);
6825
6826       // creating new image
6827       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6828       try
6829         pTemp := pImage;
6830
6831         for Row := 0 to TempHeight -1 do begin
6832           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6833           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6834         end;
6835
6836         // finish decompression
6837         jpeg_finish_decompress(@jpeg);
6838
6839         // destroy decompression
6840         jpeg_destroy_decompress(@jpeg);
6841
6842         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6843
6844         result := true;
6845       except
6846         if Assigned(pImage) then
6847           FreeMem(pImage);
6848         raise;
6849       end;
6850     end;
6851   finally
6852     quit_libJPEG;
6853   end;
6854 end;
6855
6856 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6858 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6859 var
6860   bmp: TBitmap;
6861   jpg: TJPEGImage;
6862   StreamPos: Int64;
6863   Temp: array[0..1]of Byte;
6864 begin
6865   result := false;
6866
6867   // reading first two bytes to test file and set cursor back to begin
6868   StreamPos := aStream.Position;
6869   aStream.Read(Temp[0], 2);
6870   aStream.Position := StreamPos;
6871
6872   // if Bitmap then read file.
6873   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6874     bmp := TBitmap.Create;
6875     try
6876       jpg := TJPEGImage.Create;
6877       try
6878         jpg.LoadFromStream(aStream);
6879         bmp.Assign(jpg);
6880         result := AssignFromBitmap(bmp);
6881       finally
6882         jpg.Free;
6883       end;
6884     finally
6885       bmp.Free;
6886     end;
6887   end;
6888 end;
6889 {$IFEND}
6890 {$ENDIF}
6891
6892 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6893 {$IF DEFINED(GLB_LAZ_JPEG)}
6894 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6895 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6896 var
6897   jpeg: TJPEGImage;
6898   intf: TLazIntfImage;
6899   raw: TRawImage;
6900 begin
6901   jpeg := TJPEGImage.Create;
6902   intf := TLazIntfImage.Create(0, 0);
6903   try
6904     if not AssignToLazIntfImage(intf) then
6905       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6906     intf.GetRawImage(raw);
6907     jpeg.LoadFromRawImage(raw, false);
6908     jpeg.SaveToStream(aStream);
6909   finally
6910     intf.Free;
6911     jpeg.Free;
6912   end;
6913 end;
6914
6915 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6917 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6918 var
6919   jpeg: jpeg_compress_struct;
6920   jpeg_err: jpeg_error_mgr;
6921   Row: Integer;
6922   pTemp, pTemp2: pByte;
6923
6924   procedure CopyRow(pDest, pSource: pByte);
6925   var
6926     X: Integer;
6927   begin
6928     for X := 0 to Width - 1 do begin
6929       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6930       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6931       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6932       Inc(pDest, 3);
6933       Inc(pSource, 3);
6934     end;
6935   end;
6936
6937 begin
6938   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6939     raise EglBitmapUnsupportedFormat.Create(Format);
6940
6941   if not init_libJPEG then
6942     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6943
6944   try
6945     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6946     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6947
6948     // error managment
6949     jpeg.err := jpeg_std_error(@jpeg_err);
6950     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6951     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6952
6953     // compression struct
6954     jpeg_create_compress(@jpeg);
6955
6956     // allocation space for streaming methods
6957     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6958
6959     // seeting up custom functions
6960     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6961       pub.init_destination    := glBitmap_libJPEG_init_destination;
6962       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6963       pub.term_destination    := glBitmap_libJPEG_term_destination;
6964
6965       pub.next_output_byte  := @DestBuffer[1];
6966       pub.free_in_buffer    := Length(DestBuffer);
6967
6968       DestStream := aStream;
6969     end;
6970
6971     // very important state
6972     jpeg.global_state := CSTATE_START;
6973     jpeg.image_width  := Width;
6974     jpeg.image_height := Height;
6975     case Format of
6976       tfAlpha8ub1, tfLuminance8ub1: begin
6977         jpeg.input_components := 1;
6978         jpeg.in_color_space   := JCS_GRAYSCALE;
6979       end;
6980       tfRGB8ub3, tfBGR8ub3: begin
6981         jpeg.input_components := 3;
6982         jpeg.in_color_space   := JCS_RGB;
6983       end;
6984     end;
6985
6986     jpeg_set_defaults(@jpeg);
6987     jpeg_set_quality(@jpeg, 95, true);
6988     jpeg_start_compress(@jpeg, true);
6989     pTemp := Data;
6990
6991     if Format = tfBGR8ub3 then
6992       GetMem(pTemp2, fRowSize)
6993     else
6994       pTemp2 := pTemp;
6995
6996     try
6997       for Row := 0 to jpeg.image_height -1 do begin
6998         // prepare row
6999         if Format = tfBGR8ub3 then
7000           CopyRow(pTemp2, pTemp)
7001         else
7002           pTemp2 := pTemp;
7003
7004         // write row
7005         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
7006         inc(pTemp, fRowSize);
7007       end;
7008     finally
7009       // free memory
7010       if Format = tfBGR8ub3 then
7011         FreeMem(pTemp2);
7012     end;
7013     jpeg_finish_compress(@jpeg);
7014     jpeg_destroy_compress(@jpeg);
7015   finally
7016     quit_libJPEG;
7017   end;
7018 end;
7019
7020 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
7021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7022 procedure TglBitmap.SaveJPEG(const aStream: TStream);
7023 var
7024   Bmp: TBitmap;
7025   Jpg: TJPEGImage;
7026 begin
7027   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
7028     raise EglBitmapUnsupportedFormat.Create(Format);
7029
7030   Bmp := TBitmap.Create;
7031   try
7032     Jpg := TJPEGImage.Create;
7033     try
7034       AssignToBitmap(Bmp);
7035       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
7036         Jpg.Grayscale   := true;
7037         Jpg.PixelFormat := jf8Bit;
7038       end;
7039       Jpg.Assign(Bmp);
7040       Jpg.SaveToStream(aStream);
7041     finally
7042       FreeAndNil(Jpg);
7043     end;
7044   finally
7045     FreeAndNil(Bmp);
7046   end;
7047 end;
7048 {$IFEND}
7049 {$ENDIF}
7050
7051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7052 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7054 type
7055   RawHeader = packed record
7056     Magic:        String[5];
7057     Version:      Byte;
7058     Width:        Integer;
7059     Height:       Integer;
7060     DataSize:     Integer;
7061     BitsPerPixel: Integer;
7062     Precision:    TglBitmapRec4ub;
7063     Shift:        TglBitmapRec4ub;
7064   end;
7065
7066 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7067 var
7068   header: RawHeader;
7069   StartPos: Int64;
7070   fd: TFormatDescriptor;
7071   buf: PByte;
7072 begin
7073   result := false;
7074   StartPos := aStream.Position;
7075   aStream.Read(header{%H-}, SizeOf(header));
7076   if (header.Magic <> 'glBMP') then begin
7077     aStream.Position := StartPos;
7078     exit;
7079   end;
7080
7081   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7082   if (fd.Format = tfEmpty) then
7083     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7084
7085   buf := GetMemory(header.DataSize);
7086   aStream.Read(buf^, header.DataSize);
7087   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7088
7089   result := true;
7090 end;
7091
7092 procedure TglBitmap.SaveRAW(const aStream: TStream);
7093 var
7094   header: RawHeader;
7095   fd: TFormatDescriptor;
7096 begin
7097   fd := TFormatDescriptor.Get(Format);
7098   header.Magic        := 'glBMP';
7099   header.Version      := 1;
7100   header.Width        := Width;
7101   header.Height       := Height;
7102   header.DataSize     := fd.GetSize(fDimension);
7103   header.BitsPerPixel := fd.BitsPerPixel;
7104   header.Precision    := fd.Precision;
7105   header.Shift        := fd.Shift;
7106   aStream.Write(header, SizeOf(header));
7107   aStream.Write(Data^,  header.DataSize);
7108 end;
7109
7110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7111 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7113 const
7114   BMP_MAGIC          = $4D42;
7115
7116   BMP_COMP_RGB       = 0;
7117   BMP_COMP_RLE8      = 1;
7118   BMP_COMP_RLE4      = 2;
7119   BMP_COMP_BITFIELDS = 3;
7120
7121 type
7122   TBMPHeader = packed record
7123     bfType: Word;
7124     bfSize: Cardinal;
7125     bfReserved1: Word;
7126     bfReserved2: Word;
7127     bfOffBits: Cardinal;
7128   end;
7129
7130   TBMPInfo = packed record
7131     biSize: Cardinal;
7132     biWidth: Longint;
7133     biHeight: Longint;
7134     biPlanes: Word;
7135     biBitCount: Word;
7136     biCompression: Cardinal;
7137     biSizeImage: Cardinal;
7138     biXPelsPerMeter: Longint;
7139     biYPelsPerMeter: Longint;
7140     biClrUsed: Cardinal;
7141     biClrImportant: Cardinal;
7142   end;
7143
7144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7145 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7146
7147   //////////////////////////////////////////////////////////////////////////////////////////////////
7148   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7149   begin
7150     result := tfEmpty;
7151     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7152     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7153
7154     //Read Compression
7155     case aInfo.biCompression of
7156       BMP_COMP_RLE4,
7157       BMP_COMP_RLE8: begin
7158         raise EglBitmap.Create('RLE compression is not supported');
7159       end;
7160       BMP_COMP_BITFIELDS: begin
7161         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7162           aStream.Read(aMask.r, SizeOf(aMask.r));
7163           aStream.Read(aMask.g, SizeOf(aMask.g));
7164           aStream.Read(aMask.b, SizeOf(aMask.b));
7165           aStream.Read(aMask.a, SizeOf(aMask.a));
7166         end else
7167           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7168       end;
7169     end;
7170
7171     //get suitable format
7172     case aInfo.biBitCount of
7173        8: result := tfLuminance8ub1;
7174       16: result := tfX1RGB5us1;
7175       24: result := tfBGR8ub3;
7176       32: result := tfXRGB8ui1;
7177     end;
7178   end;
7179
7180   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7181   var
7182     i, c: Integer;
7183     ColorTable: TbmpColorTable;
7184   begin
7185     result := nil;
7186     if (aInfo.biBitCount >= 16) then
7187       exit;
7188     aFormat := tfLuminance8ub1;
7189     c := aInfo.biClrUsed;
7190     if (c = 0) then
7191       c := 1 shl aInfo.biBitCount;
7192     SetLength(ColorTable, c);
7193     for i := 0 to c-1 do begin
7194       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7195       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7196         aFormat := tfRGB8ub3;
7197     end;
7198
7199     result := TbmpColorTableFormat.Create;
7200     result.BitsPerPixel := aInfo.biBitCount;
7201     result.ColorTable   := ColorTable;
7202     result.CalcValues;
7203   end;
7204
7205   //////////////////////////////////////////////////////////////////////////////////////////////////
7206   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7207   var
7208     FormatDesc: TFormatDescriptor;
7209   begin
7210     result := nil;
7211     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7212       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7213       if (FormatDesc.Format = tfEmpty) then
7214         exit;
7215       aFormat := FormatDesc.Format;
7216       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7217         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7218       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7219         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7220
7221       result := TbmpBitfieldFormat.Create;
7222       result.SetCustomValues(aInfo.biBitCount, aMask);
7223     end;
7224   end;
7225
7226 var
7227   //simple types
7228   StartPos: Int64;
7229   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7230   PaddingBuff: Cardinal;
7231   LineBuf, ImageData, TmpData: PByte;
7232   SourceMD, DestMD: Pointer;
7233   BmpFormat: TglBitmapFormat;
7234
7235   //records
7236   Mask: TglBitmapRec4ul;
7237   Header: TBMPHeader;
7238   Info: TBMPInfo;
7239
7240   //classes
7241   SpecialFormat: TFormatDescriptor;
7242   FormatDesc: TFormatDescriptor;
7243
7244   //////////////////////////////////////////////////////////////////////////////////////////////////
7245   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7246   var
7247     i: Integer;
7248     Pixel: TglBitmapPixelData;
7249   begin
7250     aStream.Read(aLineBuf^, rbLineSize);
7251     SpecialFormat.PreparePixel(Pixel);
7252     for i := 0 to Info.biWidth-1 do begin
7253       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7254       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7255       FormatDesc.Map(Pixel, aData, DestMD);
7256     end;
7257   end;
7258
7259 begin
7260   result        := false;
7261   BmpFormat     := tfEmpty;
7262   SpecialFormat := nil;
7263   LineBuf       := nil;
7264   SourceMD      := nil;
7265   DestMD        := nil;
7266
7267   // Header
7268   StartPos := aStream.Position;
7269   aStream.Read(Header{%H-}, SizeOf(Header));
7270
7271   if Header.bfType = BMP_MAGIC then begin
7272     try try
7273       BmpFormat        := ReadInfo(Info, Mask);
7274       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7275       if not Assigned(SpecialFormat) then
7276         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7277       aStream.Position := StartPos + Header.bfOffBits;
7278
7279       if (BmpFormat <> tfEmpty) then begin
7280         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7281         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7282         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7283         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7284
7285         //get Memory
7286         DestMD    := FormatDesc.CreateMappingData;
7287         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7288         GetMem(ImageData, ImageSize);
7289         if Assigned(SpecialFormat) then begin
7290           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7291           SourceMD := SpecialFormat.CreateMappingData;
7292         end;
7293
7294         //read Data
7295         try try
7296           FillChar(ImageData^, ImageSize, $FF);
7297           TmpData := ImageData;
7298           if (Info.biHeight > 0) then
7299             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7300           for i := 0 to Abs(Info.biHeight)-1 do begin
7301             if Assigned(SpecialFormat) then
7302               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7303             else
7304               aStream.Read(TmpData^, wbLineSize);   //else only read data
7305             if (Info.biHeight > 0) then
7306               dec(TmpData, wbLineSize)
7307             else
7308               inc(TmpData, wbLineSize);
7309             aStream.Read(PaddingBuff{%H-}, Padding);
7310           end;
7311           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7312           result := true;
7313         finally
7314           if Assigned(LineBuf) then
7315             FreeMem(LineBuf);
7316           if Assigned(SourceMD) then
7317             SpecialFormat.FreeMappingData(SourceMD);
7318           FormatDesc.FreeMappingData(DestMD);
7319         end;
7320         except
7321           if Assigned(ImageData) then
7322             FreeMem(ImageData);
7323           raise;
7324         end;
7325       end else
7326         raise EglBitmap.Create('LoadBMP - No suitable format found');
7327     except
7328       aStream.Position := StartPos;
7329       raise;
7330     end;
7331     finally
7332       FreeAndNil(SpecialFormat);
7333     end;
7334   end
7335     else aStream.Position := StartPos;
7336 end;
7337
7338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7339 procedure TglBitmap.SaveBMP(const aStream: TStream);
7340 var
7341   Header: TBMPHeader;
7342   Info: TBMPInfo;
7343   Converter: TFormatDescriptor;
7344   FormatDesc: TFormatDescriptor;
7345   SourceFD, DestFD: Pointer;
7346   pData, srcData, dstData, ConvertBuffer: pByte;
7347
7348   Pixel: TglBitmapPixelData;
7349   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7350   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7351
7352   PaddingBuff: Cardinal;
7353
7354   function GetLineWidth : Integer;
7355   begin
7356     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7357   end;
7358
7359 begin
7360   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7361     raise EglBitmapUnsupportedFormat.Create(Format);
7362
7363   Converter  := nil;
7364   FormatDesc := TFormatDescriptor.Get(Format);
7365   ImageSize  := FormatDesc.GetSize(Dimension);
7366
7367   FillChar(Header{%H-}, SizeOf(Header), 0);
7368   Header.bfType      := BMP_MAGIC;
7369   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7370   Header.bfReserved1 := 0;
7371   Header.bfReserved2 := 0;
7372   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7373
7374   FillChar(Info{%H-}, SizeOf(Info), 0);
7375   Info.biSize        := SizeOf(Info);
7376   Info.biWidth       := Width;
7377   Info.biHeight      := Height;
7378   Info.biPlanes      := 1;
7379   Info.biCompression := BMP_COMP_RGB;
7380   Info.biSizeImage   := ImageSize;
7381
7382   try
7383     case Format of
7384       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7385       begin
7386         Info.biBitCount  :=  8;
7387         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7388         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7389         Converter := TbmpColorTableFormat.Create;
7390         with (Converter as TbmpColorTableFormat) do begin
7391           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7392           CreateColorTable;
7393         end;
7394       end;
7395
7396       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7397       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7398       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7399       begin
7400         Info.biBitCount    := 16;
7401         Info.biCompression := BMP_COMP_BITFIELDS;
7402       end;
7403
7404       tfBGR8ub3, tfRGB8ub3:
7405       begin
7406         Info.biBitCount := 24;
7407         if (Format = tfRGB8ub3) then
7408           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7409       end;
7410
7411       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7412       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7413       begin
7414         Info.biBitCount    := 32;
7415         Info.biCompression := BMP_COMP_BITFIELDS;
7416       end;
7417     else
7418       raise EglBitmapUnsupportedFormat.Create(Format);
7419     end;
7420     Info.biXPelsPerMeter := 2835;
7421     Info.biYPelsPerMeter := 2835;
7422
7423     // prepare bitmasks
7424     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7425       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7426       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7427
7428       RedMask    := FormatDesc.Mask.r;
7429       GreenMask  := FormatDesc.Mask.g;
7430       BlueMask   := FormatDesc.Mask.b;
7431       AlphaMask  := FormatDesc.Mask.a;
7432     end;
7433
7434     // headers
7435     aStream.Write(Header, SizeOf(Header));
7436     aStream.Write(Info, SizeOf(Info));
7437
7438     // colortable
7439     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7440       with (Converter as TbmpColorTableFormat) do
7441         aStream.Write(ColorTable[0].b,
7442           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7443
7444     // bitmasks
7445     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7446       aStream.Write(RedMask,   SizeOf(Cardinal));
7447       aStream.Write(GreenMask, SizeOf(Cardinal));
7448       aStream.Write(BlueMask,  SizeOf(Cardinal));
7449       aStream.Write(AlphaMask, SizeOf(Cardinal));
7450     end;
7451
7452     // image data
7453     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7454     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7455     Padding     := GetLineWidth - wbLineSize;
7456     PaddingBuff := 0;
7457
7458     pData := Data;
7459     inc(pData, (Height-1) * rbLineSize);
7460
7461     // prepare row buffer. But only for RGB because RGBA supports color masks
7462     // so it's possible to change color within the image.
7463     if Assigned(Converter) then begin
7464       FormatDesc.PreparePixel(Pixel);
7465       GetMem(ConvertBuffer, wbLineSize);
7466       SourceFD := FormatDesc.CreateMappingData;
7467       DestFD   := Converter.CreateMappingData;
7468     end else
7469       ConvertBuffer := nil;
7470
7471     try
7472       for LineIdx := 0 to Height - 1 do begin
7473         // preparing row
7474         if Assigned(Converter) then begin
7475           srcData := pData;
7476           dstData := ConvertBuffer;
7477           for PixelIdx := 0 to Info.biWidth-1 do begin
7478             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7479             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7480             Converter.Map(Pixel, dstData, DestFD);
7481           end;
7482           aStream.Write(ConvertBuffer^, wbLineSize);
7483         end else begin
7484           aStream.Write(pData^, rbLineSize);
7485         end;
7486         dec(pData, rbLineSize);
7487         if (Padding > 0) then
7488           aStream.Write(PaddingBuff, Padding);
7489       end;
7490     finally
7491       // destroy row buffer
7492       if Assigned(ConvertBuffer) then begin
7493         FormatDesc.FreeMappingData(SourceFD);
7494         Converter.FreeMappingData(DestFD);
7495         FreeMem(ConvertBuffer);
7496       end;
7497     end;
7498   finally
7499     if Assigned(Converter) then
7500       Converter.Free;
7501   end;
7502 end;
7503
7504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7505 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7507 type
7508   TTGAHeader = packed record
7509     ImageID: Byte;
7510     ColorMapType: Byte;
7511     ImageType: Byte;
7512     //ColorMapSpec: Array[0..4] of Byte;
7513     ColorMapStart: Word;
7514     ColorMapLength: Word;
7515     ColorMapEntrySize: Byte;
7516     OrigX: Word;
7517     OrigY: Word;
7518     Width: Word;
7519     Height: Word;
7520     Bpp: Byte;
7521     ImageDesc: Byte;
7522   end;
7523
7524 const
7525   TGA_UNCOMPRESSED_RGB  =  2;
7526   TGA_UNCOMPRESSED_GRAY =  3;
7527   TGA_COMPRESSED_RGB    = 10;
7528   TGA_COMPRESSED_GRAY   = 11;
7529
7530   TGA_NONE_COLOR_TABLE  = 0;
7531
7532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7533 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7534 var
7535   Header: TTGAHeader;
7536   ImageData: System.PByte;
7537   StartPosition: Int64;
7538   PixelSize, LineSize: Integer;
7539   tgaFormat: TglBitmapFormat;
7540   FormatDesc: TFormatDescriptor;
7541   Counter: packed record
7542     X, Y: packed record
7543       low, high, dir: Integer;
7544     end;
7545   end;
7546
7547 const
7548   CACHE_SIZE = $4000;
7549
7550   ////////////////////////////////////////////////////////////////////////////////////////
7551   procedure ReadUncompressed;
7552   var
7553     i, j: Integer;
7554     buf, tmp1, tmp2: System.PByte;
7555   begin
7556     buf := nil;
7557     if (Counter.X.dir < 0) then
7558       GetMem(buf, LineSize);
7559     try
7560       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7561         tmp1 := ImageData;
7562         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7563         if (Counter.X.dir < 0) then begin               //flip X
7564           aStream.Read(buf^, LineSize);
7565           tmp2 := buf;
7566           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7567           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7568             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7569               tmp1^ := tmp2^;
7570               inc(tmp1);
7571               inc(tmp2);
7572             end;
7573             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7574           end;
7575         end else
7576           aStream.Read(tmp1^, LineSize);
7577         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7578       end;
7579     finally
7580       if Assigned(buf) then
7581         FreeMem(buf);
7582     end;
7583   end;
7584
7585   ////////////////////////////////////////////////////////////////////////////////////////
7586   procedure ReadCompressed;
7587
7588     /////////////////////////////////////////////////////////////////
7589     var
7590       TmpData: System.PByte;
7591       LinePixelsRead: Integer;
7592     procedure CheckLine;
7593     begin
7594       if (LinePixelsRead >= Header.Width) then begin
7595         LinePixelsRead := 0;
7596         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7597         TmpData := ImageData;
7598         inc(TmpData, Counter.Y.low * LineSize);           //set line
7599         if (Counter.X.dir < 0) then                       //if x flipped then
7600           inc(TmpData, LineSize - PixelSize);             //set last pixel
7601       end;
7602     end;
7603
7604     /////////////////////////////////////////////////////////////////
7605     var
7606       Cache: PByte;
7607       CacheSize, CachePos: Integer;
7608     procedure CachedRead(out Buffer; Count: Integer);
7609     var
7610       BytesRead: Integer;
7611     begin
7612       if (CachePos + Count > CacheSize) then begin
7613         //if buffer overflow save non read bytes
7614         BytesRead := 0;
7615         if (CacheSize - CachePos > 0) then begin
7616           BytesRead := CacheSize - CachePos;
7617           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7618           inc(CachePos, BytesRead);
7619         end;
7620
7621         //load cache from file
7622         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7623         aStream.Read(Cache^, CacheSize);
7624         CachePos := 0;
7625
7626         //read rest of requested bytes
7627         if (Count - BytesRead > 0) then begin
7628           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7629           inc(CachePos, Count - BytesRead);
7630         end;
7631       end else begin
7632         //if no buffer overflow just read the data
7633         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7634         inc(CachePos, Count);
7635       end;
7636     end;
7637
7638     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7639     begin
7640       case PixelSize of
7641         1: begin
7642           aBuffer^ := aData^;
7643           inc(aBuffer, Counter.X.dir);
7644         end;
7645         2: begin
7646           PWord(aBuffer)^ := PWord(aData)^;
7647           inc(aBuffer, 2 * Counter.X.dir);
7648         end;
7649         3: begin
7650           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7651           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7652           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7653           inc(aBuffer, 3 * Counter.X.dir);
7654         end;
7655         4: begin
7656           PCardinal(aBuffer)^ := PCardinal(aData)^;
7657           inc(aBuffer, 4 * Counter.X.dir);
7658         end;
7659       end;
7660     end;
7661
7662   var
7663     TotalPixelsToRead, TotalPixelsRead: Integer;
7664     Temp: Byte;
7665     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7666     PixelRepeat: Boolean;
7667     PixelsToRead, PixelCount: Integer;
7668   begin
7669     CacheSize := 0;
7670     CachePos  := 0;
7671
7672     TotalPixelsToRead := Header.Width * Header.Height;
7673     TotalPixelsRead   := 0;
7674     LinePixelsRead    := 0;
7675
7676     GetMem(Cache, CACHE_SIZE);
7677     try
7678       TmpData := ImageData;
7679       inc(TmpData, Counter.Y.low * LineSize);           //set line
7680       if (Counter.X.dir < 0) then                       //if x flipped then
7681         inc(TmpData, LineSize - PixelSize);             //set last pixel
7682
7683       repeat
7684         //read CommandByte
7685         CachedRead(Temp, 1);
7686         PixelRepeat  := (Temp and $80) > 0;
7687         PixelsToRead := (Temp and $7F) + 1;
7688         inc(TotalPixelsRead, PixelsToRead);
7689
7690         if PixelRepeat then
7691           CachedRead(buf[0], PixelSize);
7692         while (PixelsToRead > 0) do begin
7693           CheckLine;
7694           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7695           while (PixelCount > 0) do begin
7696             if not PixelRepeat then
7697               CachedRead(buf[0], PixelSize);
7698             PixelToBuffer(@buf[0], TmpData);
7699             inc(LinePixelsRead);
7700             dec(PixelsToRead);
7701             dec(PixelCount);
7702           end;
7703         end;
7704       until (TotalPixelsRead >= TotalPixelsToRead);
7705     finally
7706       FreeMem(Cache);
7707     end;
7708   end;
7709
7710   function IsGrayFormat: Boolean;
7711   begin
7712     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7713   end;
7714
7715 begin
7716   result := false;
7717
7718   // reading header to test file and set cursor back to begin
7719   StartPosition := aStream.Position;
7720   aStream.Read(Header{%H-}, SizeOf(Header));
7721
7722   // no colormapped files
7723   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7724     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7725   begin
7726     try
7727       if Header.ImageID <> 0 then       // skip image ID
7728         aStream.Position := aStream.Position + Header.ImageID;
7729
7730       tgaFormat := tfEmpty;
7731       case Header.Bpp of
7732          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7733                0: tgaFormat := tfLuminance8ub1;
7734                8: tgaFormat := tfAlpha8ub1;
7735             end;
7736
7737         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7738                0: tgaFormat := tfLuminance16us1;
7739                8: tgaFormat := tfLuminance8Alpha8ub2;
7740             end else case (Header.ImageDesc and $F) of
7741                0: tgaFormat := tfX1RGB5us1;
7742                1: tgaFormat := tfA1RGB5us1;
7743                4: tgaFormat := tfARGB4us1;
7744             end;
7745
7746         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7747                0: tgaFormat := tfBGR8ub3;
7748             end;
7749
7750         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7751                0: tgaFormat := tfDepth32ui1;
7752             end else case (Header.ImageDesc and $F) of
7753                0: tgaFormat := tfX2RGB10ui1;
7754                2: tgaFormat := tfA2RGB10ui1;
7755                8: tgaFormat := tfARGB8ui1;
7756             end;
7757       end;
7758
7759       if (tgaFormat = tfEmpty) then
7760         raise EglBitmap.Create('LoadTga - unsupported format');
7761
7762       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7763       PixelSize  := FormatDesc.GetSize(1, 1);
7764       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7765
7766       GetMem(ImageData, LineSize * Header.Height);
7767       try
7768         //column direction
7769         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7770           Counter.X.low  := Header.Height-1;;
7771           Counter.X.high := 0;
7772           Counter.X.dir  := -1;
7773         end else begin
7774           Counter.X.low  := 0;
7775           Counter.X.high := Header.Height-1;
7776           Counter.X.dir  := 1;
7777         end;
7778
7779         // Row direction
7780         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7781           Counter.Y.low  := 0;
7782           Counter.Y.high := Header.Height-1;
7783           Counter.Y.dir  := 1;
7784         end else begin
7785           Counter.Y.low  := Header.Height-1;;
7786           Counter.Y.high := 0;
7787           Counter.Y.dir  := -1;
7788         end;
7789
7790         // Read Image
7791         case Header.ImageType of
7792           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7793             ReadUncompressed;
7794           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7795             ReadCompressed;
7796         end;
7797
7798         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7799         result := true;
7800       except
7801         if Assigned(ImageData) then
7802           FreeMem(ImageData);
7803         raise;
7804       end;
7805     finally
7806       aStream.Position := StartPosition;
7807     end;
7808   end
7809     else aStream.Position := StartPosition;
7810 end;
7811
7812 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7813 procedure TglBitmap.SaveTGA(const aStream: TStream);
7814 var
7815   Header: TTGAHeader;
7816   Size: Integer;
7817   FormatDesc: TFormatDescriptor;
7818 begin
7819   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7820     raise EglBitmapUnsupportedFormat.Create(Format);
7821
7822   //prepare header
7823   FormatDesc := TFormatDescriptor.Get(Format);
7824   FillChar(Header{%H-}, SizeOf(Header), 0);
7825   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
7826   Header.Bpp       := FormatDesc.BitsPerPixel;
7827   Header.Width     := Width;
7828   Header.Height    := Height;
7829   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7830   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
7831     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7832   else
7833     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7834   aStream.Write(Header, SizeOf(Header));
7835
7836   // write Data
7837   Size := FormatDesc.GetSize(Dimension);
7838   aStream.Write(Data^, Size);
7839 end;
7840
7841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7842 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7844 const
7845   DDS_MAGIC: Cardinal         = $20534444;
7846
7847   // DDS_header.dwFlags
7848   DDSD_CAPS                   = $00000001;
7849   DDSD_HEIGHT                 = $00000002;
7850   DDSD_WIDTH                  = $00000004;
7851   DDSD_PIXELFORMAT            = $00001000;
7852
7853   // DDS_header.sPixelFormat.dwFlags
7854   DDPF_ALPHAPIXELS            = $00000001;
7855   DDPF_ALPHA                  = $00000002;
7856   DDPF_FOURCC                 = $00000004;
7857   DDPF_RGB                    = $00000040;
7858   DDPF_LUMINANCE              = $00020000;
7859
7860   // DDS_header.sCaps.dwCaps1
7861   DDSCAPS_TEXTURE             = $00001000;
7862
7863   // DDS_header.sCaps.dwCaps2
7864   DDSCAPS2_CUBEMAP            = $00000200;
7865
7866   D3DFMT_DXT1                 = $31545844;
7867   D3DFMT_DXT3                 = $33545844;
7868   D3DFMT_DXT5                 = $35545844;
7869
7870 type
7871   TDDSPixelFormat = packed record
7872     dwSize: Cardinal;
7873     dwFlags: Cardinal;
7874     dwFourCC: Cardinal;
7875     dwRGBBitCount: Cardinal;
7876     dwRBitMask: Cardinal;
7877     dwGBitMask: Cardinal;
7878     dwBBitMask: Cardinal;
7879     dwABitMask: Cardinal;
7880   end;
7881
7882   TDDSCaps = packed record
7883     dwCaps1: Cardinal;
7884     dwCaps2: Cardinal;
7885     dwDDSX: Cardinal;
7886     dwReserved: Cardinal;
7887   end;
7888
7889   TDDSHeader = packed record
7890     dwSize: Cardinal;
7891     dwFlags: Cardinal;
7892     dwHeight: Cardinal;
7893     dwWidth: Cardinal;
7894     dwPitchOrLinearSize: Cardinal;
7895     dwDepth: Cardinal;
7896     dwMipMapCount: Cardinal;
7897     dwReserved: array[0..10] of Cardinal;
7898     PixelFormat: TDDSPixelFormat;
7899     Caps: TDDSCaps;
7900     dwReserved2: Cardinal;
7901   end;
7902
7903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7904 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7905 var
7906   Header: TDDSHeader;
7907   Converter: TbmpBitfieldFormat;
7908
7909   function GetDDSFormat: TglBitmapFormat;
7910   var
7911     fd: TFormatDescriptor;
7912     i: Integer;
7913     Mask: TglBitmapRec4ul;
7914     Range: TglBitmapRec4ui;
7915     match: Boolean;
7916   begin
7917     result := tfEmpty;
7918     with Header.PixelFormat do begin
7919       // Compresses
7920       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7921         case Header.PixelFormat.dwFourCC of
7922           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7923           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7924           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7925         end;
7926       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
7927         // prepare masks
7928         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
7929           Mask.r := dwRBitMask;
7930           Mask.g := dwGBitMask;
7931           Mask.b := dwBBitMask;
7932         end else begin
7933           Mask.r := dwRBitMask;
7934           Mask.g := dwRBitMask;
7935           Mask.b := dwRBitMask;
7936         end;
7937         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
7938           Mask.a := dwABitMask
7939         else
7940           Mask.a := 0;;
7941
7942         //find matching format
7943         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
7944         result := fd.Format;
7945         if (result <> tfEmpty) then
7946           exit;
7947
7948         //find format with same Range
7949         for i := 0 to 3 do
7950           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
7951         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7952           fd := TFormatDescriptor.Get(result);
7953           match := true;
7954           for i := 0 to 3 do
7955             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7956               match := false;
7957               break;
7958             end;
7959           if match then
7960             break;
7961         end;
7962
7963         //no format with same range found -> use default
7964         if (result = tfEmpty) then begin
7965           if (dwABitMask > 0) then
7966             result := tfRGBA8ui1
7967           else
7968             result := tfRGB8ub3;
7969         end;
7970
7971         Converter := TbmpBitfieldFormat.Create;
7972         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
7973       end;
7974     end;
7975   end;
7976
7977 var
7978   StreamPos: Int64;
7979   x, y, LineSize, RowSize, Magic: Cardinal;
7980   NewImage, TmpData, RowData, SrcData: System.PByte;
7981   SourceMD, DestMD: Pointer;
7982   Pixel: TglBitmapPixelData;
7983   ddsFormat: TglBitmapFormat;
7984   FormatDesc: TFormatDescriptor;
7985
7986 begin
7987   result    := false;
7988   Converter := nil;
7989   StreamPos := aStream.Position;
7990
7991   // Magic
7992   aStream.Read(Magic{%H-}, sizeof(Magic));
7993   if (Magic <> DDS_MAGIC) then begin
7994     aStream.Position := StreamPos;
7995     exit;
7996   end;
7997
7998   //Header
7999   aStream.Read(Header{%H-}, sizeof(Header));
8000   if (Header.dwSize <> SizeOf(Header)) or
8001      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
8002         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
8003   begin
8004     aStream.Position := StreamPos;
8005     exit;
8006   end;
8007
8008   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
8009     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
8010
8011   ddsFormat := GetDDSFormat;
8012   try
8013     if (ddsFormat = tfEmpty) then
8014       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8015
8016     FormatDesc := TFormatDescriptor.Get(ddsFormat);
8017     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
8018     GetMem(NewImage, Header.dwHeight * LineSize);
8019     try
8020       TmpData := NewImage;
8021
8022       //Converter needed
8023       if Assigned(Converter) then begin
8024         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
8025         GetMem(RowData, RowSize);
8026         SourceMD := Converter.CreateMappingData;
8027         DestMD   := FormatDesc.CreateMappingData;
8028         try
8029           for y := 0 to Header.dwHeight-1 do begin
8030             TmpData := NewImage;
8031             inc(TmpData, y * LineSize);
8032             SrcData := RowData;
8033             aStream.Read(SrcData^, RowSize);
8034             for x := 0 to Header.dwWidth-1 do begin
8035               Converter.Unmap(SrcData, Pixel, SourceMD);
8036               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
8037               FormatDesc.Map(Pixel, TmpData, DestMD);
8038             end;
8039           end;
8040         finally
8041           Converter.FreeMappingData(SourceMD);
8042           FormatDesc.FreeMappingData(DestMD);
8043           FreeMem(RowData);
8044         end;
8045       end else
8046
8047       // Compressed
8048       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
8049         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
8050         for Y := 0 to Header.dwHeight-1 do begin
8051           aStream.Read(TmpData^, RowSize);
8052           Inc(TmpData, LineSize);
8053         end;
8054       end else
8055
8056       // Uncompressed
8057       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
8058         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
8059         for Y := 0 to Header.dwHeight-1 do begin
8060           aStream.Read(TmpData^, RowSize);
8061           Inc(TmpData, LineSize);
8062         end;
8063       end else
8064         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8065
8066       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8067       result := true;
8068     except
8069       if Assigned(NewImage) then
8070         FreeMem(NewImage);
8071       raise;
8072     end;
8073   finally
8074     FreeAndNil(Converter);
8075   end;
8076 end;
8077
8078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8079 procedure TglBitmap.SaveDDS(const aStream: TStream);
8080 var
8081   Header: TDDSHeader;
8082   FormatDesc: TFormatDescriptor;
8083 begin
8084   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8085     raise EglBitmapUnsupportedFormat.Create(Format);
8086
8087   FormatDesc := TFormatDescriptor.Get(Format);
8088
8089   // Generell
8090   FillChar(Header{%H-}, SizeOf(Header), 0);
8091   Header.dwSize  := SizeOf(Header);
8092   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8093
8094   Header.dwWidth  := Max(1, Width);
8095   Header.dwHeight := Max(1, Height);
8096
8097   // Caps
8098   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8099
8100   // Pixelformat
8101   Header.PixelFormat.dwSize := sizeof(Header);
8102   if (FormatDesc.IsCompressed) then begin
8103     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8104     case Format of
8105       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8106       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8107       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8108     end;
8109   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8110     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8111     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8112     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8113   end else if FormatDesc.IsGrayscale then begin
8114     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8115     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8116     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8117     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8118   end else begin
8119     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8120     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8121     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8122     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8123     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8124     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8125   end;
8126
8127   if (FormatDesc.HasAlpha) then
8128     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8129
8130   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8131   aStream.Write(Header, SizeOf(Header));
8132   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8133 end;
8134
8135 {$IFNDEF OPENGL_ES}
8136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8137 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8139 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8140   const aWidth: Integer; const aHeight: Integer);
8141 var
8142   pTemp: pByte;
8143   Size: Integer;
8144 begin
8145   if (aHeight > 1) then begin
8146     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8147     GetMem(pTemp, Size);
8148     try
8149       Move(aData^, pTemp^, Size);
8150       FreeMem(aData);
8151       aData := nil;
8152     except
8153       FreeMem(pTemp);
8154       raise;
8155     end;
8156   end else
8157     pTemp := aData;
8158   inherited SetDataPointer(pTemp, aFormat, aWidth);
8159 end;
8160
8161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8162 function TglBitmap1D.FlipHorz: Boolean;
8163 var
8164   Col: Integer;
8165   pTempDest, pDest, pSource: PByte;
8166 begin
8167   result := inherited FlipHorz;
8168   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8169     pSource := Data;
8170     GetMem(pDest, fRowSize);
8171     try
8172       pTempDest := pDest;
8173       Inc(pTempDest, fRowSize);
8174       for Col := 0 to Width-1 do begin
8175         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8176         Move(pSource^, pTempDest^, fPixelSize);
8177         Inc(pSource, fPixelSize);
8178       end;
8179       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8180       result := true;
8181     except
8182       if Assigned(pDest) then
8183         FreeMem(pDest);
8184       raise;
8185     end;
8186   end;
8187 end;
8188
8189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8190 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8191 var
8192   FormatDesc: TFormatDescriptor;
8193 begin
8194   // Upload data
8195   FormatDesc := TFormatDescriptor.Get(Format);
8196   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8197     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8198
8199   if FormatDesc.IsCompressed then begin
8200     if not Assigned(glCompressedTexImage1D) then
8201       raise EglBitmap.Create('compressed formats not supported by video adapter');
8202     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8203   end else if aBuildWithGlu then
8204     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8205   else
8206     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8207
8208   // Free Data
8209   if (FreeDataAfterGenTexture) then
8210     FreeData;
8211 end;
8212
8213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8214 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8215 var
8216   BuildWithGlu, TexRec: Boolean;
8217   TexSize: Integer;
8218 begin
8219   if Assigned(Data) then begin
8220     // Check Texture Size
8221     if (aTestTextureSize) then begin
8222       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8223
8224       if (Width > TexSize) then
8225         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8226
8227       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8228                 (Target = GL_TEXTURE_RECTANGLE);
8229       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8230         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8231     end;
8232
8233     CreateId;
8234     SetupParameters(BuildWithGlu);
8235     UploadData(BuildWithGlu);
8236     glAreTexturesResident(1, @fID, @fIsResident);
8237   end;
8238 end;
8239
8240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8241 procedure TglBitmap1D.AfterConstruction;
8242 begin
8243   inherited;
8244   Target := GL_TEXTURE_1D;
8245 end;
8246 {$ENDIF}
8247
8248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8249 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8251 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8252 begin
8253   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8254     result := fLines[aIndex]
8255   else
8256     result := nil;
8257 end;
8258
8259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8260 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8261   const aWidth: Integer; const aHeight: Integer);
8262 var
8263   Idx, LineWidth: Integer;
8264 begin
8265   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8266
8267   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8268     // Assigning Data
8269     if Assigned(Data) then begin
8270       SetLength(fLines, GetHeight);
8271       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8272
8273       for Idx := 0 to GetHeight-1 do begin
8274         fLines[Idx] := Data;
8275         Inc(fLines[Idx], Idx * LineWidth);
8276       end;
8277     end
8278       else SetLength(fLines, 0);
8279   end else begin
8280     SetLength(fLines, 0);
8281   end;
8282 end;
8283
8284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8285 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8286 var
8287   FormatDesc: TFormatDescriptor;
8288 begin
8289   FormatDesc := TFormatDescriptor.Get(Format);
8290   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8291     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8292
8293   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8294
8295   if FormatDesc.IsCompressed then begin
8296     if not Assigned(glCompressedTexImage2D) then
8297       raise EglBitmap.Create('compressed formats not supported by video adapter');
8298     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8299 {$IFNDEF OPENGL_ES}
8300   end else if aBuildWithGlu then begin
8301     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8302       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8303 {$ENDIF}
8304   end else begin
8305     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8306       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8307   end;
8308
8309   // Freigeben
8310   if (FreeDataAfterGenTexture) then
8311     FreeData;
8312 end;
8313
8314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8315 procedure TglBitmap2D.AfterConstruction;
8316 begin
8317   inherited;
8318   Target := GL_TEXTURE_2D;
8319 end;
8320
8321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8322 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8323 var
8324   Temp: pByte;
8325   Size, w, h: Integer;
8326   FormatDesc: TFormatDescriptor;
8327 begin
8328   FormatDesc := TFormatDescriptor.Get(aFormat);
8329   if FormatDesc.IsCompressed then
8330     raise EglBitmapUnsupportedFormat.Create(aFormat);
8331
8332   w    := aRight  - aLeft;
8333   h    := aBottom - aTop;
8334   Size := FormatDesc.GetSize(w, h);
8335   GetMem(Temp, Size);
8336   try
8337     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8338     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8339     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8340     FlipVert;
8341   except
8342     if Assigned(Temp) then
8343       FreeMem(Temp);
8344     raise;
8345   end;
8346 end;
8347
8348 {$IFNDEF OPENGL_ES}
8349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8350 procedure TglBitmap2D.GetDataFromTexture;
8351 var
8352   Temp: PByte;
8353   TempWidth, TempHeight: Integer;
8354   TempIntFormat: GLint;
8355   IntFormat: TglBitmapFormat;
8356   FormatDesc: TFormatDescriptor;
8357 begin
8358   Bind;
8359
8360   // Request Data
8361   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8362   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8363   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8364
8365   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8366   IntFormat  := FormatDesc.Format;
8367
8368   // Getting data from OpenGL
8369   FormatDesc := TFormatDescriptor.Get(IntFormat);
8370   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8371   try
8372     if FormatDesc.IsCompressed then begin
8373       if not Assigned(glGetCompressedTexImage) then
8374         raise EglBitmap.Create('compressed formats not supported by video adapter');
8375       glGetCompressedTexImage(Target, 0, Temp)
8376     end else
8377       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8378     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8379   except
8380     if Assigned(Temp) then
8381       FreeMem(Temp);
8382     raise;
8383   end;
8384 end;
8385 {$ENDIF}
8386
8387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8388 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8389 var
8390   {$IFNDEF OPENGL_ES}
8391   BuildWithGlu, TexRec: Boolean;
8392   {$ENDIF}
8393   PotTex: Boolean;
8394   TexSize: Integer;
8395 begin
8396   if Assigned(Data) then begin
8397     // Check Texture Size
8398     if (aTestTextureSize) then begin
8399       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8400
8401       if ((Height > TexSize) or (Width > TexSize)) then
8402         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8403
8404       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8405 {$IF NOT DEFINED(OPENGL_ES)}
8406       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8407       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8408         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8409 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8410       if not PotTex and not GL_OES_texture_npot then
8411         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8412 {$ELSE}
8413       if not PotTex then
8414         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8415 {$IFEND}
8416     end;
8417
8418     CreateId;
8419     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8420     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8421 {$IFNDEF OPENGL_ES}
8422     glAreTexturesResident(1, @fID, @fIsResident);
8423 {$ENDIF}
8424   end;
8425 end;
8426
8427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8428 function TglBitmap2D.FlipHorz: Boolean;
8429 var
8430   Col, Row: Integer;
8431   TempDestData, DestData, SourceData: PByte;
8432   ImgSize: Integer;
8433 begin
8434   result := inherited FlipHorz;
8435   if Assigned(Data) then begin
8436     SourceData := Data;
8437     ImgSize := Height * fRowSize;
8438     GetMem(DestData, ImgSize);
8439     try
8440       TempDestData := DestData;
8441       Dec(TempDestData, fRowSize + fPixelSize);
8442       for Row := 0 to Height -1 do begin
8443         Inc(TempDestData, fRowSize * 2);
8444         for Col := 0 to Width -1 do begin
8445           Move(SourceData^, TempDestData^, fPixelSize);
8446           Inc(SourceData, fPixelSize);
8447           Dec(TempDestData, fPixelSize);
8448         end;
8449       end;
8450       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8451       result := true;
8452     except
8453       if Assigned(DestData) then
8454         FreeMem(DestData);
8455       raise;
8456     end;
8457   end;
8458 end;
8459
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 function TglBitmap2D.FlipVert: Boolean;
8462 var
8463   Row: Integer;
8464   TempDestData, DestData, SourceData: PByte;
8465 begin
8466   result := inherited FlipVert;
8467   if Assigned(Data) then begin
8468     SourceData := Data;
8469     GetMem(DestData, Height * fRowSize);
8470     try
8471       TempDestData := DestData;
8472       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8473       for Row := 0 to Height -1 do begin
8474         Move(SourceData^, TempDestData^, fRowSize);
8475         Dec(TempDestData, fRowSize);
8476         Inc(SourceData, fRowSize);
8477       end;
8478       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8479       result := true;
8480     except
8481       if Assigned(DestData) then
8482         FreeMem(DestData);
8483       raise;
8484     end;
8485   end;
8486 end;
8487
8488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8489 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8491 type
8492   TMatrixItem = record
8493     X, Y: Integer;
8494     W: Single;
8495   end;
8496
8497   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8498   TglBitmapToNormalMapRec = Record
8499     Scale: Single;
8500     Heights: array of Single;
8501     MatrixU : array of TMatrixItem;
8502     MatrixV : array of TMatrixItem;
8503   end;
8504
8505 const
8506   ONE_OVER_255 = 1 / 255;
8507
8508   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8509 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8510 var
8511   Val: Single;
8512 begin
8513   with FuncRec do begin
8514     Val :=
8515       Source.Data.r * LUMINANCE_WEIGHT_R +
8516       Source.Data.g * LUMINANCE_WEIGHT_G +
8517       Source.Data.b * LUMINANCE_WEIGHT_B;
8518     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8519   end;
8520 end;
8521
8522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8523 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8524 begin
8525   with FuncRec do
8526     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8527 end;
8528
8529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8530 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8531 type
8532   TVec = Array[0..2] of Single;
8533 var
8534   Idx: Integer;
8535   du, dv: Double;
8536   Len: Single;
8537   Vec: TVec;
8538
8539   function GetHeight(X, Y: Integer): Single;
8540   begin
8541     with FuncRec do begin
8542       X := Max(0, Min(Size.X -1, X));
8543       Y := Max(0, Min(Size.Y -1, Y));
8544       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8545     end;
8546   end;
8547
8548 begin
8549   with FuncRec do begin
8550     with PglBitmapToNormalMapRec(Args)^ do begin
8551       du := 0;
8552       for Idx := Low(MatrixU) to High(MatrixU) do
8553         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8554
8555       dv := 0;
8556       for Idx := Low(MatrixU) to High(MatrixU) do
8557         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8558
8559       Vec[0] := -du * Scale;
8560       Vec[1] := -dv * Scale;
8561       Vec[2] := 1;
8562     end;
8563
8564     // Normalize
8565     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8566     if Len <> 0 then begin
8567       Vec[0] := Vec[0] * Len;
8568       Vec[1] := Vec[1] * Len;
8569       Vec[2] := Vec[2] * Len;
8570     end;
8571
8572     // Farbe zuweisem
8573     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8574     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8575     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8576   end;
8577 end;
8578
8579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8580 procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8581 var
8582   Rec: TglBitmapToNormalMapRec;
8583
8584   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8585   begin
8586     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8587       Matrix[Index].X := X;
8588       Matrix[Index].Y := Y;
8589       Matrix[Index].W := W;
8590     end;
8591   end;
8592
8593 begin
8594   if TFormatDescriptor.Get(Format).IsCompressed then
8595     raise EglBitmapUnsupportedFormat.Create(Format);
8596
8597   if aScale > 100 then
8598     Rec.Scale := 100
8599   else if aScale < -100 then
8600     Rec.Scale := -100
8601   else
8602     Rec.Scale := aScale;
8603
8604   SetLength(Rec.Heights, Width * Height);
8605   try
8606     case aFunc of
8607       nm4Samples: begin
8608         SetLength(Rec.MatrixU, 2);
8609         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8610         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8611
8612         SetLength(Rec.MatrixV, 2);
8613         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8614         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8615       end;
8616
8617       nmSobel: begin
8618         SetLength(Rec.MatrixU, 6);
8619         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8620         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8621         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8622         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8623         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8624         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8625
8626         SetLength(Rec.MatrixV, 6);
8627         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8628         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8629         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8630         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8631         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8632         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8633       end;
8634
8635       nm3x3: begin
8636         SetLength(Rec.MatrixU, 6);
8637         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8638         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8639         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8640         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8641         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8642         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8643
8644         SetLength(Rec.MatrixV, 6);
8645         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8646         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8647         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8648         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8649         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8650         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8651       end;
8652
8653       nm5x5: begin
8654         SetLength(Rec.MatrixU, 20);
8655         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8656         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8657         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8658         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8659         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8660         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8661         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8662         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8663         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8664         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8665         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8666         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8667         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8668         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8669         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8670         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8671         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8672         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8673         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8674         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8675
8676         SetLength(Rec.MatrixV, 20);
8677         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8678         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8679         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8680         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8681         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8682         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8683         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8684         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8685         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8686         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8687         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8688         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8689         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8690         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8691         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8692         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8693         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8694         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8695         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8696         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8697       end;
8698     end;
8699
8700     // Daten Sammeln
8701     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8702       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8703     else
8704       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
8705     Convert(glBitmapToNormalMapFunc, false, @Rec);
8706   finally
8707     SetLength(Rec.Heights, 0);
8708   end;
8709 end;
8710
8711 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8713 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8715 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8716 begin
8717   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8718 end;
8719
8720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8721 procedure TglBitmapCubeMap.AfterConstruction;
8722 begin
8723   inherited;
8724
8725 {$IFNDEF OPENGL_ES}
8726   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8727     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8728 {$ELSE}
8729   if not (GL_VERSION_2_0) then
8730     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8731 {$ENDIF}
8732
8733   SetWrap;
8734   Target   := GL_TEXTURE_CUBE_MAP;
8735 {$IFNDEF OPENGL_ES}
8736   fGenMode := GL_REFLECTION_MAP;
8737 {$ENDIF}
8738 end;
8739
8740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8741 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8742 var
8743   {$IFNDEF OPENGL_ES}
8744   BuildWithGlu: Boolean;
8745   {$ENDIF}
8746   TexSize: Integer;
8747 begin
8748   if (aTestTextureSize) then begin
8749     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8750
8751     if (Height > TexSize) or (Width > TexSize) then
8752       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8753
8754 {$IF NOT DEFINED(OPENGL_ES)}
8755     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8756       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8757 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8758     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
8759       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8760 {$ELSE}
8761     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
8762       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8763 {$IFEND}
8764   end;
8765
8766   if (ID = 0) then
8767     CreateID;
8768   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8769   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8770 end;
8771
8772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8773 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8774 begin
8775   inherited Bind (aEnableTextureUnit);
8776 {$IFNDEF OPENGL_ES}
8777   if aEnableTexCoordsGen then begin
8778     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8779     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8780     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8781     glEnable(GL_TEXTURE_GEN_S);
8782     glEnable(GL_TEXTURE_GEN_T);
8783     glEnable(GL_TEXTURE_GEN_R);
8784   end;
8785 {$ENDIF}
8786 end;
8787
8788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8789 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8790 begin
8791   inherited Unbind(aDisableTextureUnit);
8792 {$IFNDEF OPENGL_ES}
8793   if aDisableTexCoordsGen then begin
8794     glDisable(GL_TEXTURE_GEN_S);
8795     glDisable(GL_TEXTURE_GEN_T);
8796     glDisable(GL_TEXTURE_GEN_R);
8797   end;
8798 {$ENDIF}
8799 end;
8800 {$IFEND}
8801
8802 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8803 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8804 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8805 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8806 type
8807   TVec = Array[0..2] of Single;
8808   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8809
8810   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8811   TglBitmapNormalMapRec = record
8812     HalfSize : Integer;
8813     Func: TglBitmapNormalMapGetVectorFunc;
8814   end;
8815
8816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8817 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8818 begin
8819   aVec[0] := aHalfSize;
8820   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8821   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8822 end;
8823
8824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8825 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8826 begin
8827   aVec[0] := - aHalfSize;
8828   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8829   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8830 end;
8831
8832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8833 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8834 begin
8835   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8836   aVec[1] := aHalfSize;
8837   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8838 end;
8839
8840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8841 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8842 begin
8843   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8844   aVec[1] := - aHalfSize;
8845   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8846 end;
8847
8848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8849 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8850 begin
8851   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8852   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8853   aVec[2] := aHalfSize;
8854 end;
8855
8856 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8857 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8858 begin
8859   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8860   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8861   aVec[2] := - aHalfSize;
8862 end;
8863
8864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8865 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8866 var
8867   i: Integer;
8868   Vec: TVec;
8869   Len: Single;
8870 begin
8871   with FuncRec do begin
8872     with PglBitmapNormalMapRec(Args)^ do begin
8873       Func(Vec, Position, HalfSize);
8874
8875       // Normalize
8876       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8877       if Len <> 0 then begin
8878         Vec[0] := Vec[0] * Len;
8879         Vec[1] := Vec[1] * Len;
8880         Vec[2] := Vec[2] * Len;
8881       end;
8882
8883       // Scale Vector and AddVectro
8884       Vec[0] := Vec[0] * 0.5 + 0.5;
8885       Vec[1] := Vec[1] * 0.5 + 0.5;
8886       Vec[2] := Vec[2] * 0.5 + 0.5;
8887     end;
8888
8889     // Set Color
8890     for i := 0 to 2 do
8891       Dest.Data.arr[i] := Round(Vec[i] * 255);
8892   end;
8893 end;
8894
8895 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8896 procedure TglBitmapNormalMap.AfterConstruction;
8897 begin
8898   inherited;
8899 {$IFNDEF OPENGL_ES}
8900   fGenMode := GL_NORMAL_MAP;
8901 {$ENDIF}
8902 end;
8903
8904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8905 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8906 var
8907   Rec: TglBitmapNormalMapRec;
8908   SizeRec: TglBitmapSize;
8909 begin
8910   Rec.HalfSize := aSize div 2;
8911   FreeDataAfterGenTexture := false;
8912
8913   SizeRec.Fields := [ffX, ffY];
8914   SizeRec.X := aSize;
8915   SizeRec.Y := aSize;
8916
8917   // Positive X
8918   Rec.Func := glBitmapNormalMapPosX;
8919   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8920   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8921
8922   // Negative X
8923   Rec.Func := glBitmapNormalMapNegX;
8924   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8925   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8926
8927   // Positive Y
8928   Rec.Func := glBitmapNormalMapPosY;
8929   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8930   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8931
8932   // Negative Y
8933   Rec.Func := glBitmapNormalMapNegY;
8934   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8935   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8936
8937   // Positive Z
8938   Rec.Func := glBitmapNormalMapPosZ;
8939   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8940   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8941
8942   // Negative Z
8943   Rec.Func := glBitmapNormalMapNegZ;
8944   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8945   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8946 end;
8947 {$IFEND}
8948
8949 initialization
8950   glBitmapSetDefaultFormat (tfEmpty);
8951   glBitmapSetDefaultMipmap (mmMipmap);
8952   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8953   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8954 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8955   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8956 {$IFEND}
8957
8958   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8959   glBitmapSetDefaultDeleteTextureOnFree    (true);
8960
8961   TFormatDescriptor.Init;
8962
8963 finalization
8964   TFormatDescriptor.Finalize;
8965
8966 end.