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 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 interface
 183
 184 uses
 185   {$IFDEF OPENGL_ES}            dglOpenGLES,
 186   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 187
 188   {$IF DEFINED(GLB_WIN) AND
 189        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 190
 191   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 192   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 193   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 194
 195   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 196   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 197   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 198   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 199   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 200
 201   Classes, SysUtils;
 202
 203 type
 204 {$IFNDEF fpc}
 205   QWord   = System.UInt64;
 206   PQWord  = ^QWord;
 207
 208   PtrInt  = Longint;
 209   PtrUInt = DWord;
 210 {$ENDIF}
 211
 212
 213   { type that describes the format of the data stored in a texture.
 214     the name of formats is composed of the following constituents:
 215     - multiple channels:
 216        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 217        - width of the chanel in bit       (4, 8, 16, ...)
 218     - data type                           (e.g. ub, us, ui)
 219     - number of elements of data types }
 220   TglBitmapFormat = (
 221     tfEmpty = 0,
 222
 223     tfAlpha4ub1,                //< 1 x unsigned byte
 224     tfAlpha8ub1,                //< 1 x unsigned byte
 225     tfAlpha16us1,               //< 1 x unsigned short
 226
 227     tfLuminance4ub1,            //< 1 x unsigned byte
 228     tfLuminance8ub1,            //< 1 x unsigned byte
 229     tfLuminance16us1,           //< 1 x unsigned short
 230
 231     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 232     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 233     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 235     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 236
 237     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 238     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 239     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 240     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 241     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 242     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 243     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 244     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 245     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 246     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 247     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 248     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 249
 250     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 251     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 252     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 253     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 254     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 255     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 256     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 257     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 258     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 259     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 260
 261     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 262     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 263     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 264     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 265     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 266     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 267     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 268     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 269     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 270     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 271     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 272
 273     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 274     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 275     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 276     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 277     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 278     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 279     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 280     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 281     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 282     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 283
 284     tfDepth16us1,               //< 1 x unsigned short (depth)
 285     tfDepth24ui1,               //< 1 x unsigned int (depth)
 286     tfDepth32ui1,               //< 1 x unsigned int (depth)
 287
 288     tfS3tcDtx1RGBA,
 289     tfS3tcDtx3RGBA,
 290     tfS3tcDtx5RGBA
 291   );
 292
 293   { type to define suitable file formats }
 294   TglBitmapFileType = (
 295      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 296      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 297      ftDDS,                                             //< Direct Draw Surface file (DDS)
 298      ftTGA,                                             //< Targa Image File (TGA)
 299      ftBMP,                                             //< Windows Bitmap File (BMP)
 300      ftRAW);                                            //< glBitmap RAW file format
 301    TglBitmapFileTypes = set of TglBitmapFileType;
 302
 303   { possible mipmap types }
 304   TglBitmapMipMap = (
 305      mmNone,                //< no mipmaps
 306      mmMipmap,              //< normal mipmaps
 307      mmMipmapGlu);          //< mipmaps generated with glu functions
 308
 309   { possible normal map functions }
 310    TglBitmapNormalMapFunc = (
 311      nm4Samples,
 312      nmSobel,
 313      nm3x3,
 314      nm5x5);
 315
 316  ////////////////////////////////////////////////////////////////////////////////////////////////////
 317    EglBitmap                  = class(Exception);   //< glBitmap exception
 318    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 319    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 320    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 321    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 322    public
 323      constructor Create(const aFormat: TglBitmapFormat); overload;
 324      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 325    end;
 326
 327 ////////////////////////////////////////////////////////////////////////////////////////////////////
 328   { record that stores 4 unsigned integer values }
 329   TglBitmapRec4ui = packed record
 330   case Integer of
 331     0: (r, g, b, a: Cardinal);
 332     1: (arr: array[0..3] of Cardinal);
 333   end;
 334
 335   { record that stores 4 unsigned byte values }
 336   TglBitmapRec4ub = packed record
 337   case Integer of
 338     0: (r, g, b, a: Byte);
 339     1: (arr: array[0..3] of Byte);
 340   end;
 341
 342   { record that stores 4 unsigned long integer values }
 343   TglBitmapRec4ul = packed record
 344   case Integer of
 345     0: (r, g, b, a: QWord);
 346     1: (arr: array[0..3] of QWord);
 347   end;
 348
 349   { describes the properties of a given texture data format }
 350   TglBitmapFormatDescriptor = class(TObject)
 351   private
 352     // cached properties
 353     fBytesPerPixel: Single;   //< number of bytes for each pixel
 354     fChannelCount: Integer;   //< number of color channels
 355     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 356     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 357
 358     { @return @true if the format has a red color channel, @false otherwise }
 359     function GetHasRed: Boolean;
 360
 361     { @return @true if the format has a green color channel, @false otherwise }
 362     function GetHasGreen: Boolean;
 363
 364     { @return @true if the format has a blue color channel, @false otherwise }
 365     function GetHasBlue: Boolean;
 366
 367     { @return @true if the format has a alpha color channel, @false otherwise }
 368     function GetHasAlpha: Boolean;
 369
 370     { @return @true if the format has any color color channel, @false otherwise }
 371     function GetHasColor: Boolean;
 372
 373     { @return @true if the format is a grayscale format, @false otherwise }
 374     function GetIsGrayscale: Boolean;
 375   protected
 376     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 377     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 378     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 379     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 380     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 381     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 382
 383     fBitsPerPixel: Integer;           //< number of bits per pixel
 384     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 385
 386     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 387     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 388
 389     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 390     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 391     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 392
 393     { set values for this format descriptor }
 394     procedure SetValues; virtual;
 395
 396     { calculate cached values }
 397     procedure CalcValues;
 398   public
 399     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 400     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 401     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 402     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 403     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 404
 405     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 406     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 407     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 408     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 409
 410     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 411     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 412     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 413     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 414     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 415
 416     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 417     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 418     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 419
 420     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 421     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 422     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 423     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 424     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 425     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 426
 427     { constructor }
 428     constructor Create;
 429   public
 430     { get the format descriptor by a given OpenGL internal format
 431         @param aInternalFormat  OpenGL internal format to get format descriptor for
 432         @returns                suitable format descriptor or tfEmpty-Descriptor }
 433     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 434   end;
 435
 436 ////////////////////////////////////////////////////////////////////////////////////////////////////
 437   { structure to store pixel data in }
 438   TglBitmapPixelData = packed record
 439     Data:   TglBitmapRec4ui;  //< color data for each color channel
 440     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 441     Format: TglBitmapFormat;  //< format of the pixel
 442   end;
 443   PglBitmapPixelData = ^TglBitmapPixelData;
 444
 445   TglBitmapSizeFields = set of (ffX, ffY);
 446   TglBitmapSize = packed record
 447     Fields: TglBitmapSizeFields;
 448     X: Word;
 449     Y: Word;
 450   end;
 451   TglBitmapPixelPosition = TglBitmapSize;
 452
 453 ////////////////////////////////////////////////////////////////////////////////////////////////////
 454   TglBitmap = class;
 455
 456   { structure to store data for converting in }
 457   TglBitmapFunctionRec = record
 458     Sender:   TglBitmap;              //< texture object that stores the data to convert
 459     Size:     TglBitmapSize;          //< size of the texture
 460     Position: TglBitmapPixelPosition; //< position of the currently pixel
 461     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 462     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 463     Args:     Pointer;                //< user defined args that was passed to the convert function
 464   end;
 465
 466   { callback to use for converting texture data }
 467   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 468
 469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 470   { base class for all glBitmap classes. used to manage OpenGL texture objects
 471     and to load, save and manipulate texture data }
 472   TglBitmap = class
 473   private
 474     { @returns format descriptor that describes the format of the stored data }
 475     function GetFormatDesc: TglBitmapFormatDescriptor;
 476   protected
 477     fID: GLuint;                          //< name of the OpenGL texture object
 478     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 479     fAnisotropic: Integer;                //< anisotropic level
 480     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 481     fFreeDataOnDestroy: Boolean;          //< free stored data when this object is destroyed
 482     fFreeDataAfterGenTexture: Boolean;    //< free stored data after data was uploaded to video card
 483     fData: PByte;                         //< data of this texture
 484 {$IFNDEF OPENGL_ES}
 485     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 486 {$ENDIF}
 487     fBorderColor: array[0..3] of Single;  //< color of the texture border
 488
 489     fDimension: TglBitmapSize;            //< size of this texture
 490     fMipMap: TglBitmapMipMap;             //< mipmap type
 491     fFormat: TglBitmapFormat;             //< format the texture data is stored in
 492
 493     // Mapping
 494     fPixelSize: Integer;                  //< size of one pixel (in byte)
 495     fRowSize: Integer;                    //< size of one pixel row (in byte)
 496
 497     // Filtering
 498     fFilterMin: GLenum;                   //< min filter to apply to the texture
 499     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 500
 501     // TexturWarp
 502     fWrapS: GLenum;                       //< texture wrapping for x axis
 503     fWrapT: GLenum;                       //< texture wrapping for y axis
 504     fWrapR: GLenum;                       //< texture wrapping for z axis
 505
 506 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 507     //Swizzle
 508     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 509 {$IFEND}
 510
 511     // CustomData
 512     fFilename: String;                    //< filename the texture was load from
 513     fCustomName: String;                  //< user defined name
 514     fCustomNameW: WideString;             //< user defined name
 515     fCustomData: Pointer;                 //< user defined data
 516
 517   protected
 518     { @returns the actual width of the texture }
 519     function GetWidth:  Integer; virtual;
 520
 521     { @returns the actual height of the texture }
 522     function GetHeight: Integer; virtual;
 523
 524     { @returns the width of the texture or 1 if the width is zero }
 525     function GetFileWidth:  Integer; virtual;
 526
 527     { @returns the height of the texture or 1 if the height is zero }
 528     function GetFileHeight: Integer; virtual;
 529
 530   protected
 531     { set a new value for fCustomData }
 532     procedure SetCustomData(const aValue: Pointer);
 533
 534     { set a new value for fCustomName }
 535     procedure SetCustomName(const aValue: String);
 536
 537     { set a new value for fCustomNameW }
 538     procedure SetCustomNameW(const aValue: WideString);
 539
 540     { set new value for fFreeDataOnDestroy }
 541     procedure SetFreeDataOnDestroy(const aValue: Boolean);
 542
 543     { set new value for fDeleteTextureOnFree }
 544     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 545
 546     { set new value for the data format. only possible if new format has the same pixel size.
 547       if you want to convert the texture data, see ConvertTo function }
 548     procedure SetFormat(const aValue: TglBitmapFormat);
 549
 550     { set new value for fFreeDataAfterGenTexture }
 551     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
 552
 553     { set name of OpenGL texture object }
 554     procedure SetID(const aValue: Cardinal);
 555
 556     { set new value for fMipMap }
 557     procedure SetMipMap(const aValue: TglBitmapMipMap);
 558
 559     { set new value for target }
 560     procedure SetTarget(const aValue: Cardinal);
 561
 562     { set new value for fAnisotrophic }
 563     procedure SetAnisotropic(const aValue: Integer);
 564
 565   protected
 566     { create OpenGL texture object (delete exisiting object if exists) }
 567     procedure CreateID;
 568
 569     { setup texture parameters }
 570     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
 571
 572     { set data pointer of texture data
 573         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
 574         @param aFormat  format of the data stored at aData
 575         @param aWidth   width of the texture data
 576         @param aHeight  height of the texture data }
 577     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
 578       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 579
 580     { generate texture (upload texture data to video card)
 581         @param aTestTextureSize   test texture size before uploading and raise exception if something is wrong }
 582     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
 583
 584     { flip texture horizontal
 585         @returns @true in success, @false otherwise }
 586     function FlipHorz: Boolean; virtual;
 587
 588     { flip texture vertical
 589         @returns @true in success, @false otherwise }
 590     function FlipVert: Boolean; virtual;
 591
 592   protected
 593     property Width:  Integer read GetWidth;             //< the actual width of the texture
 594     property Height: Integer read GetHeight;            //< the actual height of the texture
 595
 596     property FileWidth:  Integer read GetFileWidth;     //< the width of the texture or 1 if the width is zero
 597     property FileHeight: Integer read GetFileHeight;    //< the height of the texture or 1 if the height is zero
 598   public
 599     property ID:           Cardinal        read fID          write SetID;           //< name of the OpenGL texture object
 600     property Target:       Cardinal        read fTarget      write SetTarget;       //< texture target (e.g. GL_TEXTURE_2D)
 601     property Format:       TglBitmapFormat read fFormat      write SetFormat;       //< format the texture data is stored in
 602     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
 603     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
 604
 605     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;      //< format descriptor that describes the format of the stored data
 606
 607     property Filename:    String     read fFilename;                          //< filename the texture was load from
 608     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
 609     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
 610     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
 611
 612     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;     //< delete texture object when this object is destroyed
 613     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;       //< free stored data when this object is destroyed
 614     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card
 615
 616     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
 617     property Data:       PByte         read fData;          //< texture data (or @nil if unset)
 618 {$IFNDEF OPENGL_ES}
 619     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
 620 {$ENDIF}
 621
 622     { this method is called after the constructor and sets the default values of this object }
 623     procedure AfterConstruction; override;
 624
 625     { this method is called before the destructor and does some cleanup }
 626     procedure BeforeDestruction; override;
 627
 628     { splits a resource identifier into the resource and it's type
 629         @param aResource  resource identifier to split and store name in
 630         @param aResType   type of the resource }
 631     procedure PrepareResType(var aResource: String; var aResType: PChar);
 632
 633   public
 634     { load a texture from a file
 635         @param aFilename file to load texuture from }
 636     procedure LoadFromFile(const aFilename: String);
 637
 638     { load a texture from a stream
 639         @param aStream  stream to load texture from }
 640     procedure LoadFromStream(const aStream: TStream); virtual;
 641
 642     { use a function to generate texture data
 643         @param aSize    size of the texture
 644         @param aFunc    callback to use for generation
 645         @param aFormat  format of the texture data
 646         @param aArgs    user defined paramaters (use at will) }
 647     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
 648       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
 649
 650     { load a texture from a resource
 651         @param aInstance  resource handle
 652         @param aResource  resource indentifier
 653         @param aResType   resource type (if known) }
 654     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 655
 656     { load a texture from a resource id
 657         @param aInstance  resource handle
 658         @param aResource  resource ID
 659         @param aResType   resource type }
 660     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 661
 662   public
 663     { save texture data to a file
 664         @param aFilename  filename to store texture in
 665         @param aFileType  file type to store data into }
 666     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 667
 668     { save texture data to a stream
 669         @param aFilename  filename to store texture in
 670         @param aFileType  file type to store data into }
 671     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 672
 673   public
 674     { convert texture data using a user defined callback
 675         @param aFunc        callback to use for converting
 676         @param aCreateTemp  create a temporary buffer to use for converting
 677         @param aArgs        user defined paramters (use at will)
 678         @returns            @true if converting was successful, @false otherwise }
 679     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 680
 681     { convert texture data using a user defined callback
 682         @param aSource      glBitmap to read data from
 683         @param aFunc        callback to use for converting
 684         @param aCreateTemp  create a temporary buffer to use for converting
 685         @param aFormat      format of the new data
 686         @param aArgs        user defined paramters (use at will)
 687         @returns            @true if converting was successful, @false otherwise }
 688     function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 689       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 690
 691     { convert texture data using a specific format
 692         @param aFormat  new format of texture data
 693         @returns        @true if converting was successful, @false otherwise }
 694     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 695
 696 {$IFDEF GLB_SDL}
 697   public
 698     { assign texture data to SDL surface
 699         @param aSurface SDL surface to write data to
 700         @returns        @true on success, @false otherwise }
 701     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 702
 703     { assign texture data from SDL surface
 704         @param aSurface SDL surface to read data from
 705         @returns        @true on success, @false otherwise }
 706     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 707
 708     { assign alpha channel data to SDL surface
 709         @param aSurface SDL surface to write alpha channel data to
 710         @returns        @true on success, @false otherwise }
 711     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 712
 713     { assign alpha channel data from SDL surface
 714         @param aSurface SDL surface to read data from
 715         @param aFunc    callback to use for converting
 716         @param aArgs    user defined parameters (use at will)
 717         @returns        @true on success, @false otherwise }
 718     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 719 {$ENDIF}
 720
 721 {$IFDEF GLB_DELPHI}
 722   public
 723     { assign texture data to TBitmap object
 724         @param aBitmap  TBitmap to write data to
 725         @returns        @true on success, @false otherwise }
 726     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 727
 728     { assign texture data from TBitmap object
 729         @param aBitmap  TBitmap to read data from
 730         @returns        @true on success, @false otherwise }
 731     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 732
 733     { assign alpha channel data to TBitmap object
 734         @param aBitmap  TBitmap to write data to
 735         @returns        @true on success, @false otherwise }
 736     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 737
 738     { assign alpha channel data from TBitmap object
 739         @param aBitmap  TBitmap to read data from
 740         @param aFunc    callback to use for converting
 741         @param aArgs    user defined parameters (use at will)
 742         @returns        @true on success, @false otherwise }
 743     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 744 {$ENDIF}
 745
 746 {$IFDEF GLB_LAZARUS}
 747   public
 748     { assign texture data to TLazIntfImage object
 749         @param aImage   TLazIntfImage to write data to
 750         @returns        @true on success, @false otherwise }
 751     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 752
 753     { assign texture data from TLazIntfImage object
 754         @param aImage   TLazIntfImage to read data from
 755         @returns        @true on success, @false otherwise }
 756     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 757
 758     { assign alpha channel data to TLazIntfImage object
 759         @param aImage   TLazIntfImage to write data to
 760         @returns        @true on success, @false otherwise }
 761     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 762
 763     { assign alpha channel data from TLazIntfImage object
 764         @param aImage   TLazIntfImage to read data from
 765         @param aFunc    callback to use for converting
 766         @param aArgs    user defined parameters (use at will)
 767         @returns        @true on success, @false otherwise }
 768     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 769 {$ENDIF}
 770
 771   public
 772     { load alpha channel data from resource
 773         @param aInstance  resource handle
 774         @param aResource  resource ID
 775         @param aResType   resource type
 776         @param aFunc      callback to use for converting
 777         @param aArgs      user defined parameters (use at will)
 778         @returns          @true on success, @false otherwise }
 779     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 780
 781     { load alpha channel data from resource ID
 782         @param aInstance    resource handle
 783         @param aResourceID  resource ID
 784         @param aResType     resource type
 785         @param aFunc        callback to use for converting
 786         @param aArgs        user defined parameters (use at will)
 787         @returns            @true on success, @false otherwise }
 788     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 789
 790     { add alpha channel data from function
 791         @param aFunc  callback to get data from
 792         @param aArgs  user defined parameters (use at will)
 793         @returns      @true on success, @false otherwise }
 794     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 795
 796     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 797         @param aFilename  file to load alpha channel data from
 798         @param aFunc      callback to use for converting
 799         @param aArgs      user defined parameters (use at will)
 800         @returns          @true on success, @false otherwise }
 801     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 802
 803     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 804         @param aStream  stream to load alpha channel 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 AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 809
 810     { add alpha channel data from existing glBitmap object
 811         @param aBitmap  TglBitmap to copy alpha channel data from
 812         @param aFunc    callback to use for converting
 813         @param aArgs    user defined parameters (use at will)
 814         @returns        @true on success, @false otherwise }
 815     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 816
 817     { add alpha to pixel if the pixels color is greter than the given color value
 818         @param aRed         red threshold (0-255)
 819         @param aGreen       green threshold (0-255)
 820         @param aBlue        blue threshold (0-255)
 821         @param aDeviatation accepted deviatation (0-255)
 822         @returns            @true on success, @false otherwise }
 823     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 824
 825     { add alpha to pixel if the pixels color is greter than the given color value
 826         @param aRed         red threshold (0-Range.r)
 827         @param aGreen       green threshold (0-Range.g)
 828         @param aBlue        blue threshold (0-Range.b)
 829         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 830         @returns            @true on success, @false otherwise }
 831     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 832
 833     { add alpha to pixel if the pixels color is greter than the given color value
 834         @param aRed         red threshold (0.0-1.0)
 835         @param aGreen       green threshold (0.0-1.0)
 836         @param aBlue        blue threshold (0.0-1.0)
 837         @param aDeviatation accepted deviatation (0.0-1.0)
 838         @returns            @true on success, @false otherwise }
 839     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 840
 841     { add a constand alpha value to all pixels
 842         @param aAlpha alpha value to add (0-255)
 843         @returns      @true on success, @false otherwise }
 844     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 845
 846     { add a constand alpha value to all pixels
 847         @param aAlpha alpha value to add (0-max(Range.rgb))
 848         @returns      @true on success, @false otherwise }
 849     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 850
 851     { add a constand alpha value to all pixels
 852         @param aAlpha alpha value to add (0.0-1.0)
 853         @returns      @true on success, @false otherwise }
 854     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 855
 856     { remove alpha channel
 857         @returns  @true on success, @false otherwise }
 858     function RemoveAlpha: Boolean; virtual;
 859
 860   public
 861     { create a clone of the current object
 862         @returns clone of this object}
 863     function Clone: TglBitmap;
 864
 865     { invert color data (xor)
 866         @param aUseRGB   xor each color channel
 867         @param aUseAlpha xor alpha channel }
 868     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
 869
 870     { free texture stored data }
 871     procedure FreeData;
 872
 873 {$IFNDEF OPENGL_ES}
 874     { set the new value for texture border color
 875         @param aRed   red color for border (0.0-1.0)
 876         @param aGreen green color for border (0.0-1.0)
 877         @param aBlue  blue color for border (0.0-1.0)
 878         @param aAlpha alpha color for border (0.0-1.0) }
 879     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
 880 {$ENDIF}
 881
 882   public
 883     { fill complete texture with one color
 884         @param aRed   red color for border (0-255)
 885         @param aGreen green color for border (0-255)
 886         @param aBlue  blue color for border (0-255)
 887         @param aAlpha alpha color for border (0-255) }
 888     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 889
 890     { fill complete texture with one color
 891         @param aRed   red color for border (0-Range.r)
 892         @param aGreen green color for border (0-Range.g)
 893         @param aBlue  blue color for border (0-Range.b)
 894         @param aAlpha alpha color for border (0-Range.a) }
 895     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 896
 897     { fill complete texture with one color
 898         @param aRed   red color for border (0.0-1.0)
 899         @param aGreen green color for border (0.0-1.0)
 900         @param aBlue  blue color for border (0.0-1.0)
 901         @param aAlpha alpha color for border (0.0-1.0) }
 902     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 903
 904   public
 905     { set new texture filer
 906         @param aMin   min filter
 907         @param aMag   mag filter }
 908     procedure SetFilter(const aMin, aMag: GLenum);
 909
 910     { set new texture wrapping
 911         @param S  texture wrapping for x axis
 912         @param T  texture wrapping for y axis
 913         @param R  texture wrapping for z axis }
 914     procedure SetWrap(
 915       const S: GLenum = GL_CLAMP_TO_EDGE;
 916       const T: GLenum = GL_CLAMP_TO_EDGE;
 917       const R: GLenum = GL_CLAMP_TO_EDGE);
 918
 919 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 920     { set new swizzle
 921         @param r  swizzle for red channel
 922         @param g  swizzle for green channel
 923         @param b  swizzle for blue channel
 924         @param a  swizzle for alpha channel }
 925     procedure SetSwizzle(const r, g, b, a: GLenum);
 926 {$IFEND}
 927
 928   public
 929     { bind texture
 930         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
 931     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
 932
 933     { bind texture
 934         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
 935     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
 936
 937   public
 938     { constructor - created an empty texture }
 939     constructor Create; overload;
 940
 941     { constructor - creates a texture and load it from a file
 942         @param aFilename file to load texture from }
 943     constructor Create(const aFileName: String); overload;
 944
 945     { constructor - creates a texture and load it from a stream
 946         @param aStream stream to load texture from }
 947     constructor Create(const aStream: TStream); overload;
 948
 949     { constructor - creates a texture with the given size, format and data
 950         @param aSize    size of the texture
 951         @param aFormat  format of the given data
 952         @param aData    texture data - be carefull: the data will now be managed by the glBitmap object,
 953                         you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }
 954     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 955
 956     { constructor - creates a texture with the given size and format and uses the given callback to create the data
 957         @param aSize    size of the texture
 958         @param aFormat  format of the given data
 959         @param aFunc    callback to use for generating the data
 960         @param aArgs    user defined parameters (use at will) }
 961     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 962
 963     { constructor - creates a texture and loads it from a resource
 964         @param aInstance  resource handle
 965         @param aResource  resource indentifier
 966         @param aResType   resource type (if known) }
 967     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 968
 969     { constructor - creates a texture and loads it from a resource
 970         @param aInstance    resource handle
 971         @param aResourceID  resource ID
 972         @param aResType     resource type (if known) }
 973     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 974
 975   private
 976 {$IFDEF GLB_SUPPORT_PNG_READ}
 977     { try to load a PNG from a stream
 978         @param aStream  stream to load PNG from
 979         @returns        @true on success, @false otherwise }
 980     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 981 {$ENDIF}
 982
 983 {$ifdef GLB_SUPPORT_PNG_WRITE}
 984     { save texture data as PNG to stream
 985         @param aStream stream to save data to}
 986     procedure SavePNG(const aStream: TStream); virtual;
 987 {$ENDIF}
 988
 989 {$IFDEF GLB_SUPPORT_JPEG_READ}
 990     { try to load a JPEG from a stream
 991         @param aStream  stream to load JPEG from
 992         @returns        @true on success, @false otherwise }
 993     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 994 {$ENDIF}
 995
 996 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 997     { save texture data as JPEG to stream
 998         @param aStream stream to save data to}
 999     procedure SaveJPEG(const aStream: TStream); virtual;
1000 {$ENDIF}
1001
1002     { try to load a RAW image from a stream
1003         @param aStream  stream to load RAW image from
1004         @returns        @true on success, @false otherwise }
1005     function LoadRAW(const aStream: TStream): Boolean;
1006
1007     { save texture data as RAW image to stream
1008         @param aStream stream to save data to}
1009     procedure SaveRAW(const aStream: TStream);
1010
1011     { try to load a BMP from a stream
1012         @param aStream  stream to load BMP from
1013         @returns        @true on success, @false otherwise }
1014     function LoadBMP(const aStream: TStream): Boolean;
1015
1016     { save texture data as BMP to stream
1017         @param aStream stream to save data to}
1018     procedure SaveBMP(const aStream: TStream);
1019
1020     { try to load a TGA from a stream
1021         @param aStream  stream to load TGA from
1022         @returns        @true on success, @false otherwise }
1023     function LoadTGA(const aStream: TStream): Boolean;
1024
1025     { save texture data as TGA to stream
1026         @param aStream stream to save data to}
1027     procedure SaveTGA(const aStream: TStream);
1028
1029     { try to load a DDS from a stream
1030         @param aStream  stream to load DDS from
1031         @returns        @true on success, @false otherwise }
1032     function LoadDDS(const aStream: TStream): Boolean;
1033
1034     { save texture data as DDS to stream
1035         @param aStream stream to save data to}
1036     procedure SaveDDS(const aStream: TStream);
1037   end;
1038
1039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1040 {$IF NOT DEFINED(OPENGL_ES)}
1041   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }
1042   TglBitmap1D = class(TglBitmap)
1043   protected
1044     { set data pointer of texture data
1045         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1046         @param aFormat  format of the data stored at aData
1047         @param aWidth   width of the texture data
1048         @param aHeight  height of the texture data }
1049     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1050
1051     { upload the texture data to video card
1052         @param aBuildWithGlu  use glu functions to build mipmaps }
1053     procedure UploadData(const aBuildWithGlu: Boolean);
1054   public
1055     property Width; //< actual with of the texture
1056
1057     { this method is called after constructor and initializes the object }
1058     procedure AfterConstruction; override;
1059
1060     { flip texture horizontally
1061         @returns @true on success, @fals otherwise }
1062     function FlipHorz: Boolean; override;
1063
1064     { generate texture (create texture object if not exist, set texture parameters and upload data
1065         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1066     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1067   end;
1068 {$IFEND}
1069
1070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1071   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }
1072   TglBitmap2D = class(TglBitmap)
1073   protected
1074     fLines: array of PByte; //< array to store scanline entry points in
1075
1076     { get a specific scanline
1077         @param aIndex   index of the scanline to return
1078         @returns        scanline at position aIndex or @nil }
1079     function GetScanline(const aIndex: Integer): Pointer;
1080
1081     { set data pointer of texture data
1082         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)
1083         @param aFormat  format of the data stored at aData
1084         @param aWidth   width of the texture data
1085         @param aHeight  height of the texture data }
1086     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1087       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1088
1089     { upload the texture data to video card
1090         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1091         @param aBuildWithGlu  use glu functions to build mipmaps }
1092     procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1093   public
1094     property Width;                                                       //< actual width of the texture
1095     property Height;                                                      //< actual height of the texture
1096     property Scanline[const aIndex: Integer]: Pointer read GetScanline;   //< scanline to access texture data directly
1097
1098     { this method is called after constructor and initializes the object }
1099     procedure AfterConstruction; override;
1100
1101     { copy a part of the frame buffer top the texture
1102         @param aTop     topmost pixel to copy
1103         @param aLeft    leftmost pixel to copy
1104         @param aRight   rightmost pixel to copy
1105         @param aBottom  bottommost pixel to copy
1106         @param aFormat  format to store data in }
1107     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1108
1109 {$IFNDEF OPENGL_ES}
1110     { downlaod texture data from OpenGL texture object }
1111     procedure GetDataFromTexture;
1112 {$ENDIF}
1113
1114     { generate texture (create texture object if not exist, set texture parameters and upload data)
1115         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1116     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1117
1118     { flip texture horizontally
1119         @returns @true on success, @false otherwise }
1120     function FlipHorz: Boolean; override;
1121
1122     { flip texture vertically
1123         @returns @true on success, @false otherwise }
1124     function FlipVert: Boolean; override;
1125
1126     { create normal map from texture data
1127         @param aFunc      normal map function to generate normalmap with
1128         @param aScale     scale of the normale stored in the normal map
1129         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
1130     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1131       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1132   end;
1133
1134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1135 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1136   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }
1137   TglBitmapCubeMap = class(TglBitmap2D)
1138   protected
1139   {$IFNDEF OPENGL_ES}
1140     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1141   {$ENDIF}
1142
1143     { generate texture (create texture object if not exist, set texture parameters and upload data
1144       do not call directly for cubemaps, use GenerateCubeMap instead
1145         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1146     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1147   public
1148     { this method is called after constructor and initializes the object }
1149     procedure AfterConstruction; override;
1150
1151     { generate texture (create texture object if not exist, set texture parameters and upload data
1152         @param aCubeTarget        cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1153         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }
1154     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1155
1156     { bind texture
1157         @param aEnableTexCoordsGen  enable cube map generator
1158         @param aEnableTextureUnit   enable texture unit }
1159     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1160
1161     { unbind texture
1162         @param aDisableTexCoordsGen   disable cube map generator
1163         @param aDisableTextureUnit    disable texture unit }
1164     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1165   end;
1166 {$IFEND}
1167
1168 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1170   { wrapper class for cube normal maps }
1171   TglBitmapNormalMap = class(TglBitmapCubeMap)
1172   public
1173     { this method is called after constructor and initializes the object }
1174     procedure AfterConstruction; override;
1175
1176     { create cube normal map from texture data and upload it to video card
1177         @param aSize              size of each cube map texture
1178         @param aTestTextureSize   check texture size when uploading and throw exception if something is wrong  }
1179     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1180   end;
1181 {$IFEND}
1182
1183 const
1184   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1185
1186 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1187 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1188 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1189 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1190 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1191 procedure glBitmapSetDefaultWrap(
1192   const S: Cardinal = GL_CLAMP_TO_EDGE;
1193   const T: Cardinal = GL_CLAMP_TO_EDGE;
1194   const R: Cardinal = GL_CLAMP_TO_EDGE);
1195
1196 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1197 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1198 {$IFEND}
1199
1200 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1201 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1202 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1203 function glBitmapGetDefaultFormat: TglBitmapFormat;
1204 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1205 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1206 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1207 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1208 {$IFEND}
1209
1210 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1211 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1212 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1213 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1214 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1215 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1216 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1217
1218 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1219
1220 {$IFDEF GLB_DELPHI}
1221 function CreateGrayPalette: HPALETTE;
1222 {$ENDIF}
1223
1224 implementation
1225
1226 uses
1227   Math, syncobjs, typinfo
1228   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1229
1230
1231 var
1232   glBitmapDefaultDeleteTextureOnFree: Boolean;
1233   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1234   glBitmapDefaultFormat: TglBitmapFormat;
1235   glBitmapDefaultMipmap: TglBitmapMipMap;
1236   glBitmapDefaultFilterMin: Cardinal;
1237   glBitmapDefaultFilterMag: Cardinal;
1238   glBitmapDefaultWrapS: Cardinal;
1239   glBitmapDefaultWrapT: Cardinal;
1240   glBitmapDefaultWrapR: Cardinal;
1241   glDefaultSwizzle: array[0..3] of GLenum;
1242
1243 ////////////////////////////////////////////////////////////////////////////////////////////////////
1244 type
1245   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1246   public
1247     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1248     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1249
1250     function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
1251     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1252
1253     function CreateMappingData: Pointer; virtual;
1254     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1255
1256     function IsEmpty: Boolean; virtual;
1257     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1258
1259     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1260
1261     constructor Create; virtual;
1262   public
1263     class procedure Init;
1264     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1265     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1266     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1267     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1268     class procedure Clear;
1269     class procedure Finalize;
1270   end;
1271   TFormatDescriptorClass = class of TFormatDescriptor;
1272
1273   TfdEmpty = class(TFormatDescriptor);
1274
1275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1276   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1277     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1278     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1279   end;
1280
1281   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1282     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1283     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1284   end;
1285
1286   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1287     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1288     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1289   end;
1290
1291   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1292     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1293     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1294   end;
1295
1296   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299   end;
1300
1301   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1302     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1303     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1304   end;
1305
1306   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1307     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1308     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1309   end;
1310
1311   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1312     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1313     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1314   end;
1315
1316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1317   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1318     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1319     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1320   end;
1321
1322   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1323     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1324     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1325   end;
1326
1327   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330   end;
1331
1332   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1333     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1334     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1335   end;
1336
1337   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1338     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1339     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1340   end;
1341
1342   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1343     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1344     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1345   end;
1346
1347   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1348     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1349     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1350   end;
1351
1352   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1353     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1354     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1355   end;
1356
1357   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1358     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1359     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1360   end;
1361
1362   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1363     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1364     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1365   end;
1366
1367   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370   end;
1371
1372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1373   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1374     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1375     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1376   end;
1377
1378   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1379     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1380     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1381   end;
1382
1383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1384   TfdAlpha4ub1 = class(TfdAlphaUB1)
1385     procedure SetValues; override;
1386   end;
1387
1388   TfdAlpha8ub1 = class(TfdAlphaUB1)
1389     procedure SetValues; override;
1390   end;
1391
1392   TfdAlpha16us1 = class(TfdAlphaUS1)
1393     procedure SetValues; override;
1394   end;
1395
1396   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1397     procedure SetValues; override;
1398   end;
1399
1400   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1401     procedure SetValues; override;
1402   end;
1403
1404   TfdLuminance16us1 = class(TfdLuminanceUS1)
1405     procedure SetValues; override;
1406   end;
1407
1408   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1409     procedure SetValues; override;
1410   end;
1411
1412   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1413     procedure SetValues; override;
1414   end;
1415
1416   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1417     procedure SetValues; override;
1418   end;
1419
1420   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1421     procedure SetValues; override;
1422   end;
1423
1424   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1425     procedure SetValues; override;
1426   end;
1427
1428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1429   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1430     procedure SetValues; override;
1431   end;
1432
1433   TfdRGBX4us1 = class(TfdUniversalUS1)
1434     procedure SetValues; override;
1435   end;
1436
1437   TfdXRGB4us1 = class(TfdUniversalUS1)
1438     procedure SetValues; override;
1439   end;
1440
1441   TfdR5G6B5us1 = class(TfdUniversalUS1)
1442     procedure SetValues; override;
1443   end;
1444
1445   TfdRGB5X1us1 = class(TfdUniversalUS1)
1446     procedure SetValues; override;
1447   end;
1448
1449   TfdX1RGB5us1 = class(TfdUniversalUS1)
1450     procedure SetValues; override;
1451   end;
1452
1453   TfdRGB8ub3 = class(TfdRGBub3)
1454     procedure SetValues; override;
1455   end;
1456
1457   TfdRGBX8ui1 = class(TfdUniversalUI1)
1458     procedure SetValues; override;
1459   end;
1460
1461   TfdXRGB8ui1 = class(TfdUniversalUI1)
1462     procedure SetValues; override;
1463   end;
1464
1465   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1466     procedure SetValues; override;
1467   end;
1468
1469   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1470     procedure SetValues; override;
1471   end;
1472
1473   TfdRGB16us3 = class(TfdRGBus3)
1474     procedure SetValues; override;
1475   end;
1476
1477   TfdRGBA4us1 = class(TfdUniversalUS1)
1478     procedure SetValues; override;
1479   end;
1480
1481   TfdARGB4us1 = class(TfdUniversalUS1)
1482     procedure SetValues; override;
1483   end;
1484
1485   TfdRGB5A1us1 = class(TfdUniversalUS1)
1486     procedure SetValues; override;
1487   end;
1488
1489   TfdA1RGB5us1 = class(TfdUniversalUS1)
1490     procedure SetValues; override;
1491   end;
1492
1493   TfdRGBA8ui1 = class(TfdUniversalUI1)
1494     procedure SetValues; override;
1495   end;
1496
1497   TfdARGB8ui1 = class(TfdUniversalUI1)
1498     procedure SetValues; override;
1499   end;
1500
1501   TfdRGBA8ub4 = class(TfdRGBAub4)
1502     procedure SetValues; override;
1503   end;
1504
1505   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1506     procedure SetValues; override;
1507   end;
1508
1509   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1510     procedure SetValues; override;
1511   end;
1512
1513   TfdRGBA16us4 = class(TfdRGBAus4)
1514     procedure SetValues; override;
1515   end;
1516
1517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1518   TfdBGRX4us1 = class(TfdUniversalUS1)
1519     procedure SetValues; override;
1520   end;
1521
1522   TfdXBGR4us1 = class(TfdUniversalUS1)
1523     procedure SetValues; override;
1524   end;
1525
1526   TfdB5G6R5us1 = class(TfdUniversalUS1)
1527     procedure SetValues; override;
1528   end;
1529
1530   TfdBGR5X1us1 = class(TfdUniversalUS1)
1531     procedure SetValues; override;
1532   end;
1533
1534   TfdX1BGR5us1 = class(TfdUniversalUS1)
1535     procedure SetValues; override;
1536   end;
1537
1538   TfdBGR8ub3 = class(TfdBGRub3)
1539     procedure SetValues; override;
1540   end;
1541
1542   TfdBGRX8ui1 = class(TfdUniversalUI1)
1543     procedure SetValues; override;
1544   end;
1545
1546   TfdXBGR8ui1 = class(TfdUniversalUI1)
1547     procedure SetValues; override;
1548   end;
1549
1550   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1551     procedure SetValues; override;
1552   end;
1553
1554   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1555     procedure SetValues; override;
1556   end;
1557
1558   TfdBGR16us3 = class(TfdBGRus3)
1559     procedure SetValues; override;
1560   end;
1561
1562   TfdBGRA4us1 = class(TfdUniversalUS1)
1563     procedure SetValues; override;
1564   end;
1565
1566   TfdABGR4us1 = class(TfdUniversalUS1)
1567     procedure SetValues; override;
1568   end;
1569
1570   TfdBGR5A1us1 = class(TfdUniversalUS1)
1571     procedure SetValues; override;
1572   end;
1573
1574   TfdA1BGR5us1 = class(TfdUniversalUS1)
1575     procedure SetValues; override;
1576   end;
1577
1578   TfdBGRA8ui1 = class(TfdUniversalUI1)
1579     procedure SetValues; override;
1580   end;
1581
1582   TfdABGR8ui1 = class(TfdUniversalUI1)
1583     procedure SetValues; override;
1584   end;
1585
1586   TfdBGRA8ub4 = class(TfdBGRAub4)
1587     procedure SetValues; override;
1588   end;
1589
1590   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1591     procedure SetValues; override;
1592   end;
1593
1594   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1595     procedure SetValues; override;
1596   end;
1597
1598   TfdBGRA16us4 = class(TfdBGRAus4)
1599     procedure SetValues; override;
1600   end;
1601
1602   TfdDepth16us1 = class(TfdDepthUS1)
1603     procedure SetValues; override;
1604   end;
1605
1606   TfdDepth24ui1 = class(TfdDepthUI1)
1607     procedure SetValues; override;
1608   end;
1609
1610   TfdDepth32ui1 = class(TfdDepthUI1)
1611     procedure SetValues; override;
1612   end;
1613
1614   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1615     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1616     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1617     procedure SetValues; override;
1618   end;
1619
1620   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1621     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1622     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1623     procedure SetValues; override;
1624   end;
1625
1626   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1627     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1628     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1629     procedure SetValues; override;
1630   end;
1631
1632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1633   TbmpBitfieldFormat = class(TFormatDescriptor)
1634   public
1635     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1636     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1637     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1638     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1639   end;
1640
1641 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1642   TbmpColorTableEnty = packed record
1643     b, g, r, a: Byte;
1644   end;
1645   TbmpColorTable = array of TbmpColorTableEnty;
1646   TbmpColorTableFormat = class(TFormatDescriptor)
1647   private
1648     fBitsPerPixel: Integer;
1649     fColorTable: TbmpColorTable;
1650   protected
1651     procedure SetValues; override;
1652   public
1653     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1654     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1655
1656     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1657     procedure CalcValues;
1658     procedure CreateColorTable;
1659
1660     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1661     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1662     destructor Destroy; override;
1663   end;
1664
1665 const
1666   LUMINANCE_WEIGHT_R = 0.30;
1667   LUMINANCE_WEIGHT_G = 0.59;
1668   LUMINANCE_WEIGHT_B = 0.11;
1669
1670   ALPHA_WEIGHT_R = 0.30;
1671   ALPHA_WEIGHT_G = 0.59;
1672   ALPHA_WEIGHT_B = 0.11;
1673
1674   DEPTH_WEIGHT_R = 0.333333333;
1675   DEPTH_WEIGHT_G = 0.333333333;
1676   DEPTH_WEIGHT_B = 0.333333333;
1677
1678   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1679     TfdEmpty,
1680
1681     TfdAlpha4ub1,
1682     TfdAlpha8ub1,
1683     TfdAlpha16us1,
1684
1685     TfdLuminance4ub1,
1686     TfdLuminance8ub1,
1687     TfdLuminance16us1,
1688
1689     TfdLuminance4Alpha4ub2,
1690     TfdLuminance6Alpha2ub2,
1691     TfdLuminance8Alpha8ub2,
1692     TfdLuminance12Alpha4us2,
1693     TfdLuminance16Alpha16us2,
1694
1695     TfdR3G3B2ub1,
1696     TfdRGBX4us1,
1697     TfdXRGB4us1,
1698     TfdR5G6B5us1,
1699     TfdRGB5X1us1,
1700     TfdX1RGB5us1,
1701     TfdRGB8ub3,
1702     TfdRGBX8ui1,
1703     TfdXRGB8ui1,
1704     TfdRGB10X2ui1,
1705     TfdX2RGB10ui1,
1706     TfdRGB16us3,
1707
1708     TfdRGBA4us1,
1709     TfdARGB4us1,
1710     TfdRGB5A1us1,
1711     TfdA1RGB5us1,
1712     TfdRGBA8ui1,
1713     TfdARGB8ui1,
1714     TfdRGBA8ub4,
1715     TfdRGB10A2ui1,
1716     TfdA2RGB10ui1,
1717     TfdRGBA16us4,
1718
1719     TfdBGRX4us1,
1720     TfdXBGR4us1,
1721     TfdB5G6R5us1,
1722     TfdBGR5X1us1,
1723     TfdX1BGR5us1,
1724     TfdBGR8ub3,
1725     TfdBGRX8ui1,
1726     TfdXBGR8ui1,
1727     TfdBGR10X2ui1,
1728     TfdX2BGR10ui1,
1729     TfdBGR16us3,
1730
1731     TfdBGRA4us1,
1732     TfdABGR4us1,
1733     TfdBGR5A1us1,
1734     TfdA1BGR5us1,
1735     TfdBGRA8ui1,
1736     TfdABGR8ui1,
1737     TfdBGRA8ub4,
1738     TfdBGR10A2ui1,
1739     TfdA2BGR10ui1,
1740     TfdBGRA16us4,
1741
1742     TfdDepth16us1,
1743     TfdDepth24ui1,
1744     TfdDepth32ui1,
1745
1746     TfdS3tcDtx1RGBA,
1747     TfdS3tcDtx3RGBA,
1748     TfdS3tcDtx5RGBA
1749   );
1750
1751 var
1752   FormatDescriptorCS: TCriticalSection;
1753   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1754
1755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1756 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1757 begin
1758   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1759 end;
1760
1761 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1762 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1763 begin
1764   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1765 end;
1766
1767 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1768 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1769 begin
1770   result.Fields := [];
1771   if (X >= 0) then
1772     result.Fields := result.Fields + [ffX];
1773   if (Y >= 0) then
1774     result.Fields := result.Fields + [ffY];
1775   result.X := Max(0, X);
1776   result.Y := Max(0, Y);
1777 end;
1778
1779 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1780 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1781 begin
1782   result := glBitmapSize(X, Y);
1783 end;
1784
1785 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1786 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1787 begin
1788   result.r := r;
1789   result.g := g;
1790   result.b := b;
1791   result.a := a;
1792 end;
1793
1794 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1795 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1796 begin
1797   result.r := r;
1798   result.g := g;
1799   result.b := b;
1800   result.a := a;
1801 end;
1802
1803 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1804 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1805 begin
1806   result.r := r;
1807   result.g := g;
1808   result.b := b;
1809   result.a := a;
1810 end;
1811
1812 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1813 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1814 var
1815   i: Integer;
1816 begin
1817   result := false;
1818   for i := 0 to high(r1.arr) do
1819     if (r1.arr[i] <> r2.arr[i]) then
1820       exit;
1821   result := true;
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1826 var
1827   i: Integer;
1828 begin
1829   result := false;
1830   for i := 0 to high(r1.arr) do
1831     if (r1.arr[i] <> r2.arr[i]) then
1832       exit;
1833   result := true;
1834 end;
1835
1836 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1837 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1838 var
1839   desc: TFormatDescriptor;
1840   p, tmp: PByte;
1841   x, y, i: Integer;
1842   md: Pointer;
1843   px: TglBitmapPixelData;
1844 begin
1845   result := nil;
1846   desc := TFormatDescriptor.Get(aFormat);
1847   if (desc.IsCompressed) or (desc.glFormat = 0) then
1848     exit;
1849
1850   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1851   md := desc.CreateMappingData;
1852   try
1853     tmp := p;
1854     desc.PreparePixel(px);
1855     for y := 0 to 4 do
1856       for x := 0 to 4 do begin
1857         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1858         for i := 0 to 3 do begin
1859           if ((y < 3) and (y = i)) or
1860              ((y = 3) and (i < 3)) or
1861              ((y = 4) and (i = 3))
1862           then
1863             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1864           else if ((y < 4) and (i = 3)) or
1865                   ((y = 4) and (i < 3))
1866           then
1867             px.Data.arr[i] := px.Range.arr[i]
1868           else
1869             px.Data.arr[i] := 0; //px.Range.arr[i];
1870         end;
1871         desc.Map(px, tmp, md);
1872       end;
1873   finally
1874     desc.FreeMappingData(md);
1875   end;
1876
1877   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1878   result.FreeDataOnDestroy       := true;
1879   result.FreeDataAfterGenTexture := false;
1880   result.SetFilter(GL_NEAREST, GL_NEAREST);
1881 end;
1882
1883 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1884 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1885 begin
1886   result.r := r;
1887   result.g := g;
1888   result.b := b;
1889   result.a := a;
1890 end;
1891
1892 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1893 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1894 begin
1895   result := [];
1896
1897   if (aFormat in [
1898         //8bpp
1899         tfAlpha4ub1, tfAlpha8ub1,
1900         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1901
1902         //16bpp
1903         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1904         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1905         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1906
1907         //24bpp
1908         tfBGR8ub3, tfRGB8ub3,
1909
1910         //32bpp
1911         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1912         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1913   then
1914     result := result + [ ftBMP ];
1915
1916   if (aFormat in [
1917         //8bbp
1918         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1919
1920         //16bbp
1921         tfAlpha16us1, tfLuminance16us1,
1922         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1923         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1924
1925         //24bbp
1926         tfBGR8ub3,
1927
1928         //32bbp
1929         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1930         tfDepth24ui1, tfDepth32ui1])
1931   then
1932     result := result + [ftTGA];
1933
1934   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1935     result := result + [ftDDS];
1936
1937 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1938   if aFormat in [
1939       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1940       tfRGB8ub3, tfRGBA8ui1,
1941       tfBGR8ub3, tfBGRA8ui1] then
1942     result := result + [ftPNG];
1943 {$ENDIF}
1944
1945 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1946   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1947     result := result + [ftJPEG];
1948 {$ENDIF}
1949 end;
1950
1951 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1952 function IsPowerOfTwo(aNumber: Integer): Boolean;
1953 begin
1954   while (aNumber and 1) = 0 do
1955     aNumber := aNumber shr 1;
1956   result := aNumber = 1;
1957 end;
1958
1959 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1960 function GetTopMostBit(aBitSet: QWord): Integer;
1961 begin
1962   result := 0;
1963   while aBitSet > 0 do begin
1964     inc(result);
1965     aBitSet := aBitSet shr 1;
1966   end;
1967 end;
1968
1969 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1970 function CountSetBits(aBitSet: QWord): Integer;
1971 begin
1972   result := 0;
1973   while aBitSet > 0 do begin
1974     if (aBitSet and 1) = 1 then
1975       inc(result);
1976     aBitSet := aBitSet shr 1;
1977   end;
1978 end;
1979
1980 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1981 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1982 begin
1983   result := Trunc(
1984     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1985     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1986     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1987 end;
1988
1989 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1990 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1991 begin
1992   result := Trunc(
1993     DEPTH_WEIGHT_R * aPixel.Data.r +
1994     DEPTH_WEIGHT_G * aPixel.Data.g +
1995     DEPTH_WEIGHT_B * aPixel.Data.b);
1996 end;
1997
1998 {$IFDEF GLB_SDL_IMAGE}
1999 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2000 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2001 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2002 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2003 begin
2004   result := TStream(context^.unknown.data1).Seek(offset, whence);
2005 end;
2006
2007 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2008 begin
2009   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2010 end;
2011
2012 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2013 begin
2014   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2015 end;
2016
2017 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2018 begin
2019   result := 0;
2020 end;
2021
2022 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2023 begin
2024   result := SDL_AllocRW;
2025
2026   if result = nil then
2027     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2028
2029   result^.seek := glBitmapRWseek;
2030   result^.read := glBitmapRWread;
2031   result^.write := glBitmapRWwrite;
2032   result^.close := glBitmapRWclose;
2033   result^.unknown.data1 := Stream;
2034 end;
2035 {$ENDIF}
2036
2037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2038 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2039 begin
2040   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2041 end;
2042
2043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2044 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2045 begin
2046   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2047 end;
2048
2049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2050 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2051 begin
2052   glBitmapDefaultMipmap := aValue;
2053 end;
2054
2055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2057 begin
2058   glBitmapDefaultFormat := aFormat;
2059 end;
2060
2061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2062 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2063 begin
2064   glBitmapDefaultFilterMin := aMin;
2065   glBitmapDefaultFilterMag := aMag;
2066 end;
2067
2068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2069 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2070 begin
2071   glBitmapDefaultWrapS := S;
2072   glBitmapDefaultWrapT := T;
2073   glBitmapDefaultWrapR := R;
2074 end;
2075
2076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2077 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2078 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2079 begin
2080   glDefaultSwizzle[0] := r;
2081   glDefaultSwizzle[1] := g;
2082   glDefaultSwizzle[2] := b;
2083   glDefaultSwizzle[3] := a;
2084 end;
2085 {$IFEND}
2086
2087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2089 begin
2090   result := glBitmapDefaultDeleteTextureOnFree;
2091 end;
2092
2093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2094 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2095 begin
2096   result := glBitmapDefaultFreeDataAfterGenTextures;
2097 end;
2098
2099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2100 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2101 begin
2102   result := glBitmapDefaultMipmap;
2103 end;
2104
2105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2106 function glBitmapGetDefaultFormat: TglBitmapFormat;
2107 begin
2108   result := glBitmapDefaultFormat;
2109 end;
2110
2111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2112 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2113 begin
2114   aMin := glBitmapDefaultFilterMin;
2115   aMag := glBitmapDefaultFilterMag;
2116 end;
2117
2118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2119 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2120 begin
2121   S := glBitmapDefaultWrapS;
2122   T := glBitmapDefaultWrapT;
2123   R := glBitmapDefaultWrapR;
2124 end;
2125
2126 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2128 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2129 begin
2130   r := glDefaultSwizzle[0];
2131   g := glDefaultSwizzle[1];
2132   b := glDefaultSwizzle[2];
2133   a := glDefaultSwizzle[3];
2134 end;
2135 {$ENDIF}
2136
2137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2138 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2140 function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
2141 var
2142   w, h: Integer;
2143 begin
2144   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2145     w := Max(1, aSize.X);
2146     h := Max(1, aSize.Y);
2147     result := GetSize(w, h);
2148   end else
2149     result := 0;
2150 end;
2151
2152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2153 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2154 begin
2155   result := 0;
2156   if (aWidth <= 0) or (aHeight <= 0) then
2157     exit;
2158   result := Ceil(aWidth * aHeight * BytesPerPixel);
2159 end;
2160
2161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2162 function TFormatDescriptor.CreateMappingData: Pointer;
2163 begin
2164   result := nil;
2165 end;
2166
2167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2168 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2169 begin
2170   //DUMMY
2171 end;
2172
2173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2174 function TFormatDescriptor.IsEmpty: Boolean;
2175 begin
2176   result := (fFormat = tfEmpty);
2177 end;
2178
2179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2180 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2181 var
2182   i: Integer;
2183   m: TglBitmapRec4ul;
2184 begin
2185   result := false;
2186   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2187     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2188   m := Mask;
2189   for i := 0 to 3 do
2190     if (aMask.arr[i] <> m.arr[i]) then
2191       exit;
2192   result := true;
2193 end;
2194
2195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2196 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2197 begin
2198   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2199   aPixel.Data   := Range;
2200   aPixel.Format := fFormat;
2201   aPixel.Range  := Range;
2202 end;
2203
2204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2205 constructor TFormatDescriptor.Create;
2206 begin
2207   inherited Create;
2208 end;
2209
2210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2211 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2214 begin
2215   aData^ := aPixel.Data.a;
2216   inc(aData);
2217 end;
2218
2219 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2220 begin
2221   aPixel.Data.r := 0;
2222   aPixel.Data.g := 0;
2223   aPixel.Data.b := 0;
2224   aPixel.Data.a := aData^;
2225   inc(aData);
2226 end;
2227
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2232 begin
2233   aData^ := LuminanceWeight(aPixel);
2234   inc(aData);
2235 end;
2236
2237 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2238 begin
2239   aPixel.Data.r := aData^;
2240   aPixel.Data.g := aData^;
2241   aPixel.Data.b := aData^;
2242   aPixel.Data.a := 0;
2243   inc(aData);
2244 end;
2245
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2250 var
2251   i: Integer;
2252 begin
2253   aData^ := 0;
2254   for i := 0 to 3 do
2255     if (Range.arr[i] > 0) then
2256       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2257   inc(aData);
2258 end;
2259
2260 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2261 var
2262   i: Integer;
2263 begin
2264   for i := 0 to 3 do
2265     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2266   inc(aData);
2267 end;
2268
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2272 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2273 begin
2274   inherited Map(aPixel, aData, aMapData);
2275   aData^ := aPixel.Data.a;
2276   inc(aData);
2277 end;
2278
2279 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2280 begin
2281   inherited Unmap(aData, aPixel, aMapData);
2282   aPixel.Data.a := aData^;
2283   inc(aData);
2284 end;
2285
2286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2287 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2290 begin
2291   aData^ := aPixel.Data.r;
2292   inc(aData);
2293   aData^ := aPixel.Data.g;
2294   inc(aData);
2295   aData^ := aPixel.Data.b;
2296   inc(aData);
2297 end;
2298
2299 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2300 begin
2301   aPixel.Data.r := aData^;
2302   inc(aData);
2303   aPixel.Data.g := aData^;
2304   inc(aData);
2305   aPixel.Data.b := aData^;
2306   inc(aData);
2307   aPixel.Data.a := 0;
2308 end;
2309
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2313 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2314 begin
2315   aData^ := aPixel.Data.b;
2316   inc(aData);
2317   aData^ := aPixel.Data.g;
2318   inc(aData);
2319   aData^ := aPixel.Data.r;
2320   inc(aData);
2321 end;
2322
2323 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2324 begin
2325   aPixel.Data.b := aData^;
2326   inc(aData);
2327   aPixel.Data.g := aData^;
2328   inc(aData);
2329   aPixel.Data.r := aData^;
2330   inc(aData);
2331   aPixel.Data.a := 0;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2337 procedure TfdRGBAub4.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 TfdRGBAub4.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 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2355 begin
2356   inherited Map(aPixel, aData, aMapData);
2357   aData^ := aPixel.Data.a;
2358   inc(aData);
2359 end;
2360
2361 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2362 begin
2363   inherited Unmap(aData, aPixel, aMapData);
2364   aPixel.Data.a := aData^;
2365   inc(aData);
2366 end;
2367
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2372 begin
2373   PWord(aData)^ := aPixel.Data.a;
2374   inc(aData, 2);
2375 end;
2376
2377 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2378 begin
2379   aPixel.Data.r := 0;
2380   aPixel.Data.g := 0;
2381   aPixel.Data.b := 0;
2382   aPixel.Data.a := PWord(aData)^;
2383   inc(aData, 2);
2384 end;
2385
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2390 begin
2391   PWord(aData)^ := LuminanceWeight(aPixel);
2392   inc(aData, 2);
2393 end;
2394
2395 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2396 begin
2397   aPixel.Data.r := PWord(aData)^;
2398   aPixel.Data.g := PWord(aData)^;
2399   aPixel.Data.b := PWord(aData)^;
2400   aPixel.Data.a := 0;
2401   inc(aData, 2);
2402 end;
2403
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2408 var
2409   i: Integer;
2410 begin
2411   PWord(aData)^ := 0;
2412   for i := 0 to 3 do
2413     if (Range.arr[i] > 0) then
2414       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2415   inc(aData, 2);
2416 end;
2417
2418 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2419 var
2420   i: Integer;
2421 begin
2422   for i := 0 to 3 do
2423     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2424   inc(aData, 2);
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2430 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2431 begin
2432   PWord(aData)^ := DepthWeight(aPixel);
2433   inc(aData, 2);
2434 end;
2435
2436 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2437 begin
2438   aPixel.Data.r := PWord(aData)^;
2439   aPixel.Data.g := PWord(aData)^;
2440   aPixel.Data.b := PWord(aData)^;
2441   aPixel.Data.a := PWord(aData)^;;
2442   inc(aData, 2);
2443 end;
2444
2445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2446 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2448 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2449 begin
2450   inherited Map(aPixel, aData, aMapData);
2451   PWord(aData)^ := aPixel.Data.a;
2452   inc(aData, 2);
2453 end;
2454
2455 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2456 begin
2457   inherited Unmap(aData, aPixel, aMapData);
2458   aPixel.Data.a := PWord(aData)^;
2459   inc(aData, 2);
2460 end;
2461
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2466 begin
2467   PWord(aData)^ := aPixel.Data.r;
2468   inc(aData, 2);
2469   PWord(aData)^ := aPixel.Data.g;
2470   inc(aData, 2);
2471   PWord(aData)^ := aPixel.Data.b;
2472   inc(aData, 2);
2473 end;
2474
2475 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2476 begin
2477   aPixel.Data.r := PWord(aData)^;
2478   inc(aData, 2);
2479   aPixel.Data.g := PWord(aData)^;
2480   inc(aData, 2);
2481   aPixel.Data.b := PWord(aData)^;
2482   inc(aData, 2);
2483   aPixel.Data.a := 0;
2484 end;
2485
2486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2487 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2490 begin
2491   PWord(aData)^ := aPixel.Data.b;
2492   inc(aData, 2);
2493   PWord(aData)^ := aPixel.Data.g;
2494   inc(aData, 2);
2495   PWord(aData)^ := aPixel.Data.r;
2496   inc(aData, 2);
2497 end;
2498
2499 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2500 begin
2501   aPixel.Data.b := PWord(aData)^;
2502   inc(aData, 2);
2503   aPixel.Data.g := PWord(aData)^;
2504   inc(aData, 2);
2505   aPixel.Data.r := PWord(aData)^;
2506   inc(aData, 2);
2507   aPixel.Data.a := 0;
2508 end;
2509
2510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2511 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2513 procedure TfdRGBAus4.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 TfdRGBAus4.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 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2531 begin
2532   PWord(aData)^ := aPixel.Data.a;
2533   inc(aData, 2);
2534   inherited Map(aPixel, aData, aMapData);
2535 end;
2536
2537 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2538 begin
2539   aPixel.Data.a := PWord(aData)^;
2540   inc(aData, 2);
2541   inherited Unmap(aData, aPixel, aMapData);
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2548 begin
2549   inherited Map(aPixel, aData, aMapData);
2550   PWord(aData)^ := aPixel.Data.a;
2551   inc(aData, 2);
2552 end;
2553
2554 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2555 begin
2556   inherited Unmap(aData, aPixel, aMapData);
2557   aPixel.Data.a := PWord(aData)^;
2558   inc(aData, 2);
2559 end;
2560
2561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2562 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2564 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2565 begin
2566   PWord(aData)^ := aPixel.Data.a;
2567   inc(aData, 2);
2568   inherited Map(aPixel, aData, aMapData);
2569 end;
2570
2571 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2572 begin
2573   aPixel.Data.a := PWord(aData)^;
2574   inc(aData, 2);
2575   inherited Unmap(aData, aPixel, aMapData);
2576 end;
2577
2578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2581 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2582 var
2583   i: Integer;
2584 begin
2585   PCardinal(aData)^ := 0;
2586   for i := 0 to 3 do
2587     if (Range.arr[i] > 0) then
2588       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2589   inc(aData, 4);
2590 end;
2591
2592 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2593 var
2594   i: Integer;
2595 begin
2596   for i := 0 to 3 do
2597     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2598   inc(aData, 2);
2599 end;
2600
2601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2605 begin
2606   PCardinal(aData)^ := DepthWeight(aPixel);
2607   inc(aData, 4);
2608 end;
2609
2610 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2611 begin
2612   aPixel.Data.r := PCardinal(aData)^;
2613   aPixel.Data.g := PCardinal(aData)^;
2614   aPixel.Data.b := PCardinal(aData)^;
2615   aPixel.Data.a := PCardinal(aData)^;
2616   inc(aData, 4);
2617 end;
2618
2619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 procedure TfdAlpha4ub1.SetValues;
2623 begin
2624   inherited SetValues;
2625   fBitsPerPixel     := 8;
2626   fFormat           := tfAlpha4ub1;
2627   fWithAlpha        := tfAlpha4ub1;
2628   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2629   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2630 {$IFNDEF OPENGL_ES}
2631   fOpenGLFormat     := tfAlpha4ub1;
2632   fglFormat         := GL_ALPHA;
2633   fglInternalFormat := GL_ALPHA4;
2634   fglDataFormat     := GL_UNSIGNED_BYTE;
2635 {$ELSE}
2636   fOpenGLFormat     := tfAlpha8ub1;
2637 {$ENDIF}
2638 end;
2639
2640 procedure TfdAlpha8ub1.SetValues;
2641 begin
2642   inherited SetValues;
2643   fBitsPerPixel     := 8;
2644   fFormat           := tfAlpha8ub1;
2645   fWithAlpha        := tfAlpha8ub1;
2646   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2647   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2648   fOpenGLFormat     := tfAlpha8ub1;
2649   fglFormat         := GL_ALPHA;
2650   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2651   fglDataFormat     := GL_UNSIGNED_BYTE;
2652 end;
2653
2654 procedure TfdAlpha16us1.SetValues;
2655 begin
2656   inherited SetValues;
2657   fBitsPerPixel     := 16;
2658   fFormat           := tfAlpha16us1;
2659   fWithAlpha        := tfAlpha16us1;
2660   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2661   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2662 {$IFNDEF OPENGL_ES}
2663   fOpenGLFormat     := tfAlpha16us1;
2664   fglFormat         := GL_ALPHA;
2665   fglInternalFormat := GL_ALPHA16;
2666   fglDataFormat     := GL_UNSIGNED_SHORT;
2667 {$ELSE}
2668   fOpenGLFormat     := tfAlpha8ub1;
2669 {$ENDIF}
2670 end;
2671
2672 procedure TfdLuminance4ub1.SetValues;
2673 begin
2674   inherited SetValues;
2675   fBitsPerPixel     := 8;
2676   fFormat           := tfLuminance4ub1;
2677   fWithAlpha        := tfLuminance4Alpha4ub2;
2678   fWithoutAlpha     := tfLuminance4ub1;
2679   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2680   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2681 {$IFNDEF OPENGL_ES}
2682   fOpenGLFormat     := tfLuminance4ub1;
2683   fglFormat         := GL_LUMINANCE;
2684   fglInternalFormat := GL_LUMINANCE4;
2685   fglDataFormat     := GL_UNSIGNED_BYTE;
2686 {$ELSE}
2687   fOpenGLFormat     := tfLuminance8ub1;
2688 {$ENDIF}
2689 end;
2690
2691 procedure TfdLuminance8ub1.SetValues;
2692 begin
2693   inherited SetValues;
2694   fBitsPerPixel     := 8;
2695   fFormat           := tfLuminance8ub1;
2696   fWithAlpha        := tfLuminance8Alpha8ub2;
2697   fWithoutAlpha     := tfLuminance8ub1;
2698   fOpenGLFormat     := tfLuminance8ub1;
2699   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2700   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2701   fglFormat         := GL_LUMINANCE;
2702   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2703   fglDataFormat     := GL_UNSIGNED_BYTE;
2704 end;
2705
2706 procedure TfdLuminance16us1.SetValues;
2707 begin
2708   inherited SetValues;
2709   fBitsPerPixel     := 16;
2710   fFormat           := tfLuminance16us1;
2711   fWithAlpha        := tfLuminance16Alpha16us2;
2712   fWithoutAlpha     := tfLuminance16us1;
2713   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2714   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2715 {$IFNDEF OPENGL_ES}
2716   fOpenGLFormat     := tfLuminance16us1;
2717   fglFormat         := GL_LUMINANCE;
2718   fglInternalFormat := GL_LUMINANCE16;
2719   fglDataFormat     := GL_UNSIGNED_SHORT;
2720 {$ELSE}
2721   fOpenGLFormat     := tfLuminance8ub1;
2722 {$ENDIF}
2723 end;
2724
2725 procedure TfdLuminance4Alpha4ub2.SetValues;
2726 begin
2727   inherited SetValues;
2728   fBitsPerPixel     := 16;
2729   fFormat           := tfLuminance4Alpha4ub2;
2730   fWithAlpha        := tfLuminance4Alpha4ub2;
2731   fWithoutAlpha     := tfLuminance4ub1;
2732   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2733   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2734 {$IFNDEF OPENGL_ES}
2735   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2736   fglFormat         := GL_LUMINANCE_ALPHA;
2737   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2738   fglDataFormat     := GL_UNSIGNED_BYTE;
2739 {$ELSE}
2740   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2741 {$ENDIF}
2742 end;
2743
2744 procedure TfdLuminance6Alpha2ub2.SetValues;
2745 begin
2746   inherited SetValues;
2747   fBitsPerPixel     := 16;
2748   fFormat           := tfLuminance6Alpha2ub2;
2749   fWithAlpha        := tfLuminance6Alpha2ub2;
2750   fWithoutAlpha     := tfLuminance8ub1;
2751   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2752   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2753 {$IFNDEF OPENGL_ES}
2754   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2755   fglFormat         := GL_LUMINANCE_ALPHA;
2756   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2757   fglDataFormat     := GL_UNSIGNED_BYTE;
2758 {$ELSE}
2759   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2760 {$ENDIF}
2761 end;
2762
2763 procedure TfdLuminance8Alpha8ub2.SetValues;
2764 begin
2765   inherited SetValues;
2766   fBitsPerPixel     := 16;
2767   fFormat           := tfLuminance8Alpha8ub2;
2768   fWithAlpha        := tfLuminance8Alpha8ub2;
2769   fWithoutAlpha     := tfLuminance8ub1;
2770   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2771   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2772   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2773   fglFormat         := GL_LUMINANCE_ALPHA;
2774   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2775   fglDataFormat     := GL_UNSIGNED_BYTE;
2776 end;
2777
2778 procedure TfdLuminance12Alpha4us2.SetValues;
2779 begin
2780   inherited SetValues;
2781   fBitsPerPixel     := 32;
2782   fFormat           := tfLuminance12Alpha4us2;
2783   fWithAlpha        := tfLuminance12Alpha4us2;
2784   fWithoutAlpha     := tfLuminance16us1;
2785   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2786   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2787 {$IFNDEF OPENGL_ES}
2788   fOpenGLFormat     := tfLuminance12Alpha4us2;
2789   fglFormat         := GL_LUMINANCE_ALPHA;
2790   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2791   fglDataFormat     := GL_UNSIGNED_SHORT;
2792 {$ELSE}
2793   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2794 {$ENDIF}
2795 end;
2796
2797 procedure TfdLuminance16Alpha16us2.SetValues;
2798 begin
2799   inherited SetValues;
2800   fBitsPerPixel     := 32;
2801   fFormat           := tfLuminance16Alpha16us2;
2802   fWithAlpha        := tfLuminance16Alpha16us2;
2803   fWithoutAlpha     := tfLuminance16us1;
2804   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2805   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2806 {$IFNDEF OPENGL_ES}
2807   fOpenGLFormat     := tfLuminance16Alpha16us2;
2808   fglFormat         := GL_LUMINANCE_ALPHA;
2809   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2810   fglDataFormat     := GL_UNSIGNED_SHORT;
2811 {$ELSE}
2812   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2813 {$ENDIF}
2814 end;
2815
2816 procedure TfdR3G3B2ub1.SetValues;
2817 begin
2818   inherited SetValues;
2819   fBitsPerPixel     := 8;
2820   fFormat           := tfR3G3B2ub1;
2821   fWithAlpha        := tfRGBA4us1;
2822   fWithoutAlpha     := tfR3G3B2ub1;
2823   fRGBInverted      := tfEmpty;
2824   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2825   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2826 {$IFNDEF OPENGL_ES}
2827   fOpenGLFormat     := tfR3G3B2ub1;
2828   fglFormat         := GL_RGB;
2829   fglInternalFormat := GL_R3_G3_B2;
2830   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2831 {$ELSE}
2832   fOpenGLFormat     := tfR5G6B5us1;
2833 {$ENDIF}
2834 end;
2835
2836 procedure TfdRGBX4us1.SetValues;
2837 begin
2838   inherited SetValues;
2839   fBitsPerPixel     := 16;
2840   fFormat           := tfRGBX4us1;
2841   fWithAlpha        := tfRGBA4us1;
2842   fWithoutAlpha     := tfRGBX4us1;
2843   fRGBInverted      := tfBGRX4us1;
2844   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2845   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2846 {$IFNDEF OPENGL_ES}
2847   fOpenGLFormat     := tfRGBX4us1;
2848   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2849   fglInternalFormat := GL_RGB4;
2850   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2851 {$ELSE}
2852   fOpenGLFormat     := tfR5G6B5us1;
2853 {$ENDIF}
2854 end;
2855
2856 procedure TfdXRGB4us1.SetValues;
2857 begin
2858   inherited SetValues;
2859   fBitsPerPixel     := 16;
2860   fFormat           := tfXRGB4us1;
2861   fWithAlpha        := tfARGB4us1;
2862   fWithoutAlpha     := tfXRGB4us1;
2863   fRGBInverted      := tfXBGR4us1;
2864   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2865   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2866 {$IFNDEF OPENGL_ES}
2867   fOpenGLFormat     := tfXRGB4us1;
2868   fglFormat         := GL_BGRA;
2869   fglInternalFormat := GL_RGB4;
2870   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2871 {$ELSE}
2872   fOpenGLFormat     := tfR5G6B5us1;
2873 {$ENDIF}
2874 end;
2875
2876 procedure TfdR5G6B5us1.SetValues;
2877 begin
2878   inherited SetValues;
2879   fBitsPerPixel     := 16;
2880   fFormat           := tfR5G6B5us1;
2881   fWithAlpha        := tfRGB5A1us1;
2882   fWithoutAlpha     := tfR5G6B5us1;
2883   fRGBInverted      := tfB5G6R5us1;
2884   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2885   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2886 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2887   fOpenGLFormat     := tfR5G6B5us1;
2888   fglFormat         := GL_RGB;
2889   fglInternalFormat := GL_RGB565;
2890   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2891 {$ELSE}
2892   fOpenGLFormat     := tfRGB8ub3;
2893 {$IFEND}
2894 end;
2895
2896 procedure TfdRGB5X1us1.SetValues;
2897 begin
2898   inherited SetValues;
2899   fBitsPerPixel     := 16;
2900   fFormat           := tfRGB5X1us1;
2901   fWithAlpha        := tfRGB5A1us1;
2902   fWithoutAlpha     := tfRGB5X1us1;
2903   fRGBInverted      := tfBGR5X1us1;
2904   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2905   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2906 {$IFNDEF OPENGL_ES}
2907   fOpenGLFormat     := tfRGB5X1us1;
2908   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2909   fglInternalFormat := GL_RGB5;
2910   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2911 {$ELSE}
2912   fOpenGLFormat     := tfR5G6B5us1;
2913 {$ENDIF}
2914 end;
2915
2916 procedure TfdX1RGB5us1.SetValues;
2917 begin
2918   inherited SetValues;
2919   fBitsPerPixel     := 16;
2920   fFormat           := tfX1RGB5us1;
2921   fWithAlpha        := tfA1RGB5us1;
2922   fWithoutAlpha     := tfX1RGB5us1;
2923   fRGBInverted      := tfX1BGR5us1;
2924   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2925   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2926 {$IFNDEF OPENGL_ES}
2927   fOpenGLFormat     := tfX1RGB5us1;
2928   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2929   fglInternalFormat := GL_RGB5;
2930   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2931 {$ELSE}
2932   fOpenGLFormat     := tfR5G6B5us1;
2933 {$ENDIF}
2934 end;
2935
2936 procedure TfdRGB8ub3.SetValues;
2937 begin
2938   inherited SetValues;
2939   fBitsPerPixel     := 24;
2940   fFormat           := tfRGB8ub3;
2941   fWithAlpha        := tfRGBA8ub4;
2942   fWithoutAlpha     := tfRGB8ub3;
2943   fRGBInverted      := tfBGR8ub3;
2944   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2945   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2946   fOpenGLFormat     := tfRGB8ub3;
2947   fglFormat         := GL_RGB;
2948   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2949   fglDataFormat     := GL_UNSIGNED_BYTE;
2950 end;
2951
2952 procedure TfdRGBX8ui1.SetValues;
2953 begin
2954   inherited SetValues;
2955   fBitsPerPixel     := 32;
2956   fFormat           := tfRGBX8ui1;
2957   fWithAlpha        := tfRGBA8ui1;
2958   fWithoutAlpha     := tfRGBX8ui1;
2959   fRGBInverted      := tfBGRX8ui1;
2960   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2961   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2962 {$IFNDEF OPENGL_ES}
2963   fOpenGLFormat     := tfRGBX8ui1;
2964   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2965   fglInternalFormat := GL_RGB8;
2966   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2967 {$ELSE}
2968   fOpenGLFormat     := tfRGB8ub3;
2969 {$ENDIF}
2970 end;
2971
2972 procedure TfdXRGB8ui1.SetValues;
2973 begin
2974   inherited SetValues;
2975   fBitsPerPixel     := 32;
2976   fFormat           := tfXRGB8ui1;
2977   fWithAlpha        := tfXRGB8ui1;
2978   fWithoutAlpha     := tfXRGB8ui1;
2979   fOpenGLFormat     := tfXRGB8ui1;
2980   fRGBInverted      := tfXBGR8ui1;
2981   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2982   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2983 {$IFNDEF OPENGL_ES}
2984   fOpenGLFormat     := tfXRGB8ui1;
2985   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2986   fglInternalFormat := GL_RGB8;
2987   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2988 {$ELSE}
2989   fOpenGLFormat     := tfRGB8ub3;
2990 {$ENDIF}
2991 end;
2992
2993 procedure TfdRGB10X2ui1.SetValues;
2994 begin
2995   inherited SetValues;
2996   fBitsPerPixel     := 32;
2997   fFormat           := tfRGB10X2ui1;
2998   fWithAlpha        := tfRGB10A2ui1;
2999   fWithoutAlpha     := tfRGB10X2ui1;
3000   fRGBInverted      := tfBGR10X2ui1;
3001   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3002   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3003 {$IFNDEF OPENGL_ES}
3004   fOpenGLFormat     := tfRGB10X2ui1;
3005   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3006   fglInternalFormat := GL_RGB10;
3007   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3008 {$ELSE}
3009   fOpenGLFormat     := tfRGB16us3;
3010 {$ENDIF}
3011 end;
3012
3013 procedure TfdX2RGB10ui1.SetValues;
3014 begin
3015   inherited SetValues;
3016   fBitsPerPixel     := 32;
3017   fFormat           := tfX2RGB10ui1;
3018   fWithAlpha        := tfA2RGB10ui1;
3019   fWithoutAlpha     := tfX2RGB10ui1;
3020   fRGBInverted      := tfX2BGR10ui1;
3021   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3022   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3023 {$IFNDEF OPENGL_ES}
3024   fOpenGLFormat     := tfX2RGB10ui1;
3025   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3026   fglInternalFormat := GL_RGB10;
3027   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3028 {$ELSE}
3029   fOpenGLFormat     := tfRGB16us3;
3030 {$ENDIF}
3031 end;
3032
3033 procedure TfdRGB16us3.SetValues;
3034 begin
3035   inherited SetValues;
3036   fBitsPerPixel     := 48;
3037   fFormat           := tfRGB16us3;
3038   fWithAlpha        := tfRGBA16us4;
3039   fWithoutAlpha     := tfRGB16us3;
3040   fRGBInverted      := tfBGR16us3;
3041   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3042   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3043 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3044   fOpenGLFormat     := tfRGB16us3;
3045   fglFormat         := GL_RGB;
3046   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3047   fglDataFormat     := GL_UNSIGNED_SHORT;
3048 {$ELSE}
3049   fOpenGLFormat     := tfRGB8ub3;
3050 {$IFEND}
3051 end;
3052
3053 procedure TfdRGBA4us1.SetValues;
3054 begin
3055   inherited SetValues;
3056   fBitsPerPixel     := 16;
3057   fFormat           := tfRGBA4us1;
3058   fWithAlpha        := tfRGBA4us1;
3059   fWithoutAlpha     := tfRGBX4us1;
3060   fOpenGLFormat     := tfRGBA4us1;
3061   fRGBInverted      := tfBGRA4us1;
3062   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3063   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3064   fglFormat         := GL_RGBA;
3065   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3066   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3067 end;
3068
3069 procedure TfdARGB4us1.SetValues;
3070 begin
3071   inherited SetValues;
3072   fBitsPerPixel     := 16;
3073   fFormat           := tfARGB4us1;
3074   fWithAlpha        := tfARGB4us1;
3075   fWithoutAlpha     := tfXRGB4us1;
3076   fRGBInverted      := tfABGR4us1;
3077   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3078   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3079 {$IFNDEF OPENGL_ES}
3080   fOpenGLFormat     := tfARGB4us1;
3081   fglFormat         := GL_BGRA;
3082   fglInternalFormat := GL_RGBA4;
3083   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3084 {$ELSE}
3085   fOpenGLFormat     := tfRGBA4us1;
3086 {$ENDIF}
3087 end;
3088
3089 procedure TfdRGB5A1us1.SetValues;
3090 begin
3091   inherited SetValues;
3092   fBitsPerPixel     := 16;
3093   fFormat           := tfRGB5A1us1;
3094   fWithAlpha        := tfRGB5A1us1;
3095   fWithoutAlpha     := tfRGB5X1us1;
3096   fOpenGLFormat     := tfRGB5A1us1;
3097   fRGBInverted      := tfBGR5A1us1;
3098   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3099   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3100   fglFormat         := GL_RGBA;
3101   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3102   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3103 end;
3104
3105 procedure TfdA1RGB5us1.SetValues;
3106 begin
3107   inherited SetValues;
3108   fBitsPerPixel     := 16;
3109   fFormat           := tfA1RGB5us1;
3110   fWithAlpha        := tfA1RGB5us1;
3111   fWithoutAlpha     := tfX1RGB5us1;
3112   fRGBInverted      := tfA1BGR5us1;
3113   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3114   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3115 {$IFNDEF OPENGL_ES}
3116   fOpenGLFormat     := tfA1RGB5us1;
3117   fglFormat         := GL_BGRA;
3118   fglInternalFormat := GL_RGB5_A1;
3119   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3120 {$ELSE}
3121   fOpenGLFormat     := tfRGB5A1us1;
3122 {$ENDIF}
3123 end;
3124
3125 procedure TfdRGBA8ui1.SetValues;
3126 begin
3127   inherited SetValues;
3128   fBitsPerPixel     := 32;
3129   fFormat           := tfRGBA8ui1;
3130   fWithAlpha        := tfRGBA8ui1;
3131   fWithoutAlpha     := tfRGBX8ui1;
3132   fRGBInverted      := tfBGRA8ui1;
3133   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3134   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3135 {$IFNDEF OPENGL_ES}
3136   fOpenGLFormat     := tfRGBA8ui1;
3137   fglFormat         := GL_RGBA;
3138   fglInternalFormat := GL_RGBA8;
3139   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3140 {$ELSE}
3141   fOpenGLFormat     := tfRGBA8ub4;
3142 {$ENDIF}
3143 end;
3144
3145 procedure TfdARGB8ui1.SetValues;
3146 begin
3147   inherited SetValues;
3148   fBitsPerPixel     := 32;
3149   fFormat           := tfARGB8ui1;
3150   fWithAlpha        := tfARGB8ui1;
3151   fWithoutAlpha     := tfXRGB8ui1;
3152   fRGBInverted      := tfABGR8ui1;
3153   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3154   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3155 {$IFNDEF OPENGL_ES}
3156   fOpenGLFormat     := tfARGB8ui1;
3157   fglFormat         := GL_BGRA;
3158   fglInternalFormat := GL_RGBA8;
3159   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3160 {$ELSE}
3161   fOpenGLFormat     := tfRGBA8ub4;
3162 {$ENDIF}
3163 end;
3164
3165 procedure TfdRGBA8ub4.SetValues;
3166 begin
3167   inherited SetValues;
3168   fBitsPerPixel     := 32;
3169   fFormat           := tfRGBA8ub4;
3170   fWithAlpha        := tfRGBA8ub4;
3171   fWithoutAlpha     := tfRGB8ub3;
3172   fOpenGLFormat     := tfRGBA8ub4;
3173   fRGBInverted      := tfBGRA8ub4;
3174   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3175   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3176   fglFormat         := GL_RGBA;
3177   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3178   fglDataFormat     := GL_UNSIGNED_BYTE;
3179 end;
3180
3181 procedure TfdRGB10A2ui1.SetValues;
3182 begin
3183   inherited SetValues;
3184   fBitsPerPixel     := 32;
3185   fFormat           := tfRGB10A2ui1;
3186   fWithAlpha        := tfRGB10A2ui1;
3187   fWithoutAlpha     := tfRGB10X2ui1;
3188   fRGBInverted      := tfBGR10A2ui1;
3189   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3190   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3191 {$IFNDEF OPENGL_ES}
3192   fOpenGLFormat     := tfRGB10A2ui1;
3193   fglFormat         := GL_RGBA;
3194   fglInternalFormat := GL_RGB10_A2;
3195   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3196 {$ELSE}
3197   fOpenGLFormat     := tfA2RGB10ui1;
3198 {$ENDIF}
3199 end;
3200
3201 procedure TfdA2RGB10ui1.SetValues;
3202 begin
3203   inherited SetValues;
3204   fBitsPerPixel     := 32;
3205   fFormat           := tfA2RGB10ui1;
3206   fWithAlpha        := tfA2RGB10ui1;
3207   fWithoutAlpha     := tfX2RGB10ui1;
3208   fRGBInverted      := tfA2BGR10ui1;
3209   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3210   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3211 {$IF NOT DEFINED(OPENGL_ES)}
3212   fOpenGLFormat     := tfA2RGB10ui1;
3213   fglFormat         := GL_BGRA;
3214   fglInternalFormat := GL_RGB10_A2;
3215   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3216 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3217   fOpenGLFormat     := tfA2RGB10ui1;
3218   fglFormat         := GL_RGBA;
3219   fglInternalFormat := GL_RGB10_A2;
3220   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3221 {$ELSE}
3222   fOpenGLFormat     := tfRGBA8ui1;
3223 {$IFEND}
3224 end;
3225
3226 procedure TfdRGBA16us4.SetValues;
3227 begin
3228   inherited SetValues;
3229   fBitsPerPixel     := 64;
3230   fFormat           := tfRGBA16us4;
3231   fWithAlpha        := tfRGBA16us4;
3232   fWithoutAlpha     := tfRGB16us3;
3233   fRGBInverted      := tfBGRA16us4;
3234   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3235   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3236 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3237   fOpenGLFormat     := tfRGBA16us4;
3238   fglFormat         := GL_RGBA;
3239   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3240   fglDataFormat     := GL_UNSIGNED_SHORT;
3241 {$ELSE}
3242   fOpenGLFormat     := tfRGBA8ub4;
3243 {$IFEND}
3244 end;
3245
3246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3249 procedure TfdBGRX4us1.SetValues;
3250 begin
3251   inherited SetValues;
3252   fBitsPerPixel     := 16;
3253   fFormat           := tfBGRX4us1;
3254   fWithAlpha        := tfBGRA4us1;
3255   fWithoutAlpha     := tfBGRX4us1;
3256   fRGBInverted      := tfRGBX4us1;
3257   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3258   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3259 {$IFNDEF OPENGL_ES}
3260   fOpenGLFormat     := tfBGRX4us1;
3261   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3262   fglInternalFormat := GL_RGB4;
3263   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3264 {$ELSE}
3265   fOpenGLFormat     := tfR5G6B5us1;
3266 {$ENDIF}
3267 end;
3268
3269 procedure TfdXBGR4us1.SetValues;
3270 begin
3271   inherited SetValues;
3272   fBitsPerPixel     := 16;
3273   fFormat           := tfXBGR4us1;
3274   fWithAlpha        := tfABGR4us1;
3275   fWithoutAlpha     := tfXBGR4us1;
3276   fRGBInverted      := tfXRGB4us1;
3277   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3278   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3279 {$IFNDEF OPENGL_ES}
3280   fOpenGLFormat     := tfXBGR4us1;
3281   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3282   fglInternalFormat := GL_RGB4;
3283   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3284 {$ELSE}
3285   fOpenGLFormat     := tfR5G6B5us1;
3286 {$ENDIF}
3287 end;
3288
3289 procedure TfdB5G6R5us1.SetValues;
3290 begin
3291   inherited SetValues;
3292   fBitsPerPixel     := 16;
3293   fFormat           := tfB5G6R5us1;
3294   fWithAlpha        := tfBGR5A1us1;
3295   fWithoutAlpha     := tfB5G6R5us1;
3296   fRGBInverted      := tfR5G6B5us1;
3297   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3298   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3299 {$IFNDEF OPENGL_ES}
3300   fOpenGLFormat     := tfB5G6R5us1;
3301   fglFormat         := GL_RGB;
3302   fglInternalFormat := GL_RGB565;
3303   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3304 {$ELSE}
3305   fOpenGLFormat     := tfR5G6B5us1;
3306 {$ENDIF}
3307 end;
3308
3309 procedure TfdBGR5X1us1.SetValues;
3310 begin
3311   inherited SetValues;
3312   fBitsPerPixel     := 16;
3313   fFormat           := tfBGR5X1us1;
3314   fWithAlpha        := tfBGR5A1us1;
3315   fWithoutAlpha     := tfBGR5X1us1;
3316   fRGBInverted      := tfRGB5X1us1;
3317   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3318   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3319 {$IFNDEF OPENGL_ES}
3320   fOpenGLFormat     := tfBGR5X1us1;
3321   fglFormat         := GL_BGRA;
3322   fglInternalFormat := GL_RGB5;
3323   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3324 {$ELSE}
3325   fOpenGLFormat     := tfR5G6B5us1;
3326 {$ENDIF}
3327 end;
3328
3329 procedure TfdX1BGR5us1.SetValues;
3330 begin
3331   inherited SetValues;
3332   fBitsPerPixel     := 16;
3333   fFormat           := tfX1BGR5us1;
3334   fWithAlpha        := tfA1BGR5us1;
3335   fWithoutAlpha     := tfX1BGR5us1;
3336   fRGBInverted      := tfX1RGB5us1;
3337   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3338   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3339 {$IFNDEF OPENGL_ES}
3340   fOpenGLFormat     := tfX1BGR5us1;
3341   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3342   fglInternalFormat := GL_RGB5;
3343   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3344 {$ELSE}
3345   fOpenGLFormat     := tfR5G6B5us1;
3346 {$ENDIF}
3347 end;
3348
3349 procedure TfdBGR8ub3.SetValues;
3350 begin
3351   inherited SetValues;
3352   fBitsPerPixel     := 24;
3353   fFormat           := tfBGR8ub3;
3354   fWithAlpha        := tfBGRA8ub4;
3355   fWithoutAlpha     := tfBGR8ub3;
3356   fRGBInverted      := tfRGB8ub3;
3357   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3358   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3359 {$IFNDEF OPENGL_ES}
3360   fOpenGLFormat     := tfBGR8ub3;
3361   fglFormat         := GL_BGR;
3362   fglInternalFormat := GL_RGB8;
3363   fglDataFormat     := GL_UNSIGNED_BYTE;
3364 {$ELSE}
3365   fOpenGLFormat     := tfRGB8ub3;
3366 {$ENDIF}
3367 end;
3368
3369 procedure TfdBGRX8ui1.SetValues;
3370 begin
3371   inherited SetValues;
3372   fBitsPerPixel     := 32;
3373   fFormat           := tfBGRX8ui1;
3374   fWithAlpha        := tfBGRA8ui1;
3375   fWithoutAlpha     := tfBGRX8ui1;
3376   fRGBInverted      := tfRGBX8ui1;
3377   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3378   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3379 {$IFNDEF OPENGL_ES}
3380   fOpenGLFormat     := tfBGRX8ui1;
3381   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3382   fglInternalFormat := GL_RGB8;
3383   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3384 {$ELSE}
3385   fOpenGLFormat     := tfRGB8ub3;
3386 {$ENDIF}
3387 end;
3388
3389 procedure TfdXBGR8ui1.SetValues;
3390 begin
3391   inherited SetValues;
3392   fBitsPerPixel     := 32;
3393   fFormat           := tfXBGR8ui1;
3394   fWithAlpha        := tfABGR8ui1;
3395   fWithoutAlpha     := tfXBGR8ui1;
3396   fRGBInverted      := tfXRGB8ui1;
3397   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3398   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3399 {$IFNDEF OPENGL_ES}
3400   fOpenGLFormat     := tfXBGR8ui1;
3401   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3402   fglInternalFormat := GL_RGB8;
3403   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3404 {$ELSE}
3405   fOpenGLFormat     := tfRGB8ub3;
3406 {$ENDIF}
3407 end;
3408
3409 procedure TfdBGR10X2ui1.SetValues;
3410 begin
3411   inherited SetValues;
3412   fBitsPerPixel     := 32;
3413   fFormat           := tfBGR10X2ui1;
3414   fWithAlpha        := tfBGR10A2ui1;
3415   fWithoutAlpha     := tfBGR10X2ui1;
3416   fRGBInverted      := tfRGB10X2ui1;
3417   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3418   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3419 {$IFNDEF OPENGL_ES}
3420   fOpenGLFormat     := tfBGR10X2ui1;
3421   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3422   fglInternalFormat := GL_RGB10;
3423   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3424 {$ELSE}
3425   fOpenGLFormat     := tfRGB16us3;
3426 {$ENDIF}
3427 end;
3428
3429 procedure TfdX2BGR10ui1.SetValues;
3430 begin
3431   inherited SetValues;
3432   fBitsPerPixel     := 32;
3433   fFormat           := tfX2BGR10ui1;
3434   fWithAlpha        := tfA2BGR10ui1;
3435   fWithoutAlpha     := tfX2BGR10ui1;
3436   fRGBInverted      := tfX2RGB10ui1;
3437   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3438   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3439 {$IFNDEF OPENGL_ES}
3440   fOpenGLFormat     := tfX2BGR10ui1;
3441   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3442   fglInternalFormat := GL_RGB10;
3443   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3444 {$ELSE}
3445   fOpenGLFormat     := tfRGB16us3;
3446 {$ENDIF}
3447 end;
3448
3449 procedure TfdBGR16us3.SetValues;
3450 begin
3451   inherited SetValues;
3452   fBitsPerPixel     := 48;
3453   fFormat           := tfBGR16us3;
3454   fWithAlpha        := tfBGRA16us4;
3455   fWithoutAlpha     := tfBGR16us3;
3456   fRGBInverted      := tfRGB16us3;
3457   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3458   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3459 {$IFNDEF OPENGL_ES}
3460   fOpenGLFormat     := tfBGR16us3;
3461   fglFormat         := GL_BGR;
3462   fglInternalFormat := GL_RGB16;
3463   fglDataFormat     := GL_UNSIGNED_SHORT;
3464 {$ELSE}
3465   fOpenGLFormat     := tfRGB16us3;
3466 {$ENDIF}
3467 end;
3468
3469 procedure TfdBGRA4us1.SetValues;
3470 begin
3471   inherited SetValues;
3472   fBitsPerPixel     := 16;
3473   fFormat           := tfBGRA4us1;
3474   fWithAlpha        := tfBGRA4us1;
3475   fWithoutAlpha     := tfBGRX4us1;
3476   fRGBInverted      := tfRGBA4us1;
3477   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3478   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3479 {$IFNDEF OPENGL_ES}
3480   fOpenGLFormat     := tfBGRA4us1;
3481   fglFormat         := GL_BGRA;
3482   fglInternalFormat := GL_RGBA4;
3483   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3484 {$ELSE}
3485   fOpenGLFormat     := tfRGBA4us1;
3486 {$ENDIF}
3487 end;
3488
3489 procedure TfdABGR4us1.SetValues;
3490 begin
3491   inherited SetValues;
3492   fBitsPerPixel     := 16;
3493   fFormat           := tfABGR4us1;
3494   fWithAlpha        := tfABGR4us1;
3495   fWithoutAlpha     := tfXBGR4us1;
3496   fRGBInverted      := tfARGB4us1;
3497   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3498   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3499 {$IFNDEF OPENGL_ES}
3500   fOpenGLFormat     := tfABGR4us1;
3501   fglFormat         := GL_RGBA;
3502   fglInternalFormat := GL_RGBA4;
3503   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3504 {$ELSE}
3505   fOpenGLFormat     := tfRGBA4us1;
3506 {$ENDIF}
3507 end;
3508
3509 procedure TfdBGR5A1us1.SetValues;
3510 begin
3511   inherited SetValues;
3512   fBitsPerPixel     := 16;
3513   fFormat           := tfBGR5A1us1;
3514   fWithAlpha        := tfBGR5A1us1;
3515   fWithoutAlpha     := tfBGR5X1us1;
3516   fRGBInverted      := tfRGB5A1us1;
3517   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3518   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3519 {$IFNDEF OPENGL_ES}
3520   fOpenGLFormat     := tfBGR5A1us1;
3521   fglFormat         := GL_BGRA;
3522   fglInternalFormat := GL_RGB5_A1;
3523   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3524 {$ELSE}
3525   fOpenGLFormat     := tfRGB5A1us1;
3526 {$ENDIF}
3527 end;
3528
3529 procedure TfdA1BGR5us1.SetValues;
3530 begin
3531   inherited SetValues;
3532   fBitsPerPixel     := 16;
3533   fFormat           := tfA1BGR5us1;
3534   fWithAlpha        := tfA1BGR5us1;
3535   fWithoutAlpha     := tfX1BGR5us1;
3536   fRGBInverted      := tfA1RGB5us1;
3537   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3538   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3539 {$IFNDEF OPENGL_ES}
3540   fOpenGLFormat     := tfA1BGR5us1;
3541   fglFormat         := GL_RGBA;
3542   fglInternalFormat := GL_RGB5_A1;
3543   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3544 {$ELSE}
3545   fOpenGLFormat     := tfRGB5A1us1;
3546 {$ENDIF}
3547 end;
3548
3549 procedure TfdBGRA8ui1.SetValues;
3550 begin
3551   inherited SetValues;
3552   fBitsPerPixel     := 32;
3553   fFormat           := tfBGRA8ui1;
3554   fWithAlpha        := tfBGRA8ui1;
3555   fWithoutAlpha     := tfBGRX8ui1;
3556   fRGBInverted      := tfRGBA8ui1;
3557   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3558   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3559 {$IFNDEF OPENGL_ES}
3560   fOpenGLFormat     := tfBGRA8ui1;
3561   fglFormat         := GL_BGRA;
3562   fglInternalFormat := GL_RGBA8;
3563   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3564 {$ELSE}
3565   fOpenGLFormat     := tfRGBA8ub4;
3566 {$ENDIF}
3567 end;
3568
3569 procedure TfdABGR8ui1.SetValues;
3570 begin
3571   inherited SetValues;
3572   fBitsPerPixel     := 32;
3573   fFormat           := tfABGR8ui1;
3574   fWithAlpha        := tfABGR8ui1;
3575   fWithoutAlpha     := tfXBGR8ui1;
3576   fRGBInverted      := tfARGB8ui1;
3577   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3578   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3579 {$IFNDEF OPENGL_ES}
3580   fOpenGLFormat     := tfABGR8ui1;
3581   fglFormat         := GL_RGBA;
3582   fglInternalFormat := GL_RGBA8;
3583   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3584 {$ELSE}
3585   fOpenGLFormat     := tfRGBA8ub4
3586 {$ENDIF}
3587 end;
3588
3589 procedure TfdBGRA8ub4.SetValues;
3590 begin
3591   inherited SetValues;
3592   fBitsPerPixel     := 32;
3593   fFormat           := tfBGRA8ub4;
3594   fWithAlpha        := tfBGRA8ub4;
3595   fWithoutAlpha     := tfBGR8ub3;
3596   fRGBInverted      := tfRGBA8ub4;
3597   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3598   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3599 {$IFNDEF OPENGL_ES}
3600   fOpenGLFormat     := tfBGRA8ub4;
3601   fglFormat         := GL_BGRA;
3602   fglInternalFormat := GL_RGBA8;
3603   fglDataFormat     := GL_UNSIGNED_BYTE;
3604 {$ELSE}
3605   fOpenGLFormat     := tfRGBA8ub4;
3606 {$ENDIF}
3607 end;
3608
3609 procedure TfdBGR10A2ui1.SetValues;
3610 begin
3611   inherited SetValues;
3612   fBitsPerPixel     := 32;
3613   fFormat           := tfBGR10A2ui1;
3614   fWithAlpha        := tfBGR10A2ui1;
3615   fWithoutAlpha     := tfBGR10X2ui1;
3616   fRGBInverted      := tfRGB10A2ui1;
3617   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3618   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3619 {$IFNDEF OPENGL_ES}
3620   fOpenGLFormat     := tfBGR10A2ui1;
3621   fglFormat         := GL_BGRA;
3622   fglInternalFormat := GL_RGB10_A2;
3623   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3624 {$ELSE}
3625   fOpenGLFormat     := tfA2RGB10ui1;
3626 {$ENDIF}
3627 end;
3628
3629 procedure TfdA2BGR10ui1.SetValues;
3630 begin
3631   inherited SetValues;
3632   fBitsPerPixel     := 32;
3633   fFormat           := tfA2BGR10ui1;
3634   fWithAlpha        := tfA2BGR10ui1;
3635   fWithoutAlpha     := tfX2BGR10ui1;
3636   fRGBInverted      := tfA2RGB10ui1;
3637   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3638   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3639 {$IFNDEF OPENGL_ES}
3640   fOpenGLFormat     := tfA2BGR10ui1;
3641   fglFormat         := GL_RGBA;
3642   fglInternalFormat := GL_RGB10_A2;
3643   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3644 {$ELSE}
3645   fOpenGLFormat     := tfA2RGB10ui1;
3646 {$ENDIF}
3647 end;
3648
3649 procedure TfdBGRA16us4.SetValues;
3650 begin
3651   inherited SetValues;
3652   fBitsPerPixel     := 64;
3653   fFormat           := tfBGRA16us4;
3654   fWithAlpha        := tfBGRA16us4;
3655   fWithoutAlpha     := tfBGR16us3;
3656   fRGBInverted      := tfRGBA16us4;
3657   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3658   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3659 {$IFNDEF OPENGL_ES}
3660   fOpenGLFormat     := tfBGRA16us4;
3661   fglFormat         := GL_BGRA;
3662   fglInternalFormat := GL_RGBA16;
3663   fglDataFormat     := GL_UNSIGNED_SHORT;
3664 {$ELSE}
3665   fOpenGLFormat     := tfRGBA16us4;
3666 {$ENDIF}
3667 end;
3668
3669 procedure TfdDepth16us1.SetValues;
3670 begin
3671   inherited SetValues;
3672   fBitsPerPixel     := 16;
3673   fFormat           := tfDepth16us1;
3674   fWithoutAlpha     := tfDepth16us1;
3675   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3676   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3677 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3678   fOpenGLFormat     := tfDepth16us1;
3679   fglFormat         := GL_DEPTH_COMPONENT;
3680   fglInternalFormat := GL_DEPTH_COMPONENT16;
3681   fglDataFormat     := GL_UNSIGNED_SHORT;
3682 {$IFEND}
3683 end;
3684
3685 procedure TfdDepth24ui1.SetValues;
3686 begin
3687   inherited SetValues;
3688   fBitsPerPixel     := 32;
3689   fFormat           := tfDepth24ui1;
3690   fWithoutAlpha     := tfDepth24ui1;
3691   fOpenGLFormat     := tfDepth24ui1;
3692   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3693   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3694 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3695   fOpenGLFormat     := tfDepth24ui1;
3696   fglFormat         := GL_DEPTH_COMPONENT;
3697   fglInternalFormat := GL_DEPTH_COMPONENT24;
3698   fglDataFormat     := GL_UNSIGNED_INT;
3699 {$IFEND}
3700 end;
3701
3702 procedure TfdDepth32ui1.SetValues;
3703 begin
3704   inherited SetValues;
3705   fBitsPerPixel     := 32;
3706   fFormat           := tfDepth32ui1;
3707   fWithoutAlpha     := tfDepth32ui1;
3708   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3709   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3710 {$IF NOT DEFINED(OPENGL_ES)}
3711   fOpenGLFormat     := tfDepth32ui1;
3712   fglFormat         := GL_DEPTH_COMPONENT;
3713   fglInternalFormat := GL_DEPTH_COMPONENT32;
3714   fglDataFormat     := GL_UNSIGNED_INT;
3715 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3716   fOpenGLFormat     := tfDepth24ui1;
3717 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3718   fOpenGLFormat     := tfDepth16us1;
3719 {$IFEND}
3720 end;
3721
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3726 begin
3727   raise EglBitmap.Create('mapping for compressed formats is not supported');
3728 end;
3729
3730 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3731 begin
3732   raise EglBitmap.Create('mapping for compressed formats is not supported');
3733 end;
3734
3735 procedure TfdS3tcDtx1RGBA.SetValues;
3736 begin
3737   inherited SetValues;
3738   fFormat           := tfS3tcDtx1RGBA;
3739   fWithAlpha        := tfS3tcDtx1RGBA;
3740   fUncompressed     := tfRGB5A1us1;
3741   fBitsPerPixel     := 4;
3742   fIsCompressed     := true;
3743 {$IFNDEF OPENGL_ES}
3744   fOpenGLFormat     := tfS3tcDtx1RGBA;
3745   fglFormat         := GL_COMPRESSED_RGBA;
3746   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3747   fglDataFormat     := GL_UNSIGNED_BYTE;
3748 {$ELSE}
3749   fOpenGLFormat     := fUncompressed;
3750 {$ENDIF}
3751 end;
3752
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3756 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3757 begin
3758   raise EglBitmap.Create('mapping for compressed formats is not supported');
3759 end;
3760
3761 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3762 begin
3763   raise EglBitmap.Create('mapping for compressed formats is not supported');
3764 end;
3765
3766 procedure TfdS3tcDtx3RGBA.SetValues;
3767 begin
3768   inherited SetValues;
3769   fFormat           := tfS3tcDtx3RGBA;
3770   fWithAlpha        := tfS3tcDtx3RGBA;
3771   fUncompressed     := tfRGBA8ub4;
3772   fBitsPerPixel     := 8;
3773   fIsCompressed     := true;
3774 {$IFNDEF OPENGL_ES}
3775   fOpenGLFormat     := tfS3tcDtx3RGBA;
3776   fglFormat         := GL_COMPRESSED_RGBA;
3777   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3778   fglDataFormat     := GL_UNSIGNED_BYTE;
3779 {$ELSE}
3780   fOpenGLFormat     := fUncompressed;
3781 {$ENDIF}
3782 end;
3783
3784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3785 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3787 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3788 begin
3789   raise EglBitmap.Create('mapping for compressed formats is not supported');
3790 end;
3791
3792 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3793 begin
3794   raise EglBitmap.Create('mapping for compressed formats is not supported');
3795 end;
3796
3797 procedure TfdS3tcDtx5RGBA.SetValues;
3798 begin
3799   inherited SetValues;
3800   fFormat           := tfS3tcDtx3RGBA;
3801   fWithAlpha        := tfS3tcDtx3RGBA;
3802   fUncompressed     := tfRGBA8ub4;
3803   fBitsPerPixel     := 8;
3804   fIsCompressed     := true;
3805 {$IFNDEF OPENGL_ES}
3806   fOpenGLFormat     := tfS3tcDtx3RGBA;
3807   fglFormat         := GL_COMPRESSED_RGBA;
3808   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3809   fglDataFormat     := GL_UNSIGNED_BYTE;
3810 {$ELSE}
3811   fOpenGLFormat     := fUncompressed;
3812 {$ENDIF}
3813 end;
3814
3815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3816 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3818 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3819 begin
3820   result := (fPrecision.r > 0);
3821 end;
3822
3823 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3824 begin
3825   result := (fPrecision.g > 0);
3826 end;
3827
3828 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3829 begin
3830   result := (fPrecision.b > 0);
3831 end;
3832
3833 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3834 begin
3835   result := (fPrecision.a > 0);
3836 end;
3837
3838 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3839 begin
3840   result := HasRed or HasGreen or HasBlue;
3841 end;
3842
3843 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3844 begin
3845   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3846 end;
3847
3848 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3849 procedure TglBitmapFormatDescriptor.SetValues;
3850 begin
3851   fFormat       := tfEmpty;
3852   fWithAlpha    := tfEmpty;
3853   fWithoutAlpha := tfEmpty;
3854   fOpenGLFormat := tfEmpty;
3855   fRGBInverted  := tfEmpty;
3856   fUncompressed := tfEmpty;
3857
3858   fBitsPerPixel := 0;
3859   fIsCompressed := false;
3860
3861   fglFormat         := 0;
3862   fglInternalFormat := 0;
3863   fglDataFormat     := 0;
3864
3865   FillChar(fPrecision, 0, SizeOf(fPrecision));
3866   FillChar(fShift,     0, SizeOf(fShift));
3867 end;
3868
3869 procedure TglBitmapFormatDescriptor.CalcValues;
3870 var
3871   i: Integer;
3872 begin
3873   fBytesPerPixel := fBitsPerPixel / 8;
3874   fChannelCount  := 0;
3875   for i := 0 to 3 do begin
3876     if (fPrecision.arr[i] > 0) then
3877       inc(fChannelCount);
3878     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3879     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3880   end;
3881 end;
3882
3883 constructor TglBitmapFormatDescriptor.Create;
3884 begin
3885   inherited Create;
3886   SetValues;
3887   CalcValues;
3888 end;
3889
3890 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3891 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3892 var
3893   f: TglBitmapFormat;
3894 begin
3895   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3896     result := TFormatDescriptor.Get(f);
3897     if (result.glInternalFormat = aInternalFormat) then
3898       exit;
3899   end;
3900   result := TFormatDescriptor.Get(tfEmpty);
3901 end;
3902
3903 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3904 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3905 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3906 class procedure TFormatDescriptor.Init;
3907 begin
3908   if not Assigned(FormatDescriptorCS) then
3909     FormatDescriptorCS := TCriticalSection.Create;
3910 end;
3911
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3914 begin
3915   FormatDescriptorCS.Enter;
3916   try
3917     result := FormatDescriptors[aFormat];
3918     if not Assigned(result) then begin
3919       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3920       FormatDescriptors[aFormat] := result;
3921     end;
3922   finally
3923     FormatDescriptorCS.Leave;
3924   end;
3925 end;
3926
3927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3928 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3929 begin
3930   result := Get(Get(aFormat).WithAlpha);
3931 end;
3932
3933 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3934 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3935 var
3936   ft: TglBitmapFormat;
3937 begin
3938   // find matching format with OpenGL support
3939   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3940     result := Get(ft);
3941     if (result.MaskMatch(aMask))      and
3942        (result.glFormat <> 0)         and
3943        (result.glInternalFormat <> 0) and
3944        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3945     then
3946       exit;
3947   end;
3948
3949   // find matching format without OpenGL Support
3950   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3951     result := Get(ft);
3952     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3953       exit;
3954   end;
3955
3956   result := TFormatDescriptor.Get(tfEmpty);
3957 end;
3958
3959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3960 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3961 var
3962   ft: TglBitmapFormat;
3963 begin
3964   // find matching format with OpenGL support
3965   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3966     result := Get(ft);
3967     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3968        glBitmapRec4ubCompare(result.Precision, aPrec) and
3969        (result.glFormat <> 0)         and
3970        (result.glInternalFormat <> 0) and
3971        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3972     then
3973       exit;
3974   end;
3975
3976   // find matching format without OpenGL Support
3977   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3978     result := Get(ft);
3979     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3980        glBitmapRec4ubCompare(result.Precision, aPrec)  and
3981        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3982       exit;
3983   end;
3984
3985   result := TFormatDescriptor.Get(tfEmpty);
3986 end;
3987
3988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3989 class procedure TFormatDescriptor.Clear;
3990 var
3991   f: TglBitmapFormat;
3992 begin
3993   FormatDescriptorCS.Enter;
3994   try
3995     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3996       FreeAndNil(FormatDescriptors[f]);
3997   finally
3998     FormatDescriptorCS.Leave;
3999   end;
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 class procedure TFormatDescriptor.Finalize;
4004 begin
4005   Clear;
4006   FreeAndNil(FormatDescriptorCS);
4007 end;
4008
4009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4010 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4012 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4013 var
4014   i: Integer;
4015 begin
4016   for i := 0 to 3 do begin
4017     fShift.arr[i] := 0;
4018     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4019       aMask.arr[i] := aMask.arr[i] shr 1;
4020       inc(fShift.arr[i]);
4021     end;
4022     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4023   end;
4024   CalcValues;
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4029 begin
4030   fBitsPerPixel := aBBP;
4031   fPrecision    := aPrec;
4032   fShift        := aShift;
4033   CalcValues;
4034 end;
4035
4036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4037 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4038 var
4039   data: QWord;
4040 begin
4041   data :=
4042     ((aPixel.Data.r and Range.r) shl Shift.r) or
4043     ((aPixel.Data.g and Range.g) shl Shift.g) or
4044     ((aPixel.Data.b and Range.b) shl Shift.b) or
4045     ((aPixel.Data.a and Range.a) shl Shift.a);
4046   case BitsPerPixel of
4047     8:           aData^  := data;
4048    16:     PWord(aData)^ := data;
4049    32: PCardinal(aData)^ := data;
4050    64:    PQWord(aData)^ := data;
4051   else
4052     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4053   end;
4054   inc(aData, Round(BytesPerPixel));
4055 end;
4056
4057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4058 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4059 var
4060   data: QWord;
4061   i: Integer;
4062 begin
4063   case BitsPerPixel of
4064      8: data :=           aData^;
4065     16: data :=     PWord(aData)^;
4066     32: data := PCardinal(aData)^;
4067     64: data :=    PQWord(aData)^;
4068   else
4069     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4070   end;
4071   for i := 0 to 3 do
4072     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4073   inc(aData, Round(BytesPerPixel));
4074 end;
4075
4076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4077 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4079 procedure TbmpColorTableFormat.SetValues;
4080 begin
4081   inherited SetValues;
4082   fShift := glBitmapRec4ub(8, 8, 8, 0);
4083 end;
4084
4085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4086 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4087 begin
4088   fFormat       := aFormat;
4089   fBitsPerPixel := aBPP;
4090   fPrecision    := aPrec;
4091   fShift        := aShift;
4092   CalcValues;
4093 end;
4094
4095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4096 procedure TbmpColorTableFormat.CalcValues;
4097 begin
4098   inherited CalcValues;
4099 end;
4100
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure TbmpColorTableFormat.CreateColorTable;
4103 var
4104   i: Integer;
4105 begin
4106   SetLength(fColorTable, 256);
4107   if not HasColor then begin
4108     // alpha
4109     for i := 0 to High(fColorTable) do begin
4110       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4111       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4112       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4113       fColorTable[i].a := 0;
4114     end;
4115   end else begin
4116     // normal
4117     for i := 0 to High(fColorTable) do begin
4118       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4119       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4120       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4121       fColorTable[i].a := 0;
4122     end;
4123   end;
4124 end;
4125
4126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4127 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4128 begin
4129   if (BitsPerPixel <> 8) then
4130     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4131   if not HasColor then
4132     // alpha
4133     aData^ := aPixel.Data.a
4134   else
4135     // normal
4136     aData^ := Round(
4137       ((aPixel.Data.r and Range.r) shl Shift.r) or
4138       ((aPixel.Data.g and Range.g) shl Shift.g) or
4139       ((aPixel.Data.b and Range.b) shl Shift.b));
4140   inc(aData);
4141 end;
4142
4143 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4144 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4145 begin
4146   if (BitsPerPixel <> 8) then
4147     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4148   with fColorTable[aData^] do begin
4149     aPixel.Data.r := r;
4150     aPixel.Data.g := g;
4151     aPixel.Data.b := b;
4152     aPixel.Data.a := a;
4153   end;
4154   inc(aData, 1);
4155 end;
4156
4157 destructor TbmpColorTableFormat.Destroy;
4158 begin
4159   SetLength(fColorTable, 0);
4160   inherited Destroy;
4161 end;
4162
4163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4164 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4167 var
4168   i: Integer;
4169 begin
4170   for i := 0 to 3 do begin
4171     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4172       if (aSourceFD.Range.arr[i] > 0) then
4173         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4174       else
4175         aPixel.Data.arr[i] := 0;
4176     end;
4177   end;
4178 end;
4179
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4182 begin
4183   with aFuncRec do begin
4184     if (Source.Range.r   > 0) then
4185       Dest.Data.r := Source.Data.r;
4186     if (Source.Range.g > 0) then
4187       Dest.Data.g := Source.Data.g;
4188     if (Source.Range.b  > 0) then
4189       Dest.Data.b := Source.Data.b;
4190     if (Source.Range.a > 0) then
4191       Dest.Data.a := Source.Data.a;
4192   end;
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4197 var
4198   i: Integer;
4199 begin
4200   with aFuncRec do begin
4201     for i := 0 to 3 do
4202       if (Source.Range.arr[i] > 0) then
4203         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4204   end;
4205 end;
4206
4207 type
4208   TShiftData = packed record
4209     case Integer of
4210       0: (r, g, b, a: SmallInt);
4211       1: (arr: array[0..3] of SmallInt);
4212   end;
4213   PShiftData = ^TShiftData;
4214
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4217 var
4218   i: Integer;
4219 begin
4220   with aFuncRec do
4221     for i := 0 to 3 do
4222       if (Source.Range.arr[i] > 0) then
4223         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4224 end;
4225
4226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4227 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4228 begin
4229   with aFuncRec do begin
4230     Dest.Data := Source.Data;
4231     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4232       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4233       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4234       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4235     end;
4236     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4237       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4238     end;
4239   end;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4244 var
4245   i: Integer;
4246 begin
4247   with aFuncRec do begin
4248     for i := 0 to 3 do
4249       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4250   end;
4251 end;
4252
4253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4254 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4255 var
4256   Temp: Single;
4257 begin
4258   with FuncRec do begin
4259     if (FuncRec.Args = nil) then begin //source has no alpha
4260       Temp :=
4261         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4262         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4263         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4264       Dest.Data.a := Round(Dest.Range.a * Temp);
4265     end else
4266       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4267   end;
4268 end;
4269
4270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4271 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4272 type
4273   PglBitmapPixelData = ^TglBitmapPixelData;
4274 begin
4275   with FuncRec do begin
4276     Dest.Data.r := Source.Data.r;
4277     Dest.Data.g := Source.Data.g;
4278     Dest.Data.b := Source.Data.b;
4279
4280     with PglBitmapPixelData(Args)^ do
4281       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4282           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4283           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4284         Dest.Data.a := 0
4285       else
4286         Dest.Data.a := Dest.Range.a;
4287   end;
4288 end;
4289
4290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4291 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4292 begin
4293   with FuncRec do begin
4294     Dest.Data.r := Source.Data.r;
4295     Dest.Data.g := Source.Data.g;
4296     Dest.Data.b := Source.Data.b;
4297     Dest.Data.a := PCardinal(Args)^;
4298   end;
4299 end;
4300
4301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4302 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4303 type
4304   PRGBPix = ^TRGBPix;
4305   TRGBPix = array [0..2] of byte;
4306 var
4307   Temp: Byte;
4308 begin
4309   while aWidth > 0 do begin
4310     Temp := PRGBPix(aData)^[0];
4311     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4312     PRGBPix(aData)^[2] := Temp;
4313
4314     if aHasAlpha then
4315       Inc(aData, 4)
4316     else
4317       Inc(aData, 3);
4318     dec(aWidth);
4319   end;
4320 end;
4321
4322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4323 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4324 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4325 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4326 begin
4327   result := TFormatDescriptor.Get(Format);
4328 end;
4329
4330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4331 function TglBitmap.GetWidth: Integer;
4332 begin
4333   if (ffX in fDimension.Fields) then
4334     result := fDimension.X
4335   else
4336     result := -1;
4337 end;
4338
4339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4340 function TglBitmap.GetHeight: Integer;
4341 begin
4342   if (ffY in fDimension.Fields) then
4343     result := fDimension.Y
4344   else
4345     result := -1;
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 function TglBitmap.GetFileWidth: Integer;
4350 begin
4351   result := Max(1, Width);
4352 end;
4353
4354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4355 function TglBitmap.GetFileHeight: Integer;
4356 begin
4357   result := Max(1, Height);
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4362 begin
4363   if fCustomData = aValue then
4364     exit;
4365   fCustomData := aValue;
4366 end;
4367
4368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4369 procedure TglBitmap.SetCustomName(const aValue: String);
4370 begin
4371   if fCustomName = aValue then
4372     exit;
4373   fCustomName := aValue;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4378 begin
4379   if fCustomNameW = aValue then
4380     exit;
4381   fCustomNameW := aValue;
4382 end;
4383
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4386 begin
4387   if fFreeDataOnDestroy = aValue then
4388     exit;
4389   fFreeDataOnDestroy := aValue;
4390 end;
4391
4392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4393 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4394 begin
4395   if fDeleteTextureOnFree = aValue then
4396     exit;
4397   fDeleteTextureOnFree := aValue;
4398 end;
4399
4400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4401 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4402 begin
4403   if fFormat = aValue then
4404     exit;
4405   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4406     raise EglBitmapUnsupportedFormat.Create(Format);
4407   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4408 end;
4409
4410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4411 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4412 begin
4413   if fFreeDataAfterGenTexture = aValue then
4414     exit;
4415   fFreeDataAfterGenTexture := aValue;
4416 end;
4417
4418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 procedure TglBitmap.SetID(const aValue: Cardinal);
4420 begin
4421   if fID = aValue then
4422     exit;
4423   fID := aValue;
4424 end;
4425
4426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4427 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4428 begin
4429   if fMipMap = aValue then
4430     exit;
4431   fMipMap := aValue;
4432 end;
4433
4434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4435 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4436 begin
4437   if fTarget = aValue then
4438     exit;
4439   fTarget := aValue;
4440 end;
4441
4442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4443 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4444 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4445 var
4446   MaxAnisotropic: Integer;
4447 {$IFEND}
4448 begin
4449   fAnisotropic := aValue;
4450   if (ID > 0) then begin
4451 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
4452     if GL_EXT_texture_filter_anisotropic then begin
4453       if fAnisotropic > 0 then begin
4454         Bind(false);
4455         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4456         if aValue > MaxAnisotropic then
4457           fAnisotropic := MaxAnisotropic;
4458         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4459       end;
4460     end else begin
4461       fAnisotropic := 0;
4462     end;
4463 {$ELSE}
4464     fAnisotropic := 0;
4465 {$IFEND}
4466   end;
4467 end;
4468
4469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4470 procedure TglBitmap.CreateID;
4471 begin
4472   if (ID <> 0) then
4473     glDeleteTextures(1, @fID);
4474   glGenTextures(1, @fID);
4475   Bind(false);
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
4480 begin
4481   // Set Up Parameters
4482   SetWrap(fWrapS, fWrapT, fWrapR);
4483   SetFilter(fFilterMin, fFilterMag);
4484   SetAnisotropic(fAnisotropic);
4485
4486 {$IFNDEF OPENGL_ES}
4487   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4488   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4489     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4490 {$ENDIF}
4491
4492 {$IFNDEF OPENGL_ES}
4493   // Mip Maps Generation Mode
4494   aBuildWithGlu := false;
4495   if (MipMap = mmMipmap) then begin
4496     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4497       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4498     else
4499       aBuildWithGlu := true;
4500   end else if (MipMap = mmMipmapGlu) then
4501     aBuildWithGlu := true;
4502 {$ELSE}
4503   if (MipMap = mmMipmap) then
4504     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
4505 {$ENDIF}
4506 end;
4507
4508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4509 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4510   const aWidth: Integer; const aHeight: Integer);
4511 var
4512   s: Single;
4513 begin
4514   if (Data <> aData) then begin
4515     if (Assigned(Data)) then
4516       FreeMem(Data);
4517     fData := aData;
4518   end;
4519
4520   if not Assigned(fData) then begin
4521     fPixelSize := 0;
4522     fRowSize   := 0;
4523   end else begin
4524     FillChar(fDimension, SizeOf(fDimension), 0);
4525     if aWidth <> -1 then begin
4526       fDimension.Fields := fDimension.Fields + [ffX];
4527       fDimension.X := aWidth;
4528     end;
4529
4530     if aHeight <> -1 then begin
4531       fDimension.Fields := fDimension.Fields + [ffY];
4532       fDimension.Y := aHeight;
4533     end;
4534
4535     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4536     fFormat    := aFormat;
4537     fPixelSize := Ceil(s);
4538     fRowSize   := Ceil(s * aWidth);
4539   end;
4540 end;
4541
4542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4543 function TglBitmap.FlipHorz: Boolean;
4544 begin
4545   result := false;
4546 end;
4547
4548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4549 function TglBitmap.FlipVert: Boolean;
4550 begin
4551   result := false;
4552 end;
4553
4554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4555 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4557 procedure TglBitmap.AfterConstruction;
4558 begin
4559   inherited AfterConstruction;
4560
4561   fID         := 0;
4562   fTarget     := 0;
4563 {$IFNDEF OPENGL_ES}
4564   fIsResident := false;
4565 {$ENDIF}
4566
4567   fMipMap                  := glBitmapDefaultMipmap;
4568   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4569   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4570
4571   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4572   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4573 {$IFNDEF OPENGL_ES}
4574   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4575 {$ENDIF}
4576 end;
4577
4578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4579 procedure TglBitmap.BeforeDestruction;
4580 var
4581   NewData: PByte;
4582 begin
4583   if fFreeDataOnDestroy then begin
4584     NewData := nil;
4585     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4586   end;
4587   if (fID > 0) and fDeleteTextureOnFree then
4588     glDeleteTextures(1, @fID);
4589   inherited BeforeDestruction;
4590 end;
4591
4592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4593 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4594 var
4595   TempPos: Integer;
4596 begin
4597   if not Assigned(aResType) then begin
4598     TempPos   := Pos('.', aResource);
4599     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4600     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4601   end;
4602 end;
4603
4604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4605 procedure TglBitmap.LoadFromFile(const aFilename: String);
4606 var
4607   fs: TFileStream;
4608 begin
4609   if not FileExists(aFilename) then
4610     raise EglBitmap.Create('file does not exist: ' + aFilename);
4611   fFilename := aFilename;
4612   fs := TFileStream.Create(fFilename, fmOpenRead);
4613   try
4614     fs.Position := 0;
4615     LoadFromStream(fs);
4616   finally
4617     fs.Free;
4618   end;
4619 end;
4620
4621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4622 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4623 begin
4624   {$IFDEF GLB_SUPPORT_PNG_READ}
4625   if not LoadPNG(aStream) then
4626   {$ENDIF}
4627   {$IFDEF GLB_SUPPORT_JPEG_READ}
4628   if not LoadJPEG(aStream) then
4629   {$ENDIF}
4630   if not LoadDDS(aStream) then
4631   if not LoadTGA(aStream) then
4632   if not LoadBMP(aStream) then
4633   if not LoadRAW(aStream) then
4634     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4635 end;
4636
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
4639   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4640 var
4641   tmpData: PByte;
4642   size: Integer;
4643 begin
4644   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4645   GetMem(tmpData, size);
4646   try
4647     FillChar(tmpData^, size, #$FF);
4648     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
4649   except
4650     if Assigned(tmpData) then
4651       FreeMem(tmpData);
4652     raise;
4653   end;
4654   Convert(Self, aFunc, false, aFormat, aArgs);
4655 end;
4656
4657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4658 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4659 var
4660   rs: TResourceStream;
4661 begin
4662   PrepareResType(aResource, aResType);
4663   rs := TResourceStream.Create(aInstance, aResource, aResType);
4664   try
4665     LoadFromStream(rs);
4666   finally
4667     rs.Free;
4668   end;
4669 end;
4670
4671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4672 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4673 var
4674   rs: TResourceStream;
4675 begin
4676   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4677   try
4678     LoadFromStream(rs);
4679   finally
4680     rs.Free;
4681   end;
4682 end;
4683
4684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4685 procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
4686 var
4687   fs: TFileStream;
4688 begin
4689   fs := TFileStream.Create(aFileName, fmCreate);
4690   try
4691     fs.Position := 0;
4692     SaveToStream(fs, aFileType);
4693   finally
4694     fs.Free;
4695   end;
4696 end;
4697
4698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4699 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4700 begin
4701   case aFileType of
4702     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4703     ftPNG:  SavePNG(aStream);
4704     {$ENDIF}
4705     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4706     ftJPEG: SaveJPEG(aStream);
4707     {$ENDIF}
4708     ftDDS:  SaveDDS(aStream);
4709     ftTGA:  SaveTGA(aStream);
4710     ftBMP:  SaveBMP(aStream);
4711     ftRAW:  SaveRAW(aStream);
4712   end;
4713 end;
4714
4715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4716 function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4717 begin
4718   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
4719 end;
4720
4721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4722 function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4723   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4724 var
4725   DestData, TmpData, SourceData: pByte;
4726   TempHeight, TempWidth: Integer;
4727   SourceFD, DestFD: TFormatDescriptor;
4728   SourceMD, DestMD: Pointer;
4729
4730   FuncRec: TglBitmapFunctionRec;
4731 begin
4732   Assert(Assigned(Data));
4733   Assert(Assigned(aSource));
4734   Assert(Assigned(aSource.Data));
4735
4736   result := false;
4737   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4738     SourceFD := TFormatDescriptor.Get(aSource.Format);
4739     DestFD   := TFormatDescriptor.Get(aFormat);
4740
4741     if (SourceFD.IsCompressed) then
4742       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4743     if (DestFD.IsCompressed) then
4744       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4745
4746     // inkompatible Formats so CreateTemp
4747     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
4748       aCreateTemp := true;
4749
4750     // Values
4751     TempHeight := Max(1, aSource.Height);
4752     TempWidth  := Max(1, aSource.Width);
4753
4754     FuncRec.Sender := Self;
4755     FuncRec.Args   := aArgs;
4756
4757     TmpData := nil;
4758     if aCreateTemp then begin
4759       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4760       DestData := TmpData;
4761     end else
4762       DestData := Data;
4763
4764     try
4765       SourceFD.PreparePixel(FuncRec.Source);
4766       DestFD.PreparePixel  (FuncRec.Dest);
4767
4768       SourceMD := SourceFD.CreateMappingData;
4769       DestMD   := DestFD.CreateMappingData;
4770
4771       FuncRec.Size            := aSource.Dimension;
4772       FuncRec.Position.Fields := FuncRec.Size.Fields;
4773
4774       try
4775         SourceData := aSource.Data;
4776         FuncRec.Position.Y := 0;
4777         while FuncRec.Position.Y < TempHeight do begin
4778           FuncRec.Position.X := 0;
4779           while FuncRec.Position.X < TempWidth do begin
4780             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4781             aFunc(FuncRec);
4782             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4783             inc(FuncRec.Position.X);
4784           end;
4785           inc(FuncRec.Position.Y);
4786         end;
4787
4788         // Updating Image or InternalFormat
4789         if aCreateTemp then
4790           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
4791         else if (aFormat <> fFormat) then
4792           Format := aFormat;
4793
4794         result := true;
4795       finally
4796         SourceFD.FreeMappingData(SourceMD);
4797         DestFD.FreeMappingData(DestMD);
4798       end;
4799     except
4800       if aCreateTemp and Assigned(TmpData) then
4801         FreeMem(TmpData);
4802       raise;
4803     end;
4804   end;
4805 end;
4806
4807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4808 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
4809 var
4810   SourceFD, DestFD: TFormatDescriptor;
4811   SourcePD, DestPD: TglBitmapPixelData;
4812   ShiftData: TShiftData;
4813
4814   function DataIsIdentical: Boolean;
4815   begin
4816     result := SourceFD.MaskMatch(DestFD.Mask);
4817   end;
4818
4819   function CanCopyDirect: Boolean;
4820   begin
4821     result :=
4822       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4823       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4824       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4825       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4826   end;
4827
4828   function CanShift: Boolean;
4829   begin
4830     result :=
4831       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
4832       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
4833       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
4834       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
4835   end;
4836
4837   function GetShift(aSource, aDest: Cardinal) : ShortInt;
4838   begin
4839     result := 0;
4840     while (aSource > aDest) and (aSource > 0) do begin
4841       inc(result);
4842       aSource := aSource shr 1;
4843     end;
4844   end;
4845
4846 begin
4847   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
4848     SourceFD := TFormatDescriptor.Get(Format);
4849     DestFD   := TFormatDescriptor.Get(aFormat);
4850
4851     if DataIsIdentical then begin
4852       result := true;
4853       Format := aFormat;
4854       exit;
4855     end;
4856
4857     SourceFD.PreparePixel(SourcePD);
4858     DestFD.PreparePixel  (DestPD);
4859
4860     if CanCopyDirect then
4861       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
4862     else if CanShift then begin
4863       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
4864       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
4865       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
4866       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
4867       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
4868     end else
4869       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
4870   end else
4871     result := true;
4872 end;
4873
4874 {$IFDEF GLB_SDL}
4875 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4876 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4877 var
4878   Row, RowSize: Integer;
4879   SourceData, TmpData: PByte;
4880   TempDepth: Integer;
4881   FormatDesc: TFormatDescriptor;
4882
4883   function GetRowPointer(Row: Integer): pByte;
4884   begin
4885     result := aSurface.pixels;
4886     Inc(result, Row * RowSize);
4887   end;
4888
4889 begin
4890   result := false;
4891
4892   FormatDesc := TFormatDescriptor.Get(Format);
4893   if FormatDesc.IsCompressed then
4894     raise EglBitmapUnsupportedFormat.Create(Format);
4895
4896   if Assigned(Data) then begin
4897     case Trunc(FormatDesc.PixelSize) of
4898       1: TempDepth :=  8;
4899       2: TempDepth := 16;
4900       3: TempDepth := 24;
4901       4: TempDepth := 32;
4902     else
4903       raise EglBitmapUnsupportedFormat.Create(Format);
4904     end;
4905
4906     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4907       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4908     SourceData := Data;
4909     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4910
4911     for Row := 0 to FileHeight-1 do begin
4912       TmpData := GetRowPointer(Row);
4913       if Assigned(TmpData) then begin
4914         Move(SourceData^, TmpData^, RowSize);
4915         inc(SourceData, RowSize);
4916       end;
4917     end;
4918     result := true;
4919   end;
4920 end;
4921
4922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4923 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4924 var
4925   pSource, pData, pTempData: PByte;
4926   Row, RowSize, TempWidth, TempHeight: Integer;
4927   IntFormat: TglBitmapFormat;
4928   fd: TFormatDescriptor;
4929   Mask: TglBitmapMask;
4930
4931   function GetRowPointer(Row: Integer): pByte;
4932   begin
4933     result := aSurface^.pixels;
4934     Inc(result, Row * RowSize);
4935   end;
4936
4937 begin
4938   result := false;
4939   if (Assigned(aSurface)) then begin
4940     with aSurface^.format^ do begin
4941       Mask.r := RMask;
4942       Mask.g := GMask;
4943       Mask.b := BMask;
4944       Mask.a := AMask;
4945       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
4946       if (IntFormat = tfEmpty) then
4947         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
4948     end;
4949
4950     fd := TFormatDescriptor.Get(IntFormat);
4951     TempWidth  := aSurface^.w;
4952     TempHeight := aSurface^.h;
4953     RowSize := fd.GetSize(TempWidth, 1);
4954     GetMem(pData, TempHeight * RowSize);
4955     try
4956       pTempData := pData;
4957       for Row := 0 to TempHeight -1 do begin
4958         pSource := GetRowPointer(Row);
4959         if (Assigned(pSource)) then begin
4960           Move(pSource^, pTempData^, RowSize);
4961           Inc(pTempData, RowSize);
4962         end;
4963       end;
4964       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
4965       result := true;
4966     except
4967       if Assigned(pData) then
4968         FreeMem(pData);
4969       raise;
4970     end;
4971   end;
4972 end;
4973
4974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4975 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4976 var
4977   Row, Col, AlphaInterleave: Integer;
4978   pSource, pDest: PByte;
4979
4980   function GetRowPointer(Row: Integer): pByte;
4981   begin
4982     result := aSurface.pixels;
4983     Inc(result, Row * Width);
4984   end;
4985
4986 begin
4987   result := false;
4988   if Assigned(Data) then begin
4989     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
4990       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4991
4992       AlphaInterleave := 0;
4993       case Format of
4994         tfLuminance8Alpha8ub2:
4995           AlphaInterleave := 1;
4996         tfBGRA8ub4, tfRGBA8ub4:
4997           AlphaInterleave := 3;
4998       end;
4999
5000       pSource := Data;
5001       for Row := 0 to Height -1 do begin
5002         pDest := GetRowPointer(Row);
5003         if Assigned(pDest) then begin
5004           for Col := 0 to Width -1 do begin
5005             Inc(pSource, AlphaInterleave);
5006             pDest^ := pSource^;
5007             Inc(pDest);
5008             Inc(pSource);
5009           end;
5010         end;
5011       end;
5012       result := true;
5013     end;
5014   end;
5015 end;
5016
5017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5018 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
5019 var
5020   bmp: TglBitmap2D;
5021 begin
5022   bmp := TglBitmap2D.Create;
5023   try
5024     bmp.AssignFromSurface(aSurface);
5025     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
5026   finally
5027     bmp.Free;
5028   end;
5029 end;
5030 {$ENDIF}
5031
5032 {$IFDEF GLB_DELPHI}
5033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5034 function CreateGrayPalette: HPALETTE;
5035 var
5036   Idx: Integer;
5037   Pal: PLogPalette;
5038 begin
5039   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
5040
5041   Pal.palVersion := $300;
5042   Pal.palNumEntries := 256;
5043
5044   for Idx := 0 to Pal.palNumEntries - 1 do begin
5045     Pal.palPalEntry[Idx].peRed   := Idx;
5046     Pal.palPalEntry[Idx].peGreen := Idx;
5047     Pal.palPalEntry[Idx].peBlue  := Idx;
5048     Pal.palPalEntry[Idx].peFlags := 0;
5049   end;
5050   Result := CreatePalette(Pal^);
5051   FreeMem(Pal);
5052 end;
5053
5054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5055 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
5056 var
5057   Row: Integer;
5058   pSource, pData: PByte;
5059 begin
5060   result := false;
5061   if Assigned(Data) then begin
5062     if Assigned(aBitmap) then begin
5063       aBitmap.Width  := Width;
5064       aBitmap.Height := Height;
5065
5066       case Format of
5067         tfAlpha8ub1, tfLuminance8ub1: begin
5068           aBitmap.PixelFormat := pf8bit;
5069           aBitmap.Palette     := CreateGrayPalette;
5070         end;
5071         tfRGB5A1us1:
5072           aBitmap.PixelFormat := pf15bit;
5073         tfR5G6B5us1:
5074           aBitmap.PixelFormat := pf16bit;
5075         tfRGB8ub3, tfBGR8ub3:
5076           aBitmap.PixelFormat := pf24bit;
5077         tfRGBA8ub4, tfBGRA8ub4:
5078           aBitmap.PixelFormat := pf32bit;
5079       else
5080         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
5081       end;
5082
5083       pSource := Data;
5084       for Row := 0 to FileHeight -1 do begin
5085         pData := aBitmap.Scanline[Row];
5086         Move(pSource^, pData^, fRowSize);
5087         Inc(pSource, fRowSize);
5088         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
5089           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
5090       end;
5091       result := true;
5092     end;
5093   end;
5094 end;
5095
5096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5097 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
5098 var
5099   pSource, pData, pTempData: PByte;
5100   Row, RowSize, TempWidth, TempHeight: Integer;
5101   IntFormat: TglBitmapFormat;
5102 begin
5103   result := false;
5104
5105   if (Assigned(aBitmap)) then begin
5106     case aBitmap.PixelFormat of
5107       pf8bit:
5108         IntFormat := tfLuminance8ub1;
5109       pf15bit:
5110         IntFormat := tfRGB5A1us1;
5111       pf16bit:
5112         IntFormat := tfR5G6B5us1;
5113       pf24bit:
5114         IntFormat := tfBGR8ub3;
5115       pf32bit:
5116         IntFormat := tfBGRA8ub4;
5117     else
5118       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
5119     end;
5120
5121     TempWidth  := aBitmap.Width;
5122     TempHeight := aBitmap.Height;
5123     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
5124     GetMem(pData, TempHeight * RowSize);
5125     try
5126       pTempData := pData;
5127       for Row := 0 to TempHeight -1 do begin
5128         pSource := aBitmap.Scanline[Row];
5129         if (Assigned(pSource)) then begin
5130           Move(pSource^, pTempData^, RowSize);
5131           Inc(pTempData, RowSize);
5132         end;
5133       end;
5134       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
5135       result := true;
5136     except
5137       if Assigned(pData) then
5138         FreeMem(pData);
5139       raise;
5140     end;
5141   end;
5142 end;
5143
5144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5145 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
5146 var
5147   Row, Col, AlphaInterleave: Integer;
5148   pSource, pDest: PByte;
5149 begin
5150   result := false;
5151
5152   if Assigned(Data) then begin
5153     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
5154       if Assigned(aBitmap) then begin
5155         aBitmap.PixelFormat := pf8bit;
5156         aBitmap.Palette     := CreateGrayPalette;
5157         aBitmap.Width       := Width;
5158         aBitmap.Height      := Height;
5159
5160         case Format of
5161           tfLuminance8Alpha8ub2:
5162             AlphaInterleave := 1;
5163           tfRGBA8ub4, tfBGRA8ub4:
5164             AlphaInterleave := 3;
5165           else
5166             AlphaInterleave := 0;
5167         end;
5168
5169         // Copy Data
5170         pSource := Data;
5171
5172         for Row := 0 to Height -1 do begin
5173           pDest := aBitmap.Scanline[Row];
5174           if Assigned(pDest) then begin
5175             for Col := 0 to Width -1 do begin
5176               Inc(pSource, AlphaInterleave);
5177               pDest^ := pSource^;
5178               Inc(pDest);
5179               Inc(pSource);
5180             end;
5181           end;
5182         end;
5183         result := true;
5184       end;
5185     end;
5186   end;
5187 end;
5188
5189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5190 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5191 var
5192   tex: TglBitmap2D;
5193 begin
5194   tex := TglBitmap2D.Create;
5195   try
5196     tex.AssignFromBitmap(ABitmap);
5197     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5198   finally
5199     tex.Free;
5200   end;
5201 end;
5202 {$ENDIF}
5203
5204 {$IFDEF GLB_LAZARUS}
5205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5206 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5207 var
5208   rid: TRawImageDescription;
5209   FormatDesc: TFormatDescriptor;
5210 begin
5211   if not Assigned(Data) then
5212     raise EglBitmap.Create('no pixel data assigned. load data before save');
5213
5214   result := false;
5215   if not Assigned(aImage) or (Format = tfEmpty) then
5216     exit;
5217   FormatDesc := TFormatDescriptor.Get(Format);
5218   if FormatDesc.IsCompressed then
5219     exit;
5220
5221   FillChar(rid{%H-}, SizeOf(rid), 0);
5222   if FormatDesc.IsGrayscale then
5223     rid.Format := ricfGray
5224   else
5225     rid.Format := ricfRGBA;
5226
5227   rid.Width        := Width;
5228   rid.Height       := Height;
5229   rid.Depth        := FormatDesc.BitsPerPixel;
5230   rid.BitOrder     := riboBitsInOrder;
5231   rid.ByteOrder    := riboLSBFirst;
5232   rid.LineOrder    := riloTopToBottom;
5233   rid.LineEnd      := rileTight;
5234   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
5235   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
5236   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
5237   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
5238   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
5239   rid.RedShift     := FormatDesc.Shift.r;
5240   rid.GreenShift   := FormatDesc.Shift.g;
5241   rid.BlueShift    := FormatDesc.Shift.b;
5242   rid.AlphaShift   := FormatDesc.Shift.a;
5243
5244   rid.MaskBitsPerPixel  := 0;
5245   rid.PaletteColorCount := 0;
5246
5247   aImage.DataDescription := rid;
5248   aImage.CreateData;
5249
5250   if not Assigned(aImage.PixelData) then
5251     raise EglBitmap.Create('error while creating LazIntfImage');
5252   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
5253
5254   result := true;
5255 end;
5256
5257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5258 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
5259 var
5260   f: TglBitmapFormat;
5261   FormatDesc: TFormatDescriptor;
5262   ImageData: PByte;
5263   ImageSize: Integer;
5264   CanCopy: Boolean;
5265   Mask: TglBitmapRec4ul;
5266
5267   procedure CopyConvert;
5268   var
5269     bfFormat: TbmpBitfieldFormat;
5270     pSourceLine, pDestLine: PByte;
5271     pSourceMD, pDestMD: Pointer;
5272     Shift, Prec: TglBitmapRec4ub;
5273     x, y: Integer;
5274     pixel: TglBitmapPixelData;
5275   begin
5276     bfFormat  := TbmpBitfieldFormat.Create;
5277     with aImage.DataDescription do begin
5278       Prec.r := RedPrec;
5279       Prec.g := GreenPrec;
5280       Prec.b := BluePrec;
5281       Prec.a := AlphaPrec;
5282       Shift.r := RedShift;
5283       Shift.g := GreenShift;
5284       Shift.b := BlueShift;
5285       Shift.a := AlphaShift;
5286       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
5287     end;
5288     pSourceMD := bfFormat.CreateMappingData;
5289     pDestMD   := FormatDesc.CreateMappingData;
5290     try
5291       for y := 0 to aImage.Height-1 do begin
5292         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
5293         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
5294         for x := 0 to aImage.Width-1 do begin
5295           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
5296           FormatDesc.Map(pixel, pDestLine, pDestMD);
5297         end;
5298       end;
5299     finally
5300       FormatDesc.FreeMappingData(pDestMD);
5301       bfFormat.FreeMappingData(pSourceMD);
5302       bfFormat.Free;
5303     end;
5304   end;
5305
5306 begin
5307   result := false;
5308   if not Assigned(aImage) then
5309     exit;
5310
5311   with aImage.DataDescription do begin
5312     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
5313     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
5314     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
5315     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
5316   end;
5317   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
5318   f          := FormatDesc.Format;
5319   if (f = tfEmpty) then
5320     exit;
5321
5322   CanCopy :=
5323     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
5324     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
5325
5326   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
5327   ImageData := GetMem(ImageSize);
5328   try
5329     if CanCopy then
5330       Move(aImage.PixelData^, ImageData^, ImageSize)
5331     else
5332       CopyConvert;
5333     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
5334   except
5335     if Assigned(ImageData) then
5336       FreeMem(ImageData);
5337     raise;
5338   end;
5339
5340   result := true;
5341 end;
5342
5343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5344 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
5345 var
5346   rid: TRawImageDescription;
5347   FormatDesc: TFormatDescriptor;
5348   Pixel: TglBitmapPixelData;
5349   x, y: Integer;
5350   srcMD: Pointer;
5351   src, dst: PByte;
5352 begin
5353   result := false;
5354   if not Assigned(aImage) or (Format = tfEmpty) then
5355     exit;
5356   FormatDesc := TFormatDescriptor.Get(Format);
5357   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5358     exit;
5359
5360   FillChar(rid{%H-}, SizeOf(rid), 0);
5361   rid.Format       := ricfGray;
5362   rid.Width        := Width;
5363   rid.Height       := Height;
5364   rid.Depth        := CountSetBits(FormatDesc.Range.a);
5365   rid.BitOrder     := riboBitsInOrder;
5366   rid.ByteOrder    := riboLSBFirst;
5367   rid.LineOrder    := riloTopToBottom;
5368   rid.LineEnd      := rileTight;
5369   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
5370   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
5371   rid.GreenPrec    := 0;
5372   rid.BluePrec     := 0;
5373   rid.AlphaPrec    := 0;
5374   rid.RedShift     := 0;
5375   rid.GreenShift   := 0;
5376   rid.BlueShift    := 0;
5377   rid.AlphaShift   := 0;
5378
5379   rid.MaskBitsPerPixel  := 0;
5380   rid.PaletteColorCount := 0;
5381
5382   aImage.DataDescription := rid;
5383   aImage.CreateData;
5384
5385   srcMD := FormatDesc.CreateMappingData;
5386   try
5387     FormatDesc.PreparePixel(Pixel);
5388     src := Data;
5389     dst := aImage.PixelData;
5390     for y := 0 to Height-1 do
5391       for x := 0 to Width-1 do begin
5392         FormatDesc.Unmap(src, Pixel, srcMD);
5393         case rid.BitsPerPixel of
5394            8: begin
5395             dst^ := Pixel.Data.a;
5396             inc(dst);
5397           end;
5398           16: begin
5399             PWord(dst)^ := Pixel.Data.a;
5400             inc(dst, 2);
5401           end;
5402           24: begin
5403             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
5404             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
5405             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
5406             inc(dst, 3);
5407           end;
5408           32: begin
5409             PCardinal(dst)^ := Pixel.Data.a;
5410             inc(dst, 4);
5411           end;
5412         else
5413           raise EglBitmapUnsupportedFormat.Create(Format);
5414         end;
5415       end;
5416   finally
5417     FormatDesc.FreeMappingData(srcMD);
5418   end;
5419   result := true;
5420 end;
5421
5422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5423 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5424 var
5425   tex: TglBitmap2D;
5426 begin
5427   tex := TglBitmap2D.Create;
5428   try
5429     tex.AssignFromLazIntfImage(aImage);
5430     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5431   finally
5432     tex.Free;
5433   end;
5434 end;
5435 {$ENDIF}
5436
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
5439   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5440 var
5441   rs: TResourceStream;
5442 begin
5443   PrepareResType(aResource, aResType);
5444   rs := TResourceStream.Create(aInstance, aResource, aResType);
5445   try
5446     result := AddAlphaFromStream(rs, aFunc, aArgs);
5447   finally
5448     rs.Free;
5449   end;
5450 end;
5451
5452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5453 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
5454   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5455 var
5456   rs: TResourceStream;
5457 begin
5458   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
5459   try
5460     result := AddAlphaFromStream(rs, aFunc, aArgs);
5461   finally
5462     rs.Free;
5463   end;
5464 end;
5465
5466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5467 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5468 begin
5469   if TFormatDescriptor.Get(Format).IsCompressed then
5470     raise EglBitmapUnsupportedFormat.Create(Format);
5471   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5472 end;
5473
5474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5475 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5476 var
5477   FS: TFileStream;
5478 begin
5479   FS := TFileStream.Create(aFileName, fmOpenRead);
5480   try
5481     result := AddAlphaFromStream(FS, aFunc, aArgs);
5482   finally
5483     FS.Free;
5484   end;
5485 end;
5486
5487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5488 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5489 var
5490   tex: TglBitmap2D;
5491 begin
5492   tex := TglBitmap2D.Create(aStream);
5493   try
5494     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5495   finally
5496     tex.Free;
5497   end;
5498 end;
5499
5500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5501 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5502 var
5503   DestData, DestData2, SourceData: pByte;
5504   TempHeight, TempWidth: Integer;
5505   SourceFD, DestFD: TFormatDescriptor;
5506   SourceMD, DestMD, DestMD2: Pointer;
5507
5508   FuncRec: TglBitmapFunctionRec;
5509 begin
5510   result := false;
5511
5512   Assert(Assigned(Data));
5513   Assert(Assigned(aBitmap));
5514   Assert(Assigned(aBitmap.Data));
5515
5516   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5517     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5518
5519     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5520     DestFD   := TFormatDescriptor.Get(Format);
5521
5522     if not Assigned(aFunc) then begin
5523       aFunc        := glBitmapAlphaFunc;
5524       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5525     end else
5526       FuncRec.Args := aArgs;
5527
5528     // Values
5529     TempHeight := aBitmap.FileHeight;
5530     TempWidth  := aBitmap.FileWidth;
5531
5532     FuncRec.Sender          := Self;
5533     FuncRec.Size            := Dimension;
5534     FuncRec.Position.Fields := FuncRec.Size.Fields;
5535
5536     DestData   := Data;
5537     DestData2  := Data;
5538     SourceData := aBitmap.Data;
5539
5540     // Mapping
5541     SourceFD.PreparePixel(FuncRec.Source);
5542     DestFD.PreparePixel  (FuncRec.Dest);
5543
5544     SourceMD := SourceFD.CreateMappingData;
5545     DestMD   := DestFD.CreateMappingData;
5546     DestMD2  := DestFD.CreateMappingData;
5547     try
5548       FuncRec.Position.Y := 0;
5549       while FuncRec.Position.Y < TempHeight do begin
5550         FuncRec.Position.X := 0;
5551         while FuncRec.Position.X < TempWidth do begin
5552           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5553           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5554           aFunc(FuncRec);
5555           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5556           inc(FuncRec.Position.X);
5557         end;
5558         inc(FuncRec.Position.Y);
5559       end;
5560     finally
5561       SourceFD.FreeMappingData(SourceMD);
5562       DestFD.FreeMappingData(DestMD);
5563       DestFD.FreeMappingData(DestMD2);
5564     end;
5565   end;
5566 end;
5567
5568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5569 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5570 begin
5571   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5572 end;
5573
5574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5575 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5576 var
5577   PixelData: TglBitmapPixelData;
5578 begin
5579   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5580   result := AddAlphaFromColorKeyFloat(
5581     aRed   / PixelData.Range.r,
5582     aGreen / PixelData.Range.g,
5583     aBlue  / PixelData.Range.b,
5584     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5585 end;
5586
5587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5588 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5589 var
5590   values: array[0..2] of Single;
5591   tmp: Cardinal;
5592   i: Integer;
5593   PixelData: TglBitmapPixelData;
5594 begin
5595   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5596   with PixelData do begin
5597     values[0] := aRed;
5598     values[1] := aGreen;
5599     values[2] := aBlue;
5600
5601     for i := 0 to 2 do begin
5602       tmp          := Trunc(Range.arr[i] * aDeviation);
5603       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5604       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5605     end;
5606     Data.a  := 0;
5607     Range.a := 0;
5608   end;
5609   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5610 end;
5611
5612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5613 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5614 begin
5615   result := AddAlphaFromValueFloat(aAlpha / $FF);
5616 end;
5617
5618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5619 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5620 var
5621   PixelData: TglBitmapPixelData;
5622 begin
5623   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5624   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5625 end;
5626
5627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5628 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5629 var
5630   PixelData: TglBitmapPixelData;
5631 begin
5632   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5633   with PixelData do
5634     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5635   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5636 end;
5637
5638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5639 function TglBitmap.RemoveAlpha: Boolean;
5640 var
5641   FormatDesc: TFormatDescriptor;
5642 begin
5643   result := false;
5644   FormatDesc := TFormatDescriptor.Get(Format);
5645   if Assigned(Data) then begin
5646     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5647       raise EglBitmapUnsupportedFormat.Create(Format);
5648     result := ConvertTo(FormatDesc.WithoutAlpha);
5649   end;
5650 end;
5651
5652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5653 function TglBitmap.Clone: TglBitmap;
5654 var
5655   Temp: TglBitmap;
5656   TempPtr: PByte;
5657   Size: Integer;
5658 begin
5659   result := nil;
5660   Temp := (ClassType.Create as TglBitmap);
5661   try
5662     // copy texture data if assigned
5663     if Assigned(Data) then begin
5664       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5665       GetMem(TempPtr, Size);
5666       try
5667         Move(Data^, TempPtr^, Size);
5668         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5669       except
5670         if Assigned(TempPtr) then
5671           FreeMem(TempPtr);
5672         raise;
5673       end;
5674     end else begin
5675       TempPtr := nil;
5676       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
5677     end;
5678
5679         // copy properties
5680     Temp.fID                      := ID;
5681     Temp.fTarget                  := Target;
5682     Temp.fFormat                  := Format;
5683     Temp.fMipMap                  := MipMap;
5684     Temp.fAnisotropic             := Anisotropic;
5685     Temp.fBorderColor             := fBorderColor;
5686     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5687     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5688     Temp.fFilterMin               := fFilterMin;
5689     Temp.fFilterMag               := fFilterMag;
5690     Temp.fWrapS                   := fWrapS;
5691     Temp.fWrapT                   := fWrapT;
5692     Temp.fWrapR                   := fWrapR;
5693     Temp.fFilename                := fFilename;
5694     Temp.fCustomName              := fCustomName;
5695     Temp.fCustomNameW             := fCustomNameW;
5696     Temp.fCustomData              := fCustomData;
5697
5698     result := Temp;
5699   except
5700     FreeAndNil(Temp);
5701     raise;
5702   end;
5703 end;
5704
5705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5706 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5707 begin
5708   if aUseRGB or aUseAlpha then
5709     Convert(glBitmapInvertFunc, false, {%H-}Pointer(
5710       ((Byte(aUseAlpha) and 1) shl 1) or
5711        (Byte(aUseRGB)   and 1)      ));
5712 end;
5713
5714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5715 procedure TglBitmap.FreeData;
5716 var
5717   TempPtr: PByte;
5718 begin
5719   TempPtr := nil;
5720   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
5721 end;
5722
5723 {$IFNDEF OPENGL_ES}
5724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5725 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5726 begin
5727   fBorderColor[0] := aRed;
5728   fBorderColor[1] := aGreen;
5729   fBorderColor[2] := aBlue;
5730   fBorderColor[3] := aAlpha;
5731   if (ID > 0) then begin
5732     Bind(false);
5733     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5734   end;
5735 end;
5736 {$ENDIF}
5737
5738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5739 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5740   const aAlpha: Byte);
5741 begin
5742   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5743 end;
5744
5745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5746 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5747 var
5748   PixelData: TglBitmapPixelData;
5749 begin
5750   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
5751   FillWithColorFloat(
5752     aRed   / PixelData.Range.r,
5753     aGreen / PixelData.Range.g,
5754     aBlue  / PixelData.Range.b,
5755     aAlpha / PixelData.Range.a);
5756 end;
5757
5758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5759 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5760 var
5761   PixelData: TglBitmapPixelData;
5762 begin
5763   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5764   with PixelData do begin
5765     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5766     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5767     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5768     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5769   end;
5770   Convert(glBitmapFillWithColorFunc, false, @PixelData);
5771 end;
5772
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
5775 begin
5776   //check MIN filter
5777   case aMin of
5778     GL_NEAREST:
5779       fFilterMin := GL_NEAREST;
5780     GL_LINEAR:
5781       fFilterMin := GL_LINEAR;
5782     GL_NEAREST_MIPMAP_NEAREST:
5783       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5784     GL_LINEAR_MIPMAP_NEAREST:
5785       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5786     GL_NEAREST_MIPMAP_LINEAR:
5787       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5788     GL_LINEAR_MIPMAP_LINEAR:
5789       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5790     else
5791       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
5792   end;
5793
5794   //check MAG filter
5795   case aMag of
5796     GL_NEAREST:
5797       fFilterMag := GL_NEAREST;
5798     GL_LINEAR:
5799       fFilterMag := GL_LINEAR;
5800     else
5801       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
5802   end;
5803
5804   //apply filter
5805   if (ID > 0) then begin
5806     Bind(false);
5807     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5808
5809     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
5810       case fFilterMin of
5811         GL_NEAREST, GL_LINEAR:
5812           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5813         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5814           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5815         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5816           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5817       end;
5818     end else
5819       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5820   end;
5821 end;
5822
5823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5824 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
5825
5826   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5827   begin
5828     case aValue of
5829 {$IFNDEF OPENGL_ES}
5830       GL_CLAMP:
5831         aTarget := GL_CLAMP;
5832 {$ENDIF}
5833
5834       GL_REPEAT:
5835         aTarget := GL_REPEAT;
5836
5837       GL_CLAMP_TO_EDGE: begin
5838 {$IFNDEF OPENGL_ES}
5839         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
5840           aTarget := GL_CLAMP
5841         else
5842 {$ENDIF}
5843           aTarget := GL_CLAMP_TO_EDGE;
5844       end;
5845
5846 {$IFNDEF OPENGL_ES}
5847       GL_CLAMP_TO_BORDER: begin
5848         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5849           aTarget := GL_CLAMP_TO_BORDER
5850         else
5851           aTarget := GL_CLAMP;
5852       end;
5853 {$ENDIF}
5854
5855 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
5856       GL_MIRRORED_REPEAT: begin
5857   {$IFNDEF OPENGL_ES}
5858         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5859   {$ELSE}
5860         if GL_VERSION_2_0 then
5861   {$ENDIF}
5862           aTarget := GL_MIRRORED_REPEAT
5863         else
5864           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5865       end;
5866 {$IFEND}
5867     else
5868       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
5869     end;
5870   end;
5871
5872 begin
5873   CheckAndSetWrap(S, fWrapS);
5874   CheckAndSetWrap(T, fWrapT);
5875   CheckAndSetWrap(R, fWrapR);
5876
5877   if (ID > 0) then begin
5878     Bind(false);
5879     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5880     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5881 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
5882     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
5883     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5884 {$IFEND}
5885   end;
5886 end;
5887
5888 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
5889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5890 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
5891
5892   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
5893   begin
5894     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
5895        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
5896       fSwizzle[aIndex] := aValue
5897     else
5898       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
5899   end;
5900
5901 begin
5902 {$IFNDEF OPENGL_ES}
5903   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
5904     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5905 {$ELSE}
5906   if not GL_VERSION_3_0 then
5907     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
5908 {$ENDIF}
5909   CheckAndSetValue(r, 0);
5910   CheckAndSetValue(g, 1);
5911   CheckAndSetValue(b, 2);
5912   CheckAndSetValue(a, 3);
5913
5914   if (ID > 0) then begin
5915     Bind(false);
5916 {$IFNDEF OPENGL_ES}
5917     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
5918 {$ELSE}
5919     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
5920     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
5921     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
5922     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
5923 {$ENDIF}
5924   end;
5925 end;
5926 {$IFEND}
5927
5928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5929 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5930 begin
5931   if aEnableTextureUnit then
5932     glEnable(Target);
5933   if (ID > 0) then
5934     glBindTexture(Target, ID);
5935 end;
5936
5937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5938 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5939 begin
5940   if aDisableTextureUnit then
5941     glDisable(Target);
5942   glBindTexture(Target, 0);
5943 end;
5944
5945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5946 constructor TglBitmap.Create;
5947 begin
5948   if (ClassType = TglBitmap) then
5949     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5950   inherited Create;
5951   fFormat            := glBitmapGetDefaultFormat;
5952   fFreeDataOnDestroy := true;
5953 end;
5954
5955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5956 constructor TglBitmap.Create(const aFileName: String);
5957 begin
5958   Create;
5959   LoadFromFile(aFileName);
5960 end;
5961
5962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5963 constructor TglBitmap.Create(const aStream: TStream);
5964 begin
5965   Create;
5966   LoadFromStream(aStream);
5967 end;
5968
5969 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5970 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
5971 var
5972   ImageSize: Integer;
5973 begin
5974   Create;
5975   if not Assigned(aData) then begin
5976     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5977     GetMem(aData, ImageSize);
5978     try
5979       FillChar(aData^, ImageSize, #$FF);
5980       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5981     except
5982       if Assigned(aData) then
5983         FreeMem(aData);
5984       raise;
5985     end;
5986   end else begin
5987     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
5988   end;
5989 end;
5990
5991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5992 constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
5993 begin
5994   Create;
5995   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5996 end;
5997
5998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5999 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
6000 begin
6001   Create;
6002   LoadFromResource(aInstance, aResource, aResType);
6003 end;
6004
6005 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6006 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6007 begin
6008   Create;
6009   LoadFromResourceID(aInstance, aResourceID, aResType);
6010 end;
6011
6012 {$IFDEF GLB_SUPPORT_PNG_READ}
6013 {$IF DEFINED(GLB_LAZ_PNG)}
6014 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6015 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6017 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6018 const
6019   MAGIC_LEN = 8;
6020   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
6021 var
6022   reader: TLazReaderPNG;
6023   intf: TLazIntfImage;
6024   StreamPos: Int64;
6025   magic: String[MAGIC_LEN];
6026 begin
6027   result := true;
6028   StreamPos := aStream.Position;
6029
6030   SetLength(magic, MAGIC_LEN);
6031   aStream.Read(magic[1], MAGIC_LEN);
6032   aStream.Position := StreamPos;
6033   if (magic <> PNG_MAGIC) then begin
6034     result := false;
6035     exit;
6036   end;
6037
6038   intf   := TLazIntfImage.Create(0, 0);
6039   reader := TLazReaderPNG.Create;
6040   try try
6041     reader.UpdateDescription := true;
6042     reader.ImageRead(aStream, intf);
6043     AssignFromLazIntfImage(intf);
6044   except
6045     result := false;
6046     aStream.Position := StreamPos;
6047     exit;
6048   end;
6049   finally
6050     reader.Free;
6051     intf.Free;
6052   end;
6053 end;
6054
6055 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6057 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6058 var
6059   Surface: PSDL_Surface;
6060   RWops: PSDL_RWops;
6061 begin
6062   result := false;
6063   RWops := glBitmapCreateRWops(aStream);
6064   try
6065     if IMG_isPNG(RWops) > 0 then begin
6066       Surface := IMG_LoadPNG_RW(RWops);
6067       try
6068         AssignFromSurface(Surface);
6069         result := true;
6070       finally
6071         SDL_FreeSurface(Surface);
6072       end;
6073     end;
6074   finally
6075     SDL_FreeRW(RWops);
6076   end;
6077 end;
6078
6079 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6081 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6082 begin
6083   TStream(png_get_io_ptr(png)).Read(buffer^, size);
6084 end;
6085
6086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6087 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6088 var
6089   StreamPos: Int64;
6090   signature: array [0..7] of byte;
6091   png: png_structp;
6092   png_info: png_infop;
6093
6094   TempHeight, TempWidth: Integer;
6095   Format: TglBitmapFormat;
6096
6097   png_data: pByte;
6098   png_rows: array of pByte;
6099   Row, LineSize: Integer;
6100 begin
6101   result := false;
6102
6103   if not init_libPNG then
6104     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
6105
6106   try
6107     // signature
6108     StreamPos := aStream.Position;
6109     aStream.Read(signature{%H-}, 8);
6110     aStream.Position := StreamPos;
6111
6112     if png_check_sig(@signature, 8) <> 0 then begin
6113       // png read struct
6114       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6115       if png = nil then
6116         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
6117
6118       // png info
6119       png_info := png_create_info_struct(png);
6120       if png_info = nil then begin
6121         png_destroy_read_struct(@png, nil, nil);
6122         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
6123       end;
6124
6125       // set read callback
6126       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
6127
6128       // read informations
6129       png_read_info(png, png_info);
6130
6131       // size
6132       TempHeight := png_get_image_height(png, png_info);
6133       TempWidth := png_get_image_width(png, png_info);
6134
6135       // format
6136       case png_get_color_type(png, png_info) of
6137         PNG_COLOR_TYPE_GRAY:
6138           Format := tfLuminance8ub1;
6139         PNG_COLOR_TYPE_GRAY_ALPHA:
6140           Format := tfLuminance8Alpha8us1;
6141         PNG_COLOR_TYPE_RGB:
6142           Format := tfRGB8ub3;
6143         PNG_COLOR_TYPE_RGB_ALPHA:
6144           Format := tfRGBA8ub4;
6145         else
6146           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6147       end;
6148
6149       // cut upper 8 bit from 16 bit formats
6150       if png_get_bit_depth(png, png_info) > 8 then
6151         png_set_strip_16(png);
6152
6153       // expand bitdepth smaller than 8
6154       if png_get_bit_depth(png, png_info) < 8 then
6155         png_set_expand(png);
6156
6157       // allocating mem for scanlines
6158       LineSize := png_get_rowbytes(png, png_info);
6159       GetMem(png_data, TempHeight * LineSize);
6160       try
6161         SetLength(png_rows, TempHeight);
6162         for Row := Low(png_rows) to High(png_rows) do begin
6163           png_rows[Row] := png_data;
6164           Inc(png_rows[Row], Row * LineSize);
6165         end;
6166
6167         // read complete image into scanlines
6168         png_read_image(png, @png_rows[0]);
6169
6170         // read end
6171         png_read_end(png, png_info);
6172
6173         // destroy read struct
6174         png_destroy_read_struct(@png, @png_info, nil);
6175
6176         SetLength(png_rows, 0);
6177
6178         // set new data
6179         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
6180
6181         result := true;
6182       except
6183         if Assigned(png_data) then
6184           FreeMem(png_data);
6185         raise;
6186       end;
6187     end;
6188   finally
6189     quit_libPNG;
6190   end;
6191 end;
6192
6193 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6195 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
6196 var
6197   StreamPos: Int64;
6198   Png: TPNGObject;
6199   Header: String[8];
6200   Row, Col, PixSize, LineSize: Integer;
6201   NewImage, pSource, pDest, pAlpha: pByte;
6202   PngFormat: TglBitmapFormat;
6203   FormatDesc: TFormatDescriptor;
6204
6205 const
6206   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
6207
6208 begin
6209   result := false;
6210
6211   StreamPos := aStream.Position;
6212   aStream.Read(Header[0], SizeOf(Header));
6213   aStream.Position := StreamPos;
6214
6215   {Test if the header matches}
6216   if Header = PngHeader then begin
6217     Png := TPNGObject.Create;
6218     try
6219       Png.LoadFromStream(aStream);
6220
6221       case Png.Header.ColorType of
6222         COLOR_GRAYSCALE:
6223           PngFormat := tfLuminance8ub1;
6224         COLOR_GRAYSCALEALPHA:
6225           PngFormat := tfLuminance8Alpha8us1;
6226         COLOR_RGB:
6227           PngFormat := tfBGR8ub3;
6228         COLOR_RGBALPHA:
6229           PngFormat := tfBGRA8ub4;
6230         else
6231           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6232       end;
6233
6234       FormatDesc := TFormatDescriptor.Get(PngFormat);
6235       PixSize    := Round(FormatDesc.PixelSize);
6236       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
6237
6238       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
6239       try
6240         pDest := NewImage;
6241
6242         case Png.Header.ColorType of
6243           COLOR_RGB, COLOR_GRAYSCALE:
6244             begin
6245               for Row := 0 to Png.Height -1 do begin
6246                 Move (Png.Scanline[Row]^, pDest^, LineSize);
6247                 Inc(pDest, LineSize);
6248               end;
6249             end;
6250           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
6251             begin
6252               PixSize := PixSize -1;
6253
6254               for Row := 0 to Png.Height -1 do begin
6255                 pSource := Png.Scanline[Row];
6256                 pAlpha := pByte(Png.AlphaScanline[Row]);
6257
6258                 for Col := 0 to Png.Width -1 do begin
6259                   Move (pSource^, pDest^, PixSize);
6260                   Inc(pSource, PixSize);
6261                   Inc(pDest, PixSize);
6262
6263                   pDest^ := pAlpha^;
6264                   inc(pAlpha);
6265                   Inc(pDest);
6266                 end;
6267               end;
6268             end;
6269           else
6270             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
6271         end;
6272
6273         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
6274
6275         result := true;
6276       except
6277         if Assigned(NewImage) then
6278           FreeMem(NewImage);
6279         raise;
6280       end;
6281     finally
6282       Png.Free;
6283     end;
6284   end;
6285 end;
6286 {$IFEND}
6287 {$ENDIF}
6288
6289 {$IFDEF GLB_SUPPORT_PNG_WRITE}
6290 {$IFDEF GLB_LIB_PNG}
6291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6292 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
6293 begin
6294   TStream(png_get_io_ptr(png)).Write(buffer^, size);
6295 end;
6296 {$ENDIF}
6297
6298 {$IF DEFINED(GLB_LAZ_PNG)}
6299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6300 procedure TglBitmap.SavePNG(const aStream: TStream);
6301 var
6302   png: TPortableNetworkGraphic;
6303   intf: TLazIntfImage;
6304   raw: TRawImage;
6305 begin
6306   png  := TPortableNetworkGraphic.Create;
6307   intf := TLazIntfImage.Create(0, 0);
6308   try
6309     if not AssignToLazIntfImage(intf) then
6310       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6311     intf.GetRawImage(raw);
6312     png.LoadFromRawImage(raw, false);
6313     png.SaveToStream(aStream);
6314   finally
6315     png.Free;
6316     intf.Free;
6317   end;
6318 end;
6319
6320 {$ELSEIF DEFINED(GLB_LIB_PNG)}
6321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6322 procedure TglBitmap.SavePNG(const aStream: TStream);
6323 var
6324   png: png_structp;
6325   png_info: png_infop;
6326   png_rows: array of pByte;
6327   LineSize: Integer;
6328   ColorType: Integer;
6329   Row: Integer;
6330   FormatDesc: TFormatDescriptor;
6331 begin
6332   if not (ftPNG in FormatGetSupportedFiles(Format)) then
6333     raise EglBitmapUnsupportedFormat.Create(Format);
6334
6335   if not init_libPNG then
6336     raise Exception.Create('unable to initialize libPNG.');
6337
6338   try
6339     case Format of
6340       tfAlpha8ub1, tfLuminance8ub1:
6341         ColorType := PNG_COLOR_TYPE_GRAY;
6342       tfLuminance8Alpha8us1:
6343         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
6344       tfBGR8ub3, tfRGB8ub3:
6345         ColorType := PNG_COLOR_TYPE_RGB;
6346       tfBGRA8ub4, tfRGBA8ub4:
6347         ColorType := PNG_COLOR_TYPE_RGBA;
6348       else
6349         raise EglBitmapUnsupportedFormat.Create(Format);
6350     end;
6351
6352     FormatDesc := TFormatDescriptor.Get(Format);
6353     LineSize := FormatDesc.GetSize(Width, 1);
6354
6355     // creating array for scanline
6356     SetLength(png_rows, Height);
6357     try
6358       for Row := 0 to Height - 1 do begin
6359         png_rows[Row] := Data;
6360         Inc(png_rows[Row], Row * LineSize)
6361       end;
6362
6363       // write struct
6364       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
6365       if png = nil then
6366         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
6367
6368       // create png info
6369       png_info := png_create_info_struct(png);
6370       if png_info = nil then begin
6371         png_destroy_write_struct(@png, nil);
6372         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
6373       end;
6374
6375       // set read callback
6376       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
6377
6378       // set compression
6379       png_set_compression_level(png, 6);
6380
6381       if Format in [tfBGR8ub3, tfBGRA8ub4] then
6382         png_set_bgr(png);
6383
6384       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
6385       png_write_info(png, png_info);
6386       png_write_image(png, @png_rows[0]);
6387       png_write_end(png, png_info);
6388       png_destroy_write_struct(@png, @png_info);
6389     finally
6390       SetLength(png_rows, 0);
6391     end;
6392   finally
6393     quit_libPNG;
6394   end;
6395 end;
6396
6397 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
6398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6399 procedure TglBitmap.SavePNG(const aStream: TStream);
6400 var
6401   Png: TPNGObject;
6402
6403   pSource, pDest: pByte;
6404   X, Y, PixSize: Integer;
6405   ColorType: Cardinal;
6406   Alpha: Boolean;
6407
6408   pTemp: pByte;
6409   Temp: Byte;
6410 begin
6411   if not (ftPNG in FormatGetSupportedFiles (Format)) then
6412     raise EglBitmapUnsupportedFormat.Create(Format);
6413
6414   case Format of
6415     tfAlpha8ub1, tfLuminance8ub1: begin
6416       ColorType := COLOR_GRAYSCALE;
6417       PixSize   := 1;
6418       Alpha     := false;
6419     end;
6420     tfLuminance8Alpha8us1: begin
6421       ColorType := COLOR_GRAYSCALEALPHA;
6422       PixSize   := 1;
6423       Alpha     := true;
6424     end;
6425     tfBGR8ub3, tfRGB8ub3: begin
6426       ColorType := COLOR_RGB;
6427       PixSize   := 3;
6428       Alpha     := false;
6429     end;
6430     tfBGRA8ub4, tfRGBA8ub4: begin
6431       ColorType := COLOR_RGBALPHA;
6432       PixSize   := 3;
6433       Alpha     := true
6434     end;
6435   else
6436     raise EglBitmapUnsupportedFormat.Create(Format);
6437   end;
6438
6439   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
6440   try
6441     // Copy ImageData
6442     pSource := Data;
6443     for Y := 0 to Height -1 do begin
6444       pDest := png.ScanLine[Y];
6445       for X := 0 to Width -1 do begin
6446         Move(pSource^, pDest^, PixSize);
6447         Inc(pDest, PixSize);
6448         Inc(pSource, PixSize);
6449         if Alpha then begin
6450           png.AlphaScanline[Y]^[X] := pSource^;
6451           Inc(pSource);
6452         end;
6453       end;
6454
6455       // convert RGB line to BGR
6456       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
6457         pTemp := png.ScanLine[Y];
6458         for X := 0 to Width -1 do begin
6459           Temp := pByteArray(pTemp)^[0];
6460           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
6461           pByteArray(pTemp)^[2] := Temp;
6462           Inc(pTemp, 3);
6463         end;
6464       end;
6465     end;
6466
6467     // Save to Stream
6468     Png.CompressionLevel := 6;
6469     Png.SaveToStream(aStream);
6470   finally
6471     FreeAndNil(Png);
6472   end;
6473 end;
6474 {$IFEND}
6475 {$ENDIF}
6476
6477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6478 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6480 {$IFDEF GLB_LIB_JPEG}
6481 type
6482   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
6483   glBitmap_libJPEG_source_mgr = record
6484     pub: jpeg_source_mgr;
6485
6486     SrcStream: TStream;
6487     SrcBuffer: array [1..4096] of byte;
6488   end;
6489
6490   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
6491   glBitmap_libJPEG_dest_mgr = record
6492     pub: jpeg_destination_mgr;
6493
6494     DestStream: TStream;
6495     DestBuffer: array [1..4096] of byte;
6496   end;
6497
6498 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
6499 begin
6500   //DUMMY
6501 end;
6502
6503
6504 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
6505 begin
6506   //DUMMY
6507 end;
6508
6509
6510 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
6511 begin
6512   //DUMMY
6513 end;
6514
6515 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
6516 begin
6517   //DUMMY
6518 end;
6519
6520
6521 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
6522 begin
6523   //DUMMY
6524 end;
6525
6526
6527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6528 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
6529 var
6530   src: glBitmap_libJPEG_source_mgr_ptr;
6531   bytes: integer;
6532 begin
6533   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6534
6535   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
6536         if (bytes <= 0) then begin
6537                 src^.SrcBuffer[1] := $FF;
6538                 src^.SrcBuffer[2] := JPEG_EOI;
6539                 bytes := 2;
6540         end;
6541
6542         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6543         src^.pub.bytes_in_buffer := bytes;
6544
6545   result := true;
6546 end;
6547
6548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6549 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6550 var
6551   src: glBitmap_libJPEG_source_mgr_ptr;
6552 begin
6553   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6554
6555   if num_bytes > 0 then begin
6556     // wanted byte isn't in buffer so set stream position and read buffer
6557     if num_bytes > src^.pub.bytes_in_buffer then begin
6558       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6559       src^.pub.fill_input_buffer(cinfo);
6560     end else begin
6561       // wanted byte is in buffer so only skip
6562                 inc(src^.pub.next_input_byte, num_bytes);
6563                 dec(src^.pub.bytes_in_buffer, num_bytes);
6564     end;
6565   end;
6566 end;
6567
6568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6569 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6570 var
6571   dest: glBitmap_libJPEG_dest_mgr_ptr;
6572 begin
6573   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6574
6575   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6576     // write complete buffer
6577     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6578
6579     // reset buffer
6580     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6581     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6582   end;
6583
6584   result := true;
6585 end;
6586
6587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6588 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6589 var
6590   Idx: Integer;
6591   dest: glBitmap_libJPEG_dest_mgr_ptr;
6592 begin
6593   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6594
6595   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6596     // check for endblock
6597     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6598       // write endblock
6599       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6600
6601       // leave
6602       break;
6603     end else
6604       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6605   end;
6606 end;
6607 {$ENDIF}
6608
6609 {$IFDEF GLB_SUPPORT_JPEG_READ}
6610 {$IF DEFINED(GLB_LAZ_JPEG)}
6611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6612 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6613 const
6614   MAGIC_LEN = 2;
6615   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
6616 var
6617   intf: TLazIntfImage;
6618   reader: TFPReaderJPEG;
6619   StreamPos: Int64;
6620   magic: String[MAGIC_LEN];
6621 begin
6622   result := true;
6623   StreamPos := aStream.Position;
6624
6625   SetLength(magic, MAGIC_LEN);
6626   aStream.Read(magic[1], MAGIC_LEN);
6627   aStream.Position := StreamPos;
6628   if (magic <> JPEG_MAGIC) then begin
6629     result := false;
6630     exit;
6631   end;
6632
6633   reader := TFPReaderJPEG.Create;
6634   intf := TLazIntfImage.Create(0, 0);
6635   try try
6636     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
6637     reader.ImageRead(aStream, intf);
6638     AssignFromLazIntfImage(intf);
6639   except
6640     result := false;
6641     aStream.Position := StreamPos;
6642     exit;
6643   end;
6644   finally
6645     reader.Free;
6646     intf.Free;
6647   end;
6648 end;
6649
6650 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
6651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6652 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6653 var
6654   Surface: PSDL_Surface;
6655   RWops: PSDL_RWops;
6656 begin
6657   result := false;
6658
6659   RWops := glBitmapCreateRWops(aStream);
6660   try
6661     if IMG_isJPG(RWops) > 0 then begin
6662       Surface := IMG_LoadJPG_RW(RWops);
6663       try
6664         AssignFromSurface(Surface);
6665         result := true;
6666       finally
6667         SDL_FreeSurface(Surface);
6668       end;
6669     end;
6670   finally
6671     SDL_FreeRW(RWops);
6672   end;
6673 end;
6674
6675 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6677 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6678 var
6679   StreamPos: Int64;
6680   Temp: array[0..1]of Byte;
6681
6682   jpeg: jpeg_decompress_struct;
6683   jpeg_err: jpeg_error_mgr;
6684
6685   IntFormat: TglBitmapFormat;
6686   pImage: pByte;
6687   TempHeight, TempWidth: Integer;
6688
6689   pTemp: pByte;
6690   Row: Integer;
6691
6692   FormatDesc: TFormatDescriptor;
6693 begin
6694   result := false;
6695
6696   if not init_libJPEG then
6697     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6698
6699   try
6700     // reading first two bytes to test file and set cursor back to begin
6701     StreamPos := aStream.Position;
6702     aStream.Read({%H-}Temp[0], 2);
6703     aStream.Position := StreamPos;
6704
6705     // if Bitmap then read file.
6706     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6707       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6708       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6709
6710       // error managment
6711       jpeg.err := jpeg_std_error(@jpeg_err);
6712       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6713       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6714
6715       // decompression struct
6716       jpeg_create_decompress(@jpeg);
6717
6718       // allocation space for streaming methods
6719       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6720
6721       // seeting up custom functions
6722       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6723         pub.init_source       := glBitmap_libJPEG_init_source;
6724         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6725         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6726         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6727         pub.term_source       := glBitmap_libJPEG_term_source;
6728
6729         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6730         pub.next_input_byte := nil;   // until buffer loaded
6731
6732         SrcStream := aStream;
6733       end;
6734
6735       // set global decoding state
6736       jpeg.global_state := DSTATE_START;
6737
6738       // read header of jpeg
6739       jpeg_read_header(@jpeg, false);
6740
6741       // setting output parameter
6742       case jpeg.jpeg_color_space of
6743         JCS_GRAYSCALE:
6744           begin
6745             jpeg.out_color_space := JCS_GRAYSCALE;
6746             IntFormat := tfLuminance8ub1;
6747           end;
6748         else
6749           jpeg.out_color_space := JCS_RGB;
6750           IntFormat := tfRGB8ub3;
6751       end;
6752
6753       // reading image
6754       jpeg_start_decompress(@jpeg);
6755
6756       TempHeight := jpeg.output_height;
6757       TempWidth := jpeg.output_width;
6758
6759       FormatDesc := TFormatDescriptor.Get(IntFormat);
6760
6761       // creating new image
6762       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6763       try
6764         pTemp := pImage;
6765
6766         for Row := 0 to TempHeight -1 do begin
6767           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6768           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6769         end;
6770
6771         // finish decompression
6772         jpeg_finish_decompress(@jpeg);
6773
6774         // destroy decompression
6775         jpeg_destroy_decompress(@jpeg);
6776
6777         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
6778
6779         result := true;
6780       except
6781         if Assigned(pImage) then
6782           FreeMem(pImage);
6783         raise;
6784       end;
6785     end;
6786   finally
6787     quit_libJPEG;
6788   end;
6789 end;
6790
6791 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6793 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6794 var
6795   bmp: TBitmap;
6796   jpg: TJPEGImage;
6797   StreamPos: Int64;
6798   Temp: array[0..1]of Byte;
6799 begin
6800   result := false;
6801
6802   // reading first two bytes to test file and set cursor back to begin
6803   StreamPos := aStream.Position;
6804   aStream.Read(Temp[0], 2);
6805   aStream.Position := StreamPos;
6806
6807   // if Bitmap then read file.
6808   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6809     bmp := TBitmap.Create;
6810     try
6811       jpg := TJPEGImage.Create;
6812       try
6813         jpg.LoadFromStream(aStream);
6814         bmp.Assign(jpg);
6815         result := AssignFromBitmap(bmp);
6816       finally
6817         jpg.Free;
6818       end;
6819     finally
6820       bmp.Free;
6821     end;
6822   end;
6823 end;
6824 {$IFEND}
6825 {$ENDIF}
6826
6827 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6828 {$IF DEFINED(GLB_LAZ_JPEG)}
6829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6830 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6831 var
6832   jpeg: TJPEGImage;
6833   intf: TLazIntfImage;
6834   raw: TRawImage;
6835 begin
6836   jpeg := TJPEGImage.Create;
6837   intf := TLazIntfImage.Create(0, 0);
6838   try
6839     if not AssignToLazIntfImage(intf) then
6840       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
6841     intf.GetRawImage(raw);
6842     jpeg.LoadFromRawImage(raw, false);
6843     jpeg.SaveToStream(aStream);
6844   finally
6845     intf.Free;
6846     jpeg.Free;
6847   end;
6848 end;
6849
6850 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6852 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6853 var
6854   jpeg: jpeg_compress_struct;
6855   jpeg_err: jpeg_error_mgr;
6856   Row: Integer;
6857   pTemp, pTemp2: pByte;
6858
6859   procedure CopyRow(pDest, pSource: pByte);
6860   var
6861     X: Integer;
6862   begin
6863     for X := 0 to Width - 1 do begin
6864       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6865       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6866       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6867       Inc(pDest, 3);
6868       Inc(pSource, 3);
6869     end;
6870   end;
6871
6872 begin
6873   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6874     raise EglBitmapUnsupportedFormat.Create(Format);
6875
6876   if not init_libJPEG then
6877     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6878
6879   try
6880     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6881     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6882
6883     // error managment
6884     jpeg.err := jpeg_std_error(@jpeg_err);
6885     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6886     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6887
6888     // compression struct
6889     jpeg_create_compress(@jpeg);
6890
6891     // allocation space for streaming methods
6892     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6893
6894     // seeting up custom functions
6895     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6896       pub.init_destination    := glBitmap_libJPEG_init_destination;
6897       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6898       pub.term_destination    := glBitmap_libJPEG_term_destination;
6899
6900       pub.next_output_byte  := @DestBuffer[1];
6901       pub.free_in_buffer    := Length(DestBuffer);
6902
6903       DestStream := aStream;
6904     end;
6905
6906     // very important state
6907     jpeg.global_state := CSTATE_START;
6908     jpeg.image_width  := Width;
6909     jpeg.image_height := Height;
6910     case Format of
6911       tfAlpha8ub1, tfLuminance8ub1: begin
6912         jpeg.input_components := 1;
6913         jpeg.in_color_space   := JCS_GRAYSCALE;
6914       end;
6915       tfRGB8ub3, tfBGR8ub3: begin
6916         jpeg.input_components := 3;
6917         jpeg.in_color_space   := JCS_RGB;
6918       end;
6919     end;
6920
6921     jpeg_set_defaults(@jpeg);
6922     jpeg_set_quality(@jpeg, 95, true);
6923     jpeg_start_compress(@jpeg, true);
6924     pTemp := Data;
6925
6926     if Format = tfBGR8ub3 then
6927       GetMem(pTemp2, fRowSize)
6928     else
6929       pTemp2 := pTemp;
6930
6931     try
6932       for Row := 0 to jpeg.image_height -1 do begin
6933         // prepare row
6934         if Format = tfBGR8ub3 then
6935           CopyRow(pTemp2, pTemp)
6936         else
6937           pTemp2 := pTemp;
6938
6939         // write row
6940         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6941         inc(pTemp, fRowSize);
6942       end;
6943     finally
6944       // free memory
6945       if Format = tfBGR8ub3 then
6946         FreeMem(pTemp2);
6947     end;
6948     jpeg_finish_compress(@jpeg);
6949     jpeg_destroy_compress(@jpeg);
6950   finally
6951     quit_libJPEG;
6952   end;
6953 end;
6954
6955 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6957 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6958 var
6959   Bmp: TBitmap;
6960   Jpg: TJPEGImage;
6961 begin
6962   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6963     raise EglBitmapUnsupportedFormat.Create(Format);
6964
6965   Bmp := TBitmap.Create;
6966   try
6967     Jpg := TJPEGImage.Create;
6968     try
6969       AssignToBitmap(Bmp);
6970       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
6971         Jpg.Grayscale   := true;
6972         Jpg.PixelFormat := jf8Bit;
6973       end;
6974       Jpg.Assign(Bmp);
6975       Jpg.SaveToStream(aStream);
6976     finally
6977       FreeAndNil(Jpg);
6978     end;
6979   finally
6980     FreeAndNil(Bmp);
6981   end;
6982 end;
6983 {$IFEND}
6984 {$ENDIF}
6985
6986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6987 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6989 type
6990   RawHeader = packed record
6991     Magic:        String[5];
6992     Version:      Byte;
6993     Width:        Integer;
6994     Height:       Integer;
6995     DataSize:     Integer;
6996     BitsPerPixel: Integer;
6997     Precision:    TglBitmapRec4ub;
6998     Shift:        TglBitmapRec4ub;
6999   end;
7000
7001 function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
7002 var
7003   header: RawHeader;
7004   StartPos: Int64;
7005   fd: TFormatDescriptor;
7006   buf: PByte;
7007 begin
7008   result := false;
7009   StartPos := aStream.Position;
7010   aStream.Read(header{%H-}, SizeOf(header));
7011   if (header.Magic <> 'glBMP') then begin
7012     aStream.Position := StartPos;
7013     exit;
7014   end;
7015
7016   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
7017   if (fd.Format = tfEmpty) then
7018     raise EglBitmapUnsupportedFormat.Create('no supported format found');
7019
7020   buf := GetMemory(header.DataSize);
7021   aStream.Read(buf^, header.DataSize);
7022   SetDataPointer(buf, fd.Format, header.Width, header.Height);
7023
7024   result := true;
7025 end;
7026
7027 procedure TglBitmap.SaveRAW(const aStream: TStream);
7028 var
7029   header: RawHeader;
7030   fd: TFormatDescriptor;
7031 begin
7032   fd := TFormatDescriptor.Get(Format);
7033   header.Magic        := 'glBMP';
7034   header.Version      := 1;
7035   header.Width        := Width;
7036   header.Height       := Height;
7037   header.DataSize     := fd.GetSize(fDimension);
7038   header.BitsPerPixel := fd.BitsPerPixel;
7039   header.Precision    := fd.Precision;
7040   header.Shift        := fd.Shift;
7041   aStream.Write(header, SizeOf(header));
7042   aStream.Write(Data^,  header.DataSize);
7043 end;
7044
7045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7046 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7048 const
7049   BMP_MAGIC          = $4D42;
7050
7051   BMP_COMP_RGB       = 0;
7052   BMP_COMP_RLE8      = 1;
7053   BMP_COMP_RLE4      = 2;
7054   BMP_COMP_BITFIELDS = 3;
7055
7056 type
7057   TBMPHeader = packed record
7058     bfType: Word;
7059     bfSize: Cardinal;
7060     bfReserved1: Word;
7061     bfReserved2: Word;
7062     bfOffBits: Cardinal;
7063   end;
7064
7065   TBMPInfo = packed record
7066     biSize: Cardinal;
7067     biWidth: Longint;
7068     biHeight: Longint;
7069     biPlanes: Word;
7070     biBitCount: Word;
7071     biCompression: Cardinal;
7072     biSizeImage: Cardinal;
7073     biXPelsPerMeter: Longint;
7074     biYPelsPerMeter: Longint;
7075     biClrUsed: Cardinal;
7076     biClrImportant: Cardinal;
7077   end;
7078
7079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7080 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
7081
7082   //////////////////////////////////////////////////////////////////////////////////////////////////
7083   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
7084   begin
7085     result := tfEmpty;
7086     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
7087     FillChar(aMask{%H-}, SizeOf(aMask), 0);
7088
7089     //Read Compression
7090     case aInfo.biCompression of
7091       BMP_COMP_RLE4,
7092       BMP_COMP_RLE8: begin
7093         raise EglBitmap.Create('RLE compression is not supported');
7094       end;
7095       BMP_COMP_BITFIELDS: begin
7096         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
7097           aStream.Read(aMask.r, SizeOf(aMask.r));
7098           aStream.Read(aMask.g, SizeOf(aMask.g));
7099           aStream.Read(aMask.b, SizeOf(aMask.b));
7100           aStream.Read(aMask.a, SizeOf(aMask.a));
7101         end else
7102           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
7103       end;
7104     end;
7105
7106     //get suitable format
7107     case aInfo.biBitCount of
7108        8: result := tfLuminance8ub1;
7109       16: result := tfX1RGB5us1;
7110       24: result := tfBGR8ub3;
7111       32: result := tfXRGB8ui1;
7112     end;
7113   end;
7114
7115   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
7116   var
7117     i, c: Integer;
7118     ColorTable: TbmpColorTable;
7119   begin
7120     result := nil;
7121     if (aInfo.biBitCount >= 16) then
7122       exit;
7123     aFormat := tfLuminance8ub1;
7124     c := aInfo.biClrUsed;
7125     if (c = 0) then
7126       c := 1 shl aInfo.biBitCount;
7127     SetLength(ColorTable, c);
7128     for i := 0 to c-1 do begin
7129       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
7130       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
7131         aFormat := tfRGB8ub3;
7132     end;
7133
7134     result := TbmpColorTableFormat.Create;
7135     result.BitsPerPixel := aInfo.biBitCount;
7136     result.ColorTable   := ColorTable;
7137     result.CalcValues;
7138   end;
7139
7140   //////////////////////////////////////////////////////////////////////////////////////////////////
7141   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
7142   var
7143     FormatDesc: TFormatDescriptor;
7144   begin
7145     result := nil;
7146     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
7147       FormatDesc := TFormatDescriptor.GetFromMask(aMask);
7148       if (FormatDesc.Format = tfEmpty) then
7149         exit;
7150       aFormat := FormatDesc.Format;
7151       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
7152         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
7153       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
7154         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
7155
7156       result := TbmpBitfieldFormat.Create;
7157       result.SetCustomValues(aInfo.biBitCount, aMask);
7158     end;
7159   end;
7160
7161 var
7162   //simple types
7163   StartPos: Int64;
7164   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
7165   PaddingBuff: Cardinal;
7166   LineBuf, ImageData, TmpData: PByte;
7167   SourceMD, DestMD: Pointer;
7168   BmpFormat: TglBitmapFormat;
7169
7170   //records
7171   Mask: TglBitmapRec4ul;
7172   Header: TBMPHeader;
7173   Info: TBMPInfo;
7174
7175   //classes
7176   SpecialFormat: TFormatDescriptor;
7177   FormatDesc: TFormatDescriptor;
7178
7179   //////////////////////////////////////////////////////////////////////////////////////////////////
7180   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
7181   var
7182     i: Integer;
7183     Pixel: TglBitmapPixelData;
7184   begin
7185     aStream.Read(aLineBuf^, rbLineSize);
7186     SpecialFormat.PreparePixel(Pixel);
7187     for i := 0 to Info.biWidth-1 do begin
7188       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
7189       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
7190       FormatDesc.Map(Pixel, aData, DestMD);
7191     end;
7192   end;
7193
7194 begin
7195   result        := false;
7196   BmpFormat     := tfEmpty;
7197   SpecialFormat := nil;
7198   LineBuf       := nil;
7199   SourceMD      := nil;
7200   DestMD        := nil;
7201
7202   // Header
7203   StartPos := aStream.Position;
7204   aStream.Read(Header{%H-}, SizeOf(Header));
7205
7206   if Header.bfType = BMP_MAGIC then begin
7207     try try
7208       BmpFormat        := ReadInfo(Info, Mask);
7209       SpecialFormat    := ReadColorTable(BmpFormat, Info);
7210       if not Assigned(SpecialFormat) then
7211         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
7212       aStream.Position := StartPos + Header.bfOffBits;
7213
7214       if (BmpFormat <> tfEmpty) then begin
7215         FormatDesc := TFormatDescriptor.Get(BmpFormat);
7216         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
7217         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
7218         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
7219
7220         //get Memory
7221         DestMD    := FormatDesc.CreateMappingData;
7222         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
7223         GetMem(ImageData, ImageSize);
7224         if Assigned(SpecialFormat) then begin
7225           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
7226           SourceMD := SpecialFormat.CreateMappingData;
7227         end;
7228
7229         //read Data
7230         try try
7231           FillChar(ImageData^, ImageSize, $FF);
7232           TmpData := ImageData;
7233           if (Info.biHeight > 0) then
7234             Inc(TmpData, wbLineSize * (Info.biHeight-1));
7235           for i := 0 to Abs(Info.biHeight)-1 do begin
7236             if Assigned(SpecialFormat) then
7237               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
7238             else
7239               aStream.Read(TmpData^, wbLineSize);   //else only read data
7240             if (Info.biHeight > 0) then
7241               dec(TmpData, wbLineSize)
7242             else
7243               inc(TmpData, wbLineSize);
7244             aStream.Read(PaddingBuff{%H-}, Padding);
7245           end;
7246           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
7247           result := true;
7248         finally
7249           if Assigned(LineBuf) then
7250             FreeMem(LineBuf);
7251           if Assigned(SourceMD) then
7252             SpecialFormat.FreeMappingData(SourceMD);
7253           FormatDesc.FreeMappingData(DestMD);
7254         end;
7255         except
7256           if Assigned(ImageData) then
7257             FreeMem(ImageData);
7258           raise;
7259         end;
7260       end else
7261         raise EglBitmap.Create('LoadBMP - No suitable format found');
7262     except
7263       aStream.Position := StartPos;
7264       raise;
7265     end;
7266     finally
7267       FreeAndNil(SpecialFormat);
7268     end;
7269   end
7270     else aStream.Position := StartPos;
7271 end;
7272
7273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7274 procedure TglBitmap.SaveBMP(const aStream: TStream);
7275 var
7276   Header: TBMPHeader;
7277   Info: TBMPInfo;
7278   Converter: TFormatDescriptor;
7279   FormatDesc: TFormatDescriptor;
7280   SourceFD, DestFD: Pointer;
7281   pData, srcData, dstData, ConvertBuffer: pByte;
7282
7283   Pixel: TglBitmapPixelData;
7284   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
7285   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
7286
7287   PaddingBuff: Cardinal;
7288
7289   function GetLineWidth : Integer;
7290   begin
7291     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
7292   end;
7293
7294 begin
7295   if not (ftBMP in FormatGetSupportedFiles(Format)) then
7296     raise EglBitmapUnsupportedFormat.Create(Format);
7297
7298   Converter  := nil;
7299   FormatDesc := TFormatDescriptor.Get(Format);
7300   ImageSize  := FormatDesc.GetSize(Dimension);
7301
7302   FillChar(Header{%H-}, SizeOf(Header), 0);
7303   Header.bfType      := BMP_MAGIC;
7304   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
7305   Header.bfReserved1 := 0;
7306   Header.bfReserved2 := 0;
7307   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
7308
7309   FillChar(Info{%H-}, SizeOf(Info), 0);
7310   Info.biSize        := SizeOf(Info);
7311   Info.biWidth       := Width;
7312   Info.biHeight      := Height;
7313   Info.biPlanes      := 1;
7314   Info.biCompression := BMP_COMP_RGB;
7315   Info.biSizeImage   := ImageSize;
7316
7317   try
7318     case Format of
7319       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
7320       begin
7321         Info.biBitCount  :=  8;
7322         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
7323         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
7324         Converter := TbmpColorTableFormat.Create;
7325         with (Converter as TbmpColorTableFormat) do begin
7326           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
7327           CreateColorTable;
7328         end;
7329       end;
7330
7331       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
7332       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
7333       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
7334       begin
7335         Info.biBitCount    := 16;
7336         Info.biCompression := BMP_COMP_BITFIELDS;
7337       end;
7338
7339       tfBGR8ub3, tfRGB8ub3:
7340       begin
7341         Info.biBitCount := 24;
7342         if (Format = tfRGB8ub3) then
7343           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
7344       end;
7345
7346       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
7347       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
7348       begin
7349         Info.biBitCount    := 32;
7350         Info.biCompression := BMP_COMP_BITFIELDS;
7351       end;
7352     else
7353       raise EglBitmapUnsupportedFormat.Create(Format);
7354     end;
7355     Info.biXPelsPerMeter := 2835;
7356     Info.biYPelsPerMeter := 2835;
7357
7358     // prepare bitmasks
7359     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7360       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
7361       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
7362
7363       RedMask    := FormatDesc.Mask.r;
7364       GreenMask  := FormatDesc.Mask.g;
7365       BlueMask   := FormatDesc.Mask.b;
7366       AlphaMask  := FormatDesc.Mask.a;
7367     end;
7368
7369     // headers
7370     aStream.Write(Header, SizeOf(Header));
7371     aStream.Write(Info, SizeOf(Info));
7372
7373     // colortable
7374     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
7375       with (Converter as TbmpColorTableFormat) do
7376         aStream.Write(ColorTable[0].b,
7377           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
7378
7379     // bitmasks
7380     if Info.biCompression = BMP_COMP_BITFIELDS then begin
7381       aStream.Write(RedMask,   SizeOf(Cardinal));
7382       aStream.Write(GreenMask, SizeOf(Cardinal));
7383       aStream.Write(BlueMask,  SizeOf(Cardinal));
7384       aStream.Write(AlphaMask, SizeOf(Cardinal));
7385     end;
7386
7387     // image data
7388     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
7389     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
7390     Padding     := GetLineWidth - wbLineSize;
7391     PaddingBuff := 0;
7392
7393     pData := Data;
7394     inc(pData, (Height-1) * rbLineSize);
7395
7396     // prepare row buffer. But only for RGB because RGBA supports color masks
7397     // so it's possible to change color within the image.
7398     if Assigned(Converter) then begin
7399       FormatDesc.PreparePixel(Pixel);
7400       GetMem(ConvertBuffer, wbLineSize);
7401       SourceFD := FormatDesc.CreateMappingData;
7402       DestFD   := Converter.CreateMappingData;
7403     end else
7404       ConvertBuffer := nil;
7405
7406     try
7407       for LineIdx := 0 to Height - 1 do begin
7408         // preparing row
7409         if Assigned(Converter) then begin
7410           srcData := pData;
7411           dstData := ConvertBuffer;
7412           for PixelIdx := 0 to Info.biWidth-1 do begin
7413             FormatDesc.Unmap(srcData, Pixel, SourceFD);
7414             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
7415             Converter.Map(Pixel, dstData, DestFD);
7416           end;
7417           aStream.Write(ConvertBuffer^, wbLineSize);
7418         end else begin
7419           aStream.Write(pData^, rbLineSize);
7420         end;
7421         dec(pData, rbLineSize);
7422         if (Padding > 0) then
7423           aStream.Write(PaddingBuff, Padding);
7424       end;
7425     finally
7426       // destroy row buffer
7427       if Assigned(ConvertBuffer) then begin
7428         FormatDesc.FreeMappingData(SourceFD);
7429         Converter.FreeMappingData(DestFD);
7430         FreeMem(ConvertBuffer);
7431       end;
7432     end;
7433   finally
7434     if Assigned(Converter) then
7435       Converter.Free;
7436   end;
7437 end;
7438
7439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7440 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7442 type
7443   TTGAHeader = packed record
7444     ImageID: Byte;
7445     ColorMapType: Byte;
7446     ImageType: Byte;
7447     //ColorMapSpec: Array[0..4] of Byte;
7448     ColorMapStart: Word;
7449     ColorMapLength: Word;
7450     ColorMapEntrySize: Byte;
7451     OrigX: Word;
7452     OrigY: Word;
7453     Width: Word;
7454     Height: Word;
7455     Bpp: Byte;
7456     ImageDesc: Byte;
7457   end;
7458
7459 const
7460   TGA_UNCOMPRESSED_RGB  =  2;
7461   TGA_UNCOMPRESSED_GRAY =  3;
7462   TGA_COMPRESSED_RGB    = 10;
7463   TGA_COMPRESSED_GRAY   = 11;
7464
7465   TGA_NONE_COLOR_TABLE  = 0;
7466
7467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7468 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
7469 var
7470   Header: TTGAHeader;
7471   ImageData: System.PByte;
7472   StartPosition: Int64;
7473   PixelSize, LineSize: Integer;
7474   tgaFormat: TglBitmapFormat;
7475   FormatDesc: TFormatDescriptor;
7476   Counter: packed record
7477     X, Y: packed record
7478       low, high, dir: Integer;
7479     end;
7480   end;
7481
7482 const
7483   CACHE_SIZE = $4000;
7484
7485   ////////////////////////////////////////////////////////////////////////////////////////
7486   procedure ReadUncompressed;
7487   var
7488     i, j: Integer;
7489     buf, tmp1, tmp2: System.PByte;
7490   begin
7491     buf := nil;
7492     if (Counter.X.dir < 0) then
7493       GetMem(buf, LineSize);
7494     try
7495       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
7496         tmp1 := ImageData;
7497         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
7498         if (Counter.X.dir < 0) then begin               //flip X
7499           aStream.Read(buf^, LineSize);
7500           tmp2 := buf;
7501           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
7502           for i := 0 to Header.Width-1 do begin         //for all pixels in line
7503             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
7504               tmp1^ := tmp2^;
7505               inc(tmp1);
7506               inc(tmp2);
7507             end;
7508             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
7509           end;
7510         end else
7511           aStream.Read(tmp1^, LineSize);
7512         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
7513       end;
7514     finally
7515       if Assigned(buf) then
7516         FreeMem(buf);
7517     end;
7518   end;
7519
7520   ////////////////////////////////////////////////////////////////////////////////////////
7521   procedure ReadCompressed;
7522
7523     /////////////////////////////////////////////////////////////////
7524     var
7525       TmpData: System.PByte;
7526       LinePixelsRead: Integer;
7527     procedure CheckLine;
7528     begin
7529       if (LinePixelsRead >= Header.Width) then begin
7530         LinePixelsRead := 0;
7531         inc(Counter.Y.low, Counter.Y.dir);                //next line index
7532         TmpData := ImageData;
7533         inc(TmpData, Counter.Y.low * LineSize);           //set line
7534         if (Counter.X.dir < 0) then                       //if x flipped then
7535           inc(TmpData, LineSize - PixelSize);             //set last pixel
7536       end;
7537     end;
7538
7539     /////////////////////////////////////////////////////////////////
7540     var
7541       Cache: PByte;
7542       CacheSize, CachePos: Integer;
7543     procedure CachedRead(out Buffer; Count: Integer);
7544     var
7545       BytesRead: Integer;
7546     begin
7547       if (CachePos + Count > CacheSize) then begin
7548         //if buffer overflow save non read bytes
7549         BytesRead := 0;
7550         if (CacheSize - CachePos > 0) then begin
7551           BytesRead := CacheSize - CachePos;
7552           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
7553           inc(CachePos, BytesRead);
7554         end;
7555
7556         //load cache from file
7557         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
7558         aStream.Read(Cache^, CacheSize);
7559         CachePos := 0;
7560
7561         //read rest of requested bytes
7562         if (Count - BytesRead > 0) then begin
7563           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
7564           inc(CachePos, Count - BytesRead);
7565         end;
7566       end else begin
7567         //if no buffer overflow just read the data
7568         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
7569         inc(CachePos, Count);
7570       end;
7571     end;
7572
7573     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
7574     begin
7575       case PixelSize of
7576         1: begin
7577           aBuffer^ := aData^;
7578           inc(aBuffer, Counter.X.dir);
7579         end;
7580         2: begin
7581           PWord(aBuffer)^ := PWord(aData)^;
7582           inc(aBuffer, 2 * Counter.X.dir);
7583         end;
7584         3: begin
7585           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
7586           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
7587           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
7588           inc(aBuffer, 3 * Counter.X.dir);
7589         end;
7590         4: begin
7591           PCardinal(aBuffer)^ := PCardinal(aData)^;
7592           inc(aBuffer, 4 * Counter.X.dir);
7593         end;
7594       end;
7595     end;
7596
7597   var
7598     TotalPixelsToRead, TotalPixelsRead: Integer;
7599     Temp: Byte;
7600     buf: array [0..3] of Byte; //1 pixel is max 32bit long
7601     PixelRepeat: Boolean;
7602     PixelsToRead, PixelCount: Integer;
7603   begin
7604     CacheSize := 0;
7605     CachePos  := 0;
7606
7607     TotalPixelsToRead := Header.Width * Header.Height;
7608     TotalPixelsRead   := 0;
7609     LinePixelsRead    := 0;
7610
7611     GetMem(Cache, CACHE_SIZE);
7612     try
7613       TmpData := ImageData;
7614       inc(TmpData, Counter.Y.low * LineSize);           //set line
7615       if (Counter.X.dir < 0) then                       //if x flipped then
7616         inc(TmpData, LineSize - PixelSize);             //set last pixel
7617
7618       repeat
7619         //read CommandByte
7620         CachedRead(Temp, 1);
7621         PixelRepeat  := (Temp and $80) > 0;
7622         PixelsToRead := (Temp and $7F) + 1;
7623         inc(TotalPixelsRead, PixelsToRead);
7624
7625         if PixelRepeat then
7626           CachedRead(buf[0], PixelSize);
7627         while (PixelsToRead > 0) do begin
7628           CheckLine;
7629           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
7630           while (PixelCount > 0) do begin
7631             if not PixelRepeat then
7632               CachedRead(buf[0], PixelSize);
7633             PixelToBuffer(@buf[0], TmpData);
7634             inc(LinePixelsRead);
7635             dec(PixelsToRead);
7636             dec(PixelCount);
7637           end;
7638         end;
7639       until (TotalPixelsRead >= TotalPixelsToRead);
7640     finally
7641       FreeMem(Cache);
7642     end;
7643   end;
7644
7645   function IsGrayFormat: Boolean;
7646   begin
7647     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7648   end;
7649
7650 begin
7651   result := false;
7652
7653   // reading header to test file and set cursor back to begin
7654   StartPosition := aStream.Position;
7655   aStream.Read(Header{%H-}, SizeOf(Header));
7656
7657   // no colormapped files
7658   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7659     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7660   begin
7661     try
7662       if Header.ImageID <> 0 then       // skip image ID
7663         aStream.Position := aStream.Position + Header.ImageID;
7664
7665       tgaFormat := tfEmpty;
7666       case Header.Bpp of
7667          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7668                0: tgaFormat := tfLuminance8ub1;
7669                8: tgaFormat := tfAlpha8ub1;
7670             end;
7671
7672         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7673                0: tgaFormat := tfLuminance16us1;
7674                8: tgaFormat := tfLuminance8Alpha8ub2;
7675             end else case (Header.ImageDesc and $F) of
7676                0: tgaFormat := tfX1RGB5us1;
7677                1: tgaFormat := tfA1RGB5us1;
7678                4: tgaFormat := tfARGB4us1;
7679             end;
7680
7681         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7682                0: tgaFormat := tfBGR8ub3;
7683             end;
7684
7685         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
7686                0: tgaFormat := tfDepth32ui1;
7687             end else case (Header.ImageDesc and $F) of
7688                0: tgaFormat := tfX2RGB10ui1;
7689                2: tgaFormat := tfA2RGB10ui1;
7690                8: tgaFormat := tfARGB8ui1;
7691             end;
7692       end;
7693
7694       if (tgaFormat = tfEmpty) then
7695         raise EglBitmap.Create('LoadTga - unsupported format');
7696
7697       FormatDesc := TFormatDescriptor.Get(tgaFormat);
7698       PixelSize  := FormatDesc.GetSize(1, 1);
7699       LineSize   := FormatDesc.GetSize(Header.Width, 1);
7700
7701       GetMem(ImageData, LineSize * Header.Height);
7702       try
7703         //column direction
7704         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7705           Counter.X.low  := Header.Height-1;;
7706           Counter.X.high := 0;
7707           Counter.X.dir  := -1;
7708         end else begin
7709           Counter.X.low  := 0;
7710           Counter.X.high := Header.Height-1;
7711           Counter.X.dir  := 1;
7712         end;
7713
7714         // Row direction
7715         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7716           Counter.Y.low  := 0;
7717           Counter.Y.high := Header.Height-1;
7718           Counter.Y.dir  := 1;
7719         end else begin
7720           Counter.Y.low  := Header.Height-1;;
7721           Counter.Y.high := 0;
7722           Counter.Y.dir  := -1;
7723         end;
7724
7725         // Read Image
7726         case Header.ImageType of
7727           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7728             ReadUncompressed;
7729           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7730             ReadCompressed;
7731         end;
7732
7733         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
7734         result := true;
7735       except
7736         if Assigned(ImageData) then
7737           FreeMem(ImageData);
7738         raise;
7739       end;
7740     finally
7741       aStream.Position := StartPosition;
7742     end;
7743   end
7744     else aStream.Position := StartPosition;
7745 end;
7746
7747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7748 procedure TglBitmap.SaveTGA(const aStream: TStream);
7749 var
7750   Header: TTGAHeader;
7751   Size: Integer;
7752   FormatDesc: TFormatDescriptor;
7753 begin
7754   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7755     raise EglBitmapUnsupportedFormat.Create(Format);
7756
7757   //prepare header
7758   FormatDesc := TFormatDescriptor.Get(Format);
7759   FillChar(Header{%H-}, SizeOf(Header), 0);
7760   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
7761   Header.Bpp       := FormatDesc.BitsPerPixel;
7762   Header.Width     := Width;
7763   Header.Height    := Height;
7764   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7765   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
7766     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7767   else
7768     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7769   aStream.Write(Header, SizeOf(Header));
7770
7771   // write Data
7772   Size := FormatDesc.GetSize(Dimension);
7773   aStream.Write(Data^, Size);
7774 end;
7775
7776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7777 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7779 const
7780   DDS_MAGIC: Cardinal         = $20534444;
7781
7782   // DDS_header.dwFlags
7783   DDSD_CAPS                   = $00000001;
7784   DDSD_HEIGHT                 = $00000002;
7785   DDSD_WIDTH                  = $00000004;
7786   DDSD_PIXELFORMAT            = $00001000;
7787
7788   // DDS_header.sPixelFormat.dwFlags
7789   DDPF_ALPHAPIXELS            = $00000001;
7790   DDPF_ALPHA                  = $00000002;
7791   DDPF_FOURCC                 = $00000004;
7792   DDPF_RGB                    = $00000040;
7793   DDPF_LUMINANCE              = $00020000;
7794
7795   // DDS_header.sCaps.dwCaps1
7796   DDSCAPS_TEXTURE             = $00001000;
7797
7798   // DDS_header.sCaps.dwCaps2
7799   DDSCAPS2_CUBEMAP            = $00000200;
7800
7801   D3DFMT_DXT1                 = $31545844;
7802   D3DFMT_DXT3                 = $33545844;
7803   D3DFMT_DXT5                 = $35545844;
7804
7805 type
7806   TDDSPixelFormat = packed record
7807     dwSize: Cardinal;
7808     dwFlags: Cardinal;
7809     dwFourCC: Cardinal;
7810     dwRGBBitCount: Cardinal;
7811     dwRBitMask: Cardinal;
7812     dwGBitMask: Cardinal;
7813     dwBBitMask: Cardinal;
7814     dwABitMask: Cardinal;
7815   end;
7816
7817   TDDSCaps = packed record
7818     dwCaps1: Cardinal;
7819     dwCaps2: Cardinal;
7820     dwDDSX: Cardinal;
7821     dwReserved: Cardinal;
7822   end;
7823
7824   TDDSHeader = packed record
7825     dwSize: Cardinal;
7826     dwFlags: Cardinal;
7827     dwHeight: Cardinal;
7828     dwWidth: Cardinal;
7829     dwPitchOrLinearSize: Cardinal;
7830     dwDepth: Cardinal;
7831     dwMipMapCount: Cardinal;
7832     dwReserved: array[0..10] of Cardinal;
7833     PixelFormat: TDDSPixelFormat;
7834     Caps: TDDSCaps;
7835     dwReserved2: Cardinal;
7836   end;
7837
7838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7839 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7840 var
7841   Header: TDDSHeader;
7842   Converter: TbmpBitfieldFormat;
7843
7844   function GetDDSFormat: TglBitmapFormat;
7845   var
7846     fd: TFormatDescriptor;
7847     i: Integer;
7848     Mask: TglBitmapRec4ul;
7849     Range: TglBitmapRec4ui;
7850     match: Boolean;
7851   begin
7852     result := tfEmpty;
7853     with Header.PixelFormat do begin
7854       // Compresses
7855       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7856         case Header.PixelFormat.dwFourCC of
7857           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7858           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7859           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7860         end;
7861       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
7862         // prepare masks
7863         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
7864           Mask.r := dwRBitMask;
7865           Mask.g := dwGBitMask;
7866           Mask.b := dwBBitMask;
7867         end else begin
7868           Mask.r := dwRBitMask;
7869           Mask.g := dwRBitMask;
7870           Mask.b := dwRBitMask;
7871         end;
7872         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
7873           Mask.a := dwABitMask
7874         else
7875           Mask.a := 0;;
7876
7877         //find matching format
7878         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
7879         result := fd.Format;
7880         if (result <> tfEmpty) then
7881           exit;
7882
7883         //find format with same Range
7884         for i := 0 to 3 do
7885           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
7886         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7887           fd := TFormatDescriptor.Get(result);
7888           match := true;
7889           for i := 0 to 3 do
7890             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7891               match := false;
7892               break;
7893             end;
7894           if match then
7895             break;
7896         end;
7897
7898         //no format with same range found -> use default
7899         if (result = tfEmpty) then begin
7900           if (dwABitMask > 0) then
7901             result := tfRGBA8ui1
7902           else
7903             result := tfRGB8ub3;
7904         end;
7905
7906         Converter := TbmpBitfieldFormat.Create;
7907         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
7908       end;
7909     end;
7910   end;
7911
7912 var
7913   StreamPos: Int64;
7914   x, y, LineSize, RowSize, Magic: Cardinal;
7915   NewImage, TmpData, RowData, SrcData: System.PByte;
7916   SourceMD, DestMD: Pointer;
7917   Pixel: TglBitmapPixelData;
7918   ddsFormat: TglBitmapFormat;
7919   FormatDesc: TFormatDescriptor;
7920
7921 begin
7922   result    := false;
7923   Converter := nil;
7924   StreamPos := aStream.Position;
7925
7926   // Magic
7927   aStream.Read(Magic{%H-}, sizeof(Magic));
7928   if (Magic <> DDS_MAGIC) then begin
7929     aStream.Position := StreamPos;
7930     exit;
7931   end;
7932
7933   //Header
7934   aStream.Read(Header{%H-}, sizeof(Header));
7935   if (Header.dwSize <> SizeOf(Header)) or
7936      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7937         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7938   begin
7939     aStream.Position := StreamPos;
7940     exit;
7941   end;
7942
7943   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7944     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
7945
7946   ddsFormat := GetDDSFormat;
7947   try
7948     if (ddsFormat = tfEmpty) then
7949       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
7950
7951     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7952     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
7953     GetMem(NewImage, Header.dwHeight * LineSize);
7954     try
7955       TmpData := NewImage;
7956
7957       //Converter needed
7958       if Assigned(Converter) then begin
7959         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7960         GetMem(RowData, RowSize);
7961         SourceMD := Converter.CreateMappingData;
7962         DestMD   := FormatDesc.CreateMappingData;
7963         try
7964           for y := 0 to Header.dwHeight-1 do begin
7965             TmpData := NewImage;
7966             inc(TmpData, y * LineSize);
7967             SrcData := RowData;
7968             aStream.Read(SrcData^, RowSize);
7969             for x := 0 to Header.dwWidth-1 do begin
7970               Converter.Unmap(SrcData, Pixel, SourceMD);
7971               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7972               FormatDesc.Map(Pixel, TmpData, DestMD);
7973             end;
7974           end;
7975         finally
7976           Converter.FreeMappingData(SourceMD);
7977           FormatDesc.FreeMappingData(DestMD);
7978           FreeMem(RowData);
7979         end;
7980       end else
7981
7982       // Compressed
7983       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7984         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7985         for Y := 0 to Header.dwHeight-1 do begin
7986           aStream.Read(TmpData^, RowSize);
7987           Inc(TmpData, LineSize);
7988         end;
7989       end else
7990
7991       // Uncompressed
7992       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7993         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7994         for Y := 0 to Header.dwHeight-1 do begin
7995           aStream.Read(TmpData^, RowSize);
7996           Inc(TmpData, LineSize);
7997         end;
7998       end else
7999         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
8000
8001       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
8002       result := true;
8003     except
8004       if Assigned(NewImage) then
8005         FreeMem(NewImage);
8006       raise;
8007     end;
8008   finally
8009     FreeAndNil(Converter);
8010   end;
8011 end;
8012
8013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8014 procedure TglBitmap.SaveDDS(const aStream: TStream);
8015 var
8016   Header: TDDSHeader;
8017   FormatDesc: TFormatDescriptor;
8018 begin
8019   if not (ftDDS in FormatGetSupportedFiles(Format)) then
8020     raise EglBitmapUnsupportedFormat.Create(Format);
8021
8022   FormatDesc := TFormatDescriptor.Get(Format);
8023
8024   // Generell
8025   FillChar(Header{%H-}, SizeOf(Header), 0);
8026   Header.dwSize  := SizeOf(Header);
8027   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
8028
8029   Header.dwWidth  := Max(1, Width);
8030   Header.dwHeight := Max(1, Height);
8031
8032   // Caps
8033   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
8034
8035   // Pixelformat
8036   Header.PixelFormat.dwSize := sizeof(Header);
8037   if (FormatDesc.IsCompressed) then begin
8038     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
8039     case Format of
8040       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
8041       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
8042       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
8043     end;
8044   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
8045     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
8046     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8047     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8048   end else if FormatDesc.IsGrayscale then begin
8049     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
8050     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8051     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8052     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8053   end else begin
8054     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
8055     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
8056     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
8057     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
8058     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
8059     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
8060   end;
8061
8062   if (FormatDesc.HasAlpha) then
8063     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
8064
8065   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
8066   aStream.Write(Header, SizeOf(Header));
8067   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
8068 end;
8069
8070 {$IFNDEF OPENGL_ES}
8071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8072 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8074 procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8075   const aWidth: Integer; const aHeight: Integer);
8076 var
8077   pTemp: pByte;
8078   Size: Integer;
8079 begin
8080   if (aHeight > 1) then begin
8081     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
8082     GetMem(pTemp, Size);
8083     try
8084       Move(aData^, pTemp^, Size);
8085       FreeMem(aData);
8086       aData := nil;
8087     except
8088       FreeMem(pTemp);
8089       raise;
8090     end;
8091   end else
8092     pTemp := aData;
8093   inherited SetDataPointer(pTemp, aFormat, aWidth);
8094 end;
8095
8096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8097 function TglBitmap1D.FlipHorz: Boolean;
8098 var
8099   Col: Integer;
8100   pTempDest, pDest, pSource: PByte;
8101 begin
8102   result := inherited FlipHorz;
8103   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
8104     pSource := Data;
8105     GetMem(pDest, fRowSize);
8106     try
8107       pTempDest := pDest;
8108       Inc(pTempDest, fRowSize);
8109       for Col := 0 to Width-1 do begin
8110         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
8111         Move(pSource^, pTempDest^, fPixelSize);
8112         Inc(pSource, fPixelSize);
8113       end;
8114       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
8115       result := true;
8116     except
8117       if Assigned(pDest) then
8118         FreeMem(pDest);
8119       raise;
8120     end;
8121   end;
8122 end;
8123
8124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8125 procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
8126 var
8127   FormatDesc: TFormatDescriptor;
8128 begin
8129   // Upload data
8130   FormatDesc := TFormatDescriptor.Get(Format);
8131   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8132     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8133
8134   if FormatDesc.IsCompressed then begin
8135     if not Assigned(glCompressedTexImage1D) then
8136       raise EglBitmap.Create('compressed formats not supported by video adapter');
8137     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
8138   end else if aBuildWithGlu then
8139     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8140   else
8141     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8142
8143   // Free Data
8144   if (FreeDataAfterGenTexture) then
8145     FreeData;
8146 end;
8147
8148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8149 procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
8150 var
8151   BuildWithGlu, TexRec: Boolean;
8152   TexSize: Integer;
8153 begin
8154   if Assigned(Data) then begin
8155     // Check Texture Size
8156     if (aTestTextureSize) then begin
8157       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8158
8159       if (Width > TexSize) then
8160         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8161
8162       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8163                 (Target = GL_TEXTURE_RECTANGLE);
8164       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8165         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8166     end;
8167
8168     CreateId;
8169     SetupParameters(BuildWithGlu);
8170     UploadData(BuildWithGlu);
8171     glAreTexturesResident(1, @fID, @fIsResident);
8172   end;
8173 end;
8174
8175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8176 procedure TglBitmap1D.AfterConstruction;
8177 begin
8178   inherited;
8179   Target := GL_TEXTURE_1D;
8180 end;
8181 {$ENDIF}
8182
8183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8184 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8186 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
8187 begin
8188   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
8189     result := fLines[aIndex]
8190   else
8191     result := nil;
8192 end;
8193
8194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8195 procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
8196   const aWidth: Integer; const aHeight: Integer);
8197 var
8198   Idx, LineWidth: Integer;
8199 begin
8200   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
8201
8202   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
8203     // Assigning Data
8204     if Assigned(Data) then begin
8205       SetLength(fLines, GetHeight);
8206       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
8207
8208       for Idx := 0 to GetHeight-1 do begin
8209         fLines[Idx] := Data;
8210         Inc(fLines[Idx], Idx * LineWidth);
8211       end;
8212     end
8213       else SetLength(fLines, 0);
8214   end else begin
8215     SetLength(fLines, 0);
8216   end;
8217 end;
8218
8219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8220 procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8221 var
8222   FormatDesc: TFormatDescriptor;
8223 begin
8224   FormatDesc := TFormatDescriptor.Get(Format);
8225   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
8226     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8227
8228   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8229
8230   if FormatDesc.IsCompressed then begin
8231     if not Assigned(glCompressedTexImage2D) then
8232       raise EglBitmap.Create('compressed formats not supported by video adapter');
8233     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
8234 {$IFNDEF OPENGL_ES}
8235   end else if aBuildWithGlu then begin
8236     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
8237       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
8238 {$ENDIF}
8239   end else begin
8240     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
8241       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
8242   end;
8243
8244   // Freigeben
8245   if (FreeDataAfterGenTexture) then
8246     FreeData;
8247 end;
8248
8249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8250 procedure TglBitmap2D.AfterConstruction;
8251 begin
8252   inherited;
8253   Target := GL_TEXTURE_2D;
8254 end;
8255
8256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8257 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
8258 var
8259   Temp: pByte;
8260   Size, w, h: Integer;
8261   FormatDesc: TFormatDescriptor;
8262 begin
8263   FormatDesc := TFormatDescriptor.Get(aFormat);
8264   if FormatDesc.IsCompressed then
8265     raise EglBitmapUnsupportedFormat.Create(aFormat);
8266
8267   w    := aRight  - aLeft;
8268   h    := aBottom - aTop;
8269   Size := FormatDesc.GetSize(w, h);
8270   GetMem(Temp, Size);
8271   try
8272     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8273     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8274     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
8275     FlipVert;
8276   except
8277     if Assigned(Temp) then
8278       FreeMem(Temp);
8279     raise;
8280   end;
8281 end;
8282
8283 {$IFNDEF OPENGL_ES}
8284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8285 procedure TglBitmap2D.GetDataFromTexture;
8286 var
8287   Temp: PByte;
8288   TempWidth, TempHeight: Integer;
8289   TempIntFormat: GLint;
8290   IntFormat: TglBitmapFormat;
8291   FormatDesc: TFormatDescriptor;
8292 begin
8293   Bind;
8294
8295   // Request Data
8296   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8297   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8298   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8299
8300   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8301   IntFormat  := FormatDesc.Format;
8302
8303   // Getting data from OpenGL
8304   FormatDesc := TFormatDescriptor.Get(IntFormat);
8305   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8306   try
8307     if FormatDesc.IsCompressed then begin
8308       if not Assigned(glGetCompressedTexImage) then
8309         raise EglBitmap.Create('compressed formats not supported by video adapter');
8310       glGetCompressedTexImage(Target, 0, Temp)
8311     end else
8312       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8313     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
8314   except
8315     if Assigned(Temp) then
8316       FreeMem(Temp);
8317     raise;
8318   end;
8319 end;
8320 {$ENDIF}
8321
8322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8323 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
8324 var
8325   {$IFNDEF OPENGL_ES}
8326   BuildWithGlu, TexRec: Boolean;
8327   {$ENDIF}
8328   PotTex: Boolean;
8329   TexSize: Integer;
8330 begin
8331   if Assigned(Data) then begin
8332     // Check Texture Size
8333     if (aTestTextureSize) then begin
8334       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8335
8336       if ((Height > TexSize) or (Width > TexSize)) then
8337         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8338
8339       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
8340 {$IF NOT DEFINED(OPENGL_ES)}
8341       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8342       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8343         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8344 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8345       if not PotTex and not GL_OES_texture_npot then
8346         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8347 {$ELSE}
8348       if not PotTex then
8349         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8350 {$IFEND}
8351     end;
8352
8353     CreateId;
8354     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8355     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8356 {$IFNDEF OPENGL_ES}
8357     glAreTexturesResident(1, @fID, @fIsResident);
8358 {$ENDIF}
8359   end;
8360 end;
8361
8362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8363 function TglBitmap2D.FlipHorz: Boolean;
8364 var
8365   Col, Row: Integer;
8366   TempDestData, DestData, SourceData: PByte;
8367   ImgSize: Integer;
8368 begin
8369   result := inherited FlipHorz;
8370   if Assigned(Data) then begin
8371     SourceData := Data;
8372     ImgSize := Height * fRowSize;
8373     GetMem(DestData, ImgSize);
8374     try
8375       TempDestData := DestData;
8376       Dec(TempDestData, fRowSize + fPixelSize);
8377       for Row := 0 to Height -1 do begin
8378         Inc(TempDestData, fRowSize * 2);
8379         for Col := 0 to Width -1 do begin
8380           Move(SourceData^, TempDestData^, fPixelSize);
8381           Inc(SourceData, fPixelSize);
8382           Dec(TempDestData, fPixelSize);
8383         end;
8384       end;
8385       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8386       result := true;
8387     except
8388       if Assigned(DestData) then
8389         FreeMem(DestData);
8390       raise;
8391     end;
8392   end;
8393 end;
8394
8395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8396 function TglBitmap2D.FlipVert: Boolean;
8397 var
8398   Row: Integer;
8399   TempDestData, DestData, SourceData: PByte;
8400 begin
8401   result := inherited FlipVert;
8402   if Assigned(Data) then begin
8403     SourceData := Data;
8404     GetMem(DestData, Height * fRowSize);
8405     try
8406       TempDestData := DestData;
8407       Inc(TempDestData, Width * (Height -1) * fPixelSize);
8408       for Row := 0 to Height -1 do begin
8409         Move(SourceData^, TempDestData^, fRowSize);
8410         Dec(TempDestData, fRowSize);
8411         Inc(SourceData, fRowSize);
8412       end;
8413       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
8414       result := true;
8415     except
8416       if Assigned(DestData) then
8417         FreeMem(DestData);
8418       raise;
8419     end;
8420   end;
8421 end;
8422
8423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8424 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8426 type
8427   TMatrixItem = record
8428     X, Y: Integer;
8429     W: Single;
8430   end;
8431
8432   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
8433   TglBitmapToNormalMapRec = Record
8434     Scale: Single;
8435     Heights: array of Single;
8436     MatrixU : array of TMatrixItem;
8437     MatrixV : array of TMatrixItem;
8438   end;
8439
8440 const
8441   ONE_OVER_255 = 1 / 255;
8442
8443   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8444 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
8445 var
8446   Val: Single;
8447 begin
8448   with FuncRec do begin
8449     Val :=
8450       Source.Data.r * LUMINANCE_WEIGHT_R +
8451       Source.Data.g * LUMINANCE_WEIGHT_G +
8452       Source.Data.b * LUMINANCE_WEIGHT_B;
8453     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
8454   end;
8455 end;
8456
8457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8458 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
8459 begin
8460   with FuncRec do
8461     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
8462 end;
8463
8464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8465 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
8466 type
8467   TVec = Array[0..2] of Single;
8468 var
8469   Idx: Integer;
8470   du, dv: Double;
8471   Len: Single;
8472   Vec: TVec;
8473
8474   function GetHeight(X, Y: Integer): Single;
8475   begin
8476     with FuncRec do begin
8477       X := Max(0, Min(Size.X -1, X));
8478       Y := Max(0, Min(Size.Y -1, Y));
8479       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
8480     end;
8481   end;
8482
8483 begin
8484   with FuncRec do begin
8485     with PglBitmapToNormalMapRec(Args)^ do begin
8486       du := 0;
8487       for Idx := Low(MatrixU) to High(MatrixU) do
8488         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
8489
8490       dv := 0;
8491       for Idx := Low(MatrixU) to High(MatrixU) do
8492         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
8493
8494       Vec[0] := -du * Scale;
8495       Vec[1] := -dv * Scale;
8496       Vec[2] := 1;
8497     end;
8498
8499     // Normalize
8500     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8501     if Len <> 0 then begin
8502       Vec[0] := Vec[0] * Len;
8503       Vec[1] := Vec[1] * Len;
8504       Vec[2] := Vec[2] * Len;
8505     end;
8506
8507     // Farbe zuweisem
8508     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
8509     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
8510     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
8511   end;
8512 end;
8513
8514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8515 procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
8516 var
8517   Rec: TglBitmapToNormalMapRec;
8518
8519   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
8520   begin
8521     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
8522       Matrix[Index].X := X;
8523       Matrix[Index].Y := Y;
8524       Matrix[Index].W := W;
8525     end;
8526   end;
8527
8528 begin
8529   if TFormatDescriptor.Get(Format).IsCompressed then
8530     raise EglBitmapUnsupportedFormat.Create(Format);
8531
8532   if aScale > 100 then
8533     Rec.Scale := 100
8534   else if aScale < -100 then
8535     Rec.Scale := -100
8536   else
8537     Rec.Scale := aScale;
8538
8539   SetLength(Rec.Heights, Width * Height);
8540   try
8541     case aFunc of
8542       nm4Samples: begin
8543         SetLength(Rec.MatrixU, 2);
8544         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
8545         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
8546
8547         SetLength(Rec.MatrixV, 2);
8548         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
8549         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
8550       end;
8551
8552       nmSobel: begin
8553         SetLength(Rec.MatrixU, 6);
8554         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
8555         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
8556         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
8557         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
8558         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
8559         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
8560
8561         SetLength(Rec.MatrixV, 6);
8562         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
8563         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
8564         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
8565         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
8566         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
8567         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
8568       end;
8569
8570       nm3x3: begin
8571         SetLength(Rec.MatrixU, 6);
8572         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
8573         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
8574         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
8575         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
8576         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
8577         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
8578
8579         SetLength(Rec.MatrixV, 6);
8580         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
8581         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
8582         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
8583         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
8584         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
8585         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
8586       end;
8587
8588       nm5x5: begin
8589         SetLength(Rec.MatrixU, 20);
8590         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
8591         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
8592         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
8593         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
8594         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
8595         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
8596         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
8597         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
8598         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
8599         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
8600         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
8601         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
8602         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
8603         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
8604         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
8605         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
8606         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
8607         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
8608         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
8609         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
8610
8611         SetLength(Rec.MatrixV, 20);
8612         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
8613         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
8614         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
8615         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
8616         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
8617         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
8618         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
8619         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
8620         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
8621         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
8622         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
8623         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
8624         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
8625         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
8626         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
8627         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
8628         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
8629         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
8630         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
8631         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
8632       end;
8633     end;
8634
8635     // Daten Sammeln
8636     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
8637       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
8638     else
8639       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
8640     Convert(glBitmapToNormalMapFunc, false, @Rec);
8641   finally
8642     SetLength(Rec.Heights, 0);
8643   end;
8644 end;
8645
8646 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8648 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8650 procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
8651 begin
8652   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8653 end;
8654
8655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8656 procedure TglBitmapCubeMap.AfterConstruction;
8657 begin
8658   inherited;
8659
8660 {$IFNDEF OPENGL_ES}
8661   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8662     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8663 {$ELSE}
8664   if not (GL_VERSION_2_0) then
8665     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8666 {$ENDIF}
8667
8668   SetWrap;
8669   Target   := GL_TEXTURE_CUBE_MAP;
8670 {$IFNDEF OPENGL_ES}
8671   fGenMode := GL_REFLECTION_MAP;
8672 {$ENDIF}
8673 end;
8674
8675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8676 procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
8677 var
8678   {$IFNDEF OPENGL_ES}
8679   BuildWithGlu: Boolean;
8680   {$ENDIF}
8681   TexSize: Integer;
8682 begin
8683   if (aTestTextureSize) then begin
8684     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8685
8686     if (Height > TexSize) or (Width > TexSize) then
8687       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8688
8689 {$IF NOT DEFINED(OPENGL_ES)}
8690     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8691       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8692 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8693     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
8694       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8695 {$ELSE}
8696     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
8697       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8698 {$IFEND}
8699   end;
8700
8701   if (ID = 0) then
8702     CreateID;
8703   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8704   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8705 end;
8706
8707 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8708 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8709 begin
8710   inherited Bind (aEnableTextureUnit);
8711 {$IFNDEF OPENGL_ES}
8712   if aEnableTexCoordsGen then begin
8713     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8714     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8715     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8716     glEnable(GL_TEXTURE_GEN_S);
8717     glEnable(GL_TEXTURE_GEN_T);
8718     glEnable(GL_TEXTURE_GEN_R);
8719   end;
8720 {$ENDIF}
8721 end;
8722
8723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8724 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8725 begin
8726   inherited Unbind(aDisableTextureUnit);
8727 {$IFNDEF OPENGL_ES}
8728   if aDisableTexCoordsGen then begin
8729     glDisable(GL_TEXTURE_GEN_S);
8730     glDisable(GL_TEXTURE_GEN_T);
8731     glDisable(GL_TEXTURE_GEN_R);
8732   end;
8733 {$ENDIF}
8734 end;
8735 {$IFEND}
8736
8737 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8739 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8741 type
8742   TVec = Array[0..2] of Single;
8743   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8744
8745   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8746   TglBitmapNormalMapRec = record
8747     HalfSize : Integer;
8748     Func: TglBitmapNormalMapGetVectorFunc;
8749   end;
8750
8751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8752 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8753 begin
8754   aVec[0] := aHalfSize;
8755   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8756   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8757 end;
8758
8759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8760 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8761 begin
8762   aVec[0] := - aHalfSize;
8763   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8764   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8765 end;
8766
8767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8768 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8769 begin
8770   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8771   aVec[1] := aHalfSize;
8772   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8773 end;
8774
8775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8776 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8777 begin
8778   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8779   aVec[1] := - aHalfSize;
8780   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8781 end;
8782
8783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8784 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8785 begin
8786   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8787   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8788   aVec[2] := aHalfSize;
8789 end;
8790
8791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8792 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8793 begin
8794   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8795   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8796   aVec[2] := - aHalfSize;
8797 end;
8798
8799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8800 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8801 var
8802   i: Integer;
8803   Vec: TVec;
8804   Len: Single;
8805 begin
8806   with FuncRec do begin
8807     with PglBitmapNormalMapRec(Args)^ do begin
8808       Func(Vec, Position, HalfSize);
8809
8810       // Normalize
8811       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8812       if Len <> 0 then begin
8813         Vec[0] := Vec[0] * Len;
8814         Vec[1] := Vec[1] * Len;
8815         Vec[2] := Vec[2] * Len;
8816       end;
8817
8818       // Scale Vector and AddVectro
8819       Vec[0] := Vec[0] * 0.5 + 0.5;
8820       Vec[1] := Vec[1] * 0.5 + 0.5;
8821       Vec[2] := Vec[2] * 0.5 + 0.5;
8822     end;
8823
8824     // Set Color
8825     for i := 0 to 2 do
8826       Dest.Data.arr[i] := Round(Vec[i] * 255);
8827   end;
8828 end;
8829
8830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8831 procedure TglBitmapNormalMap.AfterConstruction;
8832 begin
8833   inherited;
8834 {$IFNDEF OPENGL_ES}
8835   fGenMode := GL_NORMAL_MAP;
8836 {$ENDIF}
8837 end;
8838
8839 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8840 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
8841 var
8842   Rec: TglBitmapNormalMapRec;
8843   SizeRec: TglBitmapSize;
8844 begin
8845   Rec.HalfSize := aSize div 2;
8846   FreeDataAfterGenTexture := false;
8847
8848   SizeRec.Fields := [ffX, ffY];
8849   SizeRec.X := aSize;
8850   SizeRec.Y := aSize;
8851
8852   // Positive X
8853   Rec.Func := glBitmapNormalMapPosX;
8854   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8855   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
8856
8857   // Negative X
8858   Rec.Func := glBitmapNormalMapNegX;
8859   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8860   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
8861
8862   // Positive Y
8863   Rec.Func := glBitmapNormalMapPosY;
8864   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8865   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
8866
8867   // Negative Y
8868   Rec.Func := glBitmapNormalMapNegY;
8869   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8870   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
8871
8872   // Positive Z
8873   Rec.Func := glBitmapNormalMapPosZ;
8874   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8875   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
8876
8877   // Negative Z
8878   Rec.Func := glBitmapNormalMapNegZ;
8879   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
8880   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
8881 end;
8882 {$IFEND}
8883
8884 initialization
8885   glBitmapSetDefaultFormat (tfEmpty);
8886   glBitmapSetDefaultMipmap (mmMipmap);
8887   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8888   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8889 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8890   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8891 {$IFEND}
8892
8893   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8894   glBitmapSetDefaultDeleteTextureOnFree    (true);
8895
8896   TFormatDescriptor.Init;
8897
8898 finalization
8899   TFormatDescriptor.Finalize;
8900
8901 end.