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     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 255     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 256     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 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     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 278     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 279     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 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   { structure to store pixel data in }
 350   TglBitmapPixelData = packed record
 351     Data:   TglBitmapRec4ui;  //< color data for each color channel
 352     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 353     Format: TglBitmapFormat;  //< format of the pixel
 354   end;
 355   PglBitmapPixelData = ^TglBitmapPixelData;
 356
 357   TglBitmapSizeFields = set of (ffX, ffY);
 358   TglBitmapSize = packed record
 359     Fields: TglBitmapSizeFields;
 360     X: Word;
 361     Y: Word;
 362   end;
 363   TglBitmapPixelPosition = TglBitmapSize;
 364
 365   { describes the properties of a given texture data format }
 366   TglBitmapFormatDescriptor = class(TObject)
 367   private
 368     // cached properties
 369     fBytesPerPixel: Single;   //< number of bytes for each pixel
 370     fChannelCount: Integer;   //< number of color channels
 371     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 372     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 373
 374     { @return @true if the format has a red color channel, @false otherwise }
 375     function GetHasRed: Boolean;
 376
 377     { @return @true if the format has a green color channel, @false otherwise }
 378     function GetHasGreen: Boolean;
 379
 380     { @return @true if the format has a blue color channel, @false otherwise }
 381     function GetHasBlue: Boolean;
 382
 383     { @return @true if the format has a alpha color channel, @false otherwise }
 384     function GetHasAlpha: Boolean;
 385
 386     { @return @true if the format has any color color channel, @false otherwise }
 387     function GetHasColor: Boolean;
 388
 389     { @return @true if the format is a grayscale format, @false otherwise }
 390     function GetIsGrayscale: Boolean;
 391
 392     { @return @true if the format is supported by OpenGL, @false otherwise }
 393     function GetHasOpenGLSupport: Boolean;
 394
 395   protected
 396     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 397     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 398     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 399     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 400     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 401     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 402
 403     fBitsPerPixel: Integer;           //< number of bits per pixel
 404     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 405
 406     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 407     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 408
 409     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 410     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 411     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 412
 413     { set values for this format descriptor }
 414     procedure SetValues; virtual;
 415
 416     { calculate cached values }
 417     procedure CalcValues;
 418   public
 419     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 420     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 421     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 422     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 423     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 424
 425     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 426     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 427     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 428     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 429
 430     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 431     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 432     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 433     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 434     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 435
 436     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 437     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 438     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 439
 440     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 441     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 442     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 443     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 444     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 445     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 446
 447     property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
 448
 449     function GetSize(const aSize: TglBitmapSize): Integer;     overload; virtual;
 450     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
 451
 452     { constructor }
 453     constructor Create;
 454   public
 455     { get the format descriptor by a given OpenGL internal format
 456         @param aInternalFormat  OpenGL internal format to get format descriptor for
 457         @returns                suitable format descriptor or tfEmpty-Descriptor }
 458     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; overload;
 459
 460     { get the format descriptor by the given format
 461         @param aFormat  format to get descriptor for
 462         @return         suitable format descriptor or tfEmpty-Descriptor }
 463     class function GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor; overload;
 464   end;
 465
 466 ////////////////////////////////////////////////////////////////////////////////////////////////////
 467   TglBitmapData = class;
 468
 469   { structure to store data for converting in }
 470   TglBitmapFunctionRec = record
 471     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 472     Size:     TglBitmapSize;          //< size of the texture
 473     Position: TglBitmapPixelPosition; //< position of the currently pixel
 474     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 475     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 476     Args:     Pointer;                //< user defined args that was passed to the convert function
 477   end;
 478
 479   { callback to use for converting texture data }
 480   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 481
 482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 483   { class to store texture data in. used to load, save and
 484     manipulate data before assigned to texture object
 485     all operations on a data object can be done from a background thread }
 486   TglBitmapData = class
 487   private { fields }
 488
 489     fData: PByte;               //< texture data
 490     fDimension: TglBitmapSize;  //< pixel size of the data
 491     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 492     fFilename: String;          //< file the data was load from
 493
 494     fScanlines:    array of PByte;  //< pointer to begin of each line
 495     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 496
 497   private { getter / setter }
 498
 499     { @returns the format descriptor suitable to the texture data format }
 500     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 501
 502     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 503     function GetWidth: Integer;
 504
 505     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 506     function GetHeight: Integer;
 507
 508     { get scanline at index aIndex
 509         @returns Pointer to start of line or @nil }
 510     function GetScanlines(const aIndex: Integer): PByte;
 511
 512     { set new value for the data format. only possible if new format has the same pixel size.
 513       if you want to convert the texture data, see ConvertTo function }
 514     procedure SetFormat(const aValue: TglBitmapFormat);
 515
 516   private { internal misc }
 517
 518     { splits a resource identifier into the resource and it's type
 519         @param aResource  resource identifier to split and store name in
 520         @param aResType   type of the resource }
 521     procedure PrepareResType(var aResource: String; var aResType: PChar);
 522
 523     { updates scanlines array }
 524     procedure UpdateScanlines;
 525
 526   private { internal load and save }
 527 {$IFDEF GLB_SUPPORT_PNG_READ}
 528     { try to load a PNG from a stream
 529         @param aStream  stream to load PNG from
 530         @returns        @true on success, @false otherwise }
 531     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 532 {$ENDIF}
 533
 534 {$ifdef GLB_SUPPORT_PNG_WRITE}
 535     { save texture data as PNG to stream
 536         @param aStream stream to save data to}
 537     procedure SavePNG(const aStream: TStream); virtual;
 538 {$ENDIF}
 539
 540 {$IFDEF GLB_SUPPORT_JPEG_READ}
 541     { try to load a JPEG from a stream
 542         @param aStream  stream to load JPEG from
 543         @returns        @true on success, @false otherwise }
 544     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 545 {$ENDIF}
 546
 547 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 548     { save texture data as JPEG to stream
 549         @param aStream stream to save data to}
 550     procedure SaveJPEG(const aStream: TStream); virtual;
 551 {$ENDIF}
 552
 553     { try to load a RAW image from a stream
 554         @param aStream  stream to load RAW image from
 555         @returns        @true on success, @false otherwise }
 556     function LoadRAW(const aStream: TStream): Boolean;
 557
 558     { save texture data as RAW image to stream
 559         @param aStream stream to save data to}
 560     procedure SaveRAW(const aStream: TStream);
 561
 562     { try to load a BMP from a stream
 563         @param aStream  stream to load BMP from
 564         @returns        @true on success, @false otherwise }
 565     function LoadBMP(const aStream: TStream): Boolean;
 566
 567     { save texture data as BMP to stream
 568         @param aStream stream to save data to}
 569     procedure SaveBMP(const aStream: TStream);
 570
 571     { try to load a TGA from a stream
 572         @param aStream  stream to load TGA from
 573         @returns        @true on success, @false otherwise }
 574     function LoadTGA(const aStream: TStream): Boolean;
 575
 576     { save texture data as TGA to stream
 577         @param aStream stream to save data to}
 578     procedure SaveTGA(const aStream: TStream);
 579
 580     { try to load a DDS from a stream
 581         @param aStream  stream to load DDS from
 582         @returns        @true on success, @false otherwise }
 583     function LoadDDS(const aStream: TStream): Boolean;
 584
 585     { save texture data as DDS to stream
 586         @param aStream stream to save data to}
 587     procedure SaveDDS(const aStream: TStream);
 588
 589   public { properties }
 590     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 591     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 592     property Filename:  String          read fFilename;                 //< file the data was loaded from
 593     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 594     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 595     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 596     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 597
 598     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 599
 600   public { flip }
 601
 602     { flip texture horizontal
 603         @returns @true in success, @false otherwise }
 604     function FlipHorz: Boolean; virtual;
 605
 606     { flip texture vertical
 607         @returns @true in success, @false otherwise }
 608     function FlipVert: Boolean; virtual;
 609
 610   public { load }
 611
 612     { load a texture from a file
 613         @param aFilename file to load texuture from }
 614     procedure LoadFromFile(const aFilename: String);
 615
 616     { load a texture from a stream
 617         @param aStream  stream to load texture from }
 618     procedure LoadFromStream(const aStream: TStream); virtual;
 619
 620     { use a function to generate texture data
 621         @param aSize    size of the texture
 622         @param aFormat  format of the texture data
 623         @param aFunc    callback to use for generation
 624         @param aArgs    user defined paramaters (use at will) }
 625     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 626
 627     { load a texture from a resource
 628         @param aInstance  resource handle
 629         @param aResource  resource indentifier
 630         @param aResType   resource type (if known) }
 631     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 632
 633     { load a texture from a resource id
 634         @param aInstance  resource handle
 635         @param aResource  resource ID
 636         @param aResType   resource type }
 637     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 638
 639   public { save }
 640
 641     { save texture data to a file
 642         @param aFilename  filename to store texture in
 643         @param aFileType  file type to store data into }
 644     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 645
 646     { save texture data to a stream
 647         @param aFilename  filename to store texture in
 648         @param aFileType  file type to store data into }
 649     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 650
 651   public { convert }
 652
 653     { convert texture data using a user defined callback
 654         @param aFunc        callback to use for converting
 655         @param aCreateTemp  create a temporary buffer to use for converting
 656         @param aArgs        user defined paramters (use at will)
 657         @returns            @true if converting was successful, @false otherwise }
 658     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 659
 660     { convert texture data using a user defined callback
 661         @param aSource      glBitmap to read data from
 662         @param aFunc        callback to use for converting
 663         @param aCreateTemp  create a temporary buffer to use for converting
 664         @param aFormat      format of the new data
 665         @param aArgs        user defined paramters (use at will)
 666         @returns            @true if converting was successful, @false otherwise }
 667     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 668       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 669
 670     { convert texture data using a specific format
 671         @param aFormat  new format of texture data
 672         @returns        @true if converting was successful, @false otherwise }
 673     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 674
 675 {$IFDEF GLB_SDL}
 676   public { SDL }
 677
 678     { assign texture data to SDL surface
 679         @param aSurface SDL surface to write data to
 680         @returns        @true on success, @false otherwise }
 681     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 682
 683     { assign texture data from SDL surface
 684         @param aSurface SDL surface to read data from
 685         @returns        @true on success, @false otherwise }
 686     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 687
 688     { assign alpha channel data to SDL surface
 689         @param aSurface SDL surface to write alpha channel data to
 690         @returns        @true on success, @false otherwise }
 691     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 692
 693     { assign alpha channel data from SDL surface
 694         @param aSurface SDL surface to read data from
 695         @param aFunc    callback to use for converting
 696         @param aArgs    user defined parameters (use at will)
 697         @returns        @true on success, @false otherwise }
 698     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 699 {$ENDIF}
 700
 701 {$IFDEF GLB_DELPHI}
 702   public { Delphi }
 703
 704     { assign texture data to TBitmap object
 705         @param aBitmap  TBitmap to write data to
 706         @returns        @true on success, @false otherwise }
 707     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 708
 709     { assign texture data from TBitmap object
 710         @param aBitmap  TBitmap to read data from
 711         @returns        @true on success, @false otherwise }
 712     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 713
 714     { assign alpha channel data to TBitmap object
 715         @param aBitmap  TBitmap to write data to
 716         @returns        @true on success, @false otherwise }
 717     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 718
 719     { assign alpha channel data from TBitmap object
 720         @param aBitmap  TBitmap to read data from
 721         @param aFunc    callback to use for converting
 722         @param aArgs    user defined parameters (use at will)
 723         @returns        @true on success, @false otherwise }
 724     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 725 {$ENDIF}
 726
 727 {$IFDEF GLB_LAZARUS}
 728   public { Lazarus }
 729
 730     { assign texture data to TLazIntfImage object
 731         @param aImage   TLazIntfImage to write data to
 732         @returns        @true on success, @false otherwise }
 733     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 734
 735     { assign texture data from TLazIntfImage object
 736         @param aImage   TLazIntfImage to read data from
 737         @returns        @true on success, @false otherwise }
 738     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 739
 740     { assign alpha channel data to TLazIntfImage object
 741         @param aImage   TLazIntfImage to write data to
 742         @returns        @true on success, @false otherwise }
 743     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 744
 745     { assign alpha channel data from TLazIntfImage object
 746         @param aImage   TLazIntfImage to read data from
 747         @param aFunc    callback to use for converting
 748         @param aArgs    user defined parameters (use at will)
 749         @returns        @true on success, @false otherwise }
 750     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 751 {$ENDIF}
 752
 753   public { Alpha }
 754     { load alpha channel data from resource
 755         @param aInstance  resource handle
 756         @param aResource  resource ID
 757         @param aResType   resource type
 758         @param aFunc      callback to use for converting
 759         @param aArgs      user defined parameters (use at will)
 760         @returns          @true on success, @false otherwise }
 761     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 762
 763     { load alpha channel data from resource ID
 764         @param aInstance    resource handle
 765         @param aResourceID  resource ID
 766         @param aResType     resource type
 767         @param aFunc        callback to use for converting
 768         @param aArgs        user defined parameters (use at will)
 769         @returns            @true on success, @false otherwise }
 770     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 771
 772     { add alpha channel data from function
 773         @param aFunc  callback to get data from
 774         @param aArgs  user defined parameters (use at will)
 775         @returns      @true on success, @false otherwise }
 776     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 777
 778     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 779         @param aFilename  file to load alpha channel data from
 780         @param aFunc      callback to use for converting
 781         @param aArgs     SetFormat user defined parameters (use at will)
 782         @returns          @true on success, @false otherwise }
 783     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 784
 785     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 786         @param aStream  stream to load alpha channel data from
 787         @param aFunc    callback to use for converting
 788         @param aArgs    user defined parameters (use at will)
 789         @returns        @true on success, @false otherwise }
 790     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 791
 792     { add alpha channel data from existing glBitmap object
 793         @param aBitmap  TglBitmap to copy alpha channel data from
 794         @param aFunc    callback to use for converting
 795         @param aArgs    user defined parameters (use at will)
 796         @returns        @true on success, @false otherwise }
 797     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 798
 799     { add alpha to pixel if the pixels color is greter than the given color value
 800         @param aRed         red threshold (0-255)
 801         @param aGreen       green threshold (0-255)
 802         @param aBlue        blue threshold (0-255)
 803         @param aDeviatation accepted deviatation (0-255)
 804         @returns            @true on success, @false otherwise }
 805     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 806
 807     { add alpha to pixel if the pixels color is greter than the given color value
 808         @param aRed         red threshold (0-Range.r)
 809         @param aGreen       green threshold (0-Range.g)
 810         @param aBlue        blue threshold (0-Range.b)
 811         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 812         @returns            @true on success, @false otherwise }
 813     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 814
 815     { add alpha to pixel if the pixels color is greter than the given color value
 816         @param aRed         red threshold (0.0-1.0)
 817         @param aGreen       green threshold (0.0-1.0)
 818         @param aBlue        blue threshold (0.0-1.0)
 819         @param aDeviatation accepted deviatation (0.0-1.0)
 820         @returns            @true on success, @false otherwise }
 821     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 822
 823     { add a constand alpha value to all pixels
 824         @param aAlpha alpha value to add (0-255)
 825         @returns      @true on success, @false otherwise }
 826     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 827
 828     { add a constand alpha value to all pixels
 829         @param aAlpha alpha value to add (0-max(Range.rgb))
 830         @returns      @true on success, @false otherwise }
 831     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 832
 833     { add a constand alpha value to all pixels
 834         @param aAlpha alpha value to add (0.0-1.0)
 835         @returns      @true on success, @false otherwise }
 836     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 837
 838     { remove alpha channel
 839         @returns  @true on success, @false otherwise }
 840     function RemoveAlpha: Boolean; virtual;
 841
 842   public { fill }
 843     { fill complete texture with one color
 844         @param aRed   red color for border (0-255)
 845         @param aGreen green color for border (0-255)
 846         @param aBlue  blue color for border (0-255)
 847         @param aAlpha alpha color for border (0-255) }
 848     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 849
 850     { fill complete texture with one color
 851         @param aRed   red color for border (0-Range.r)
 852         @param aGreen green color for border (0-Range.g)
 853         @param aBlue  blue color for border (0-Range.b)
 854         @param aAlpha alpha color for border (0-Range.a) }
 855     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 856
 857     { fill complete texture with one color
 858         @param aRed   red color for border (0.0-1.0)
 859         @param aGreen green color for border (0.0-1.0)
 860         @param aBlue  blue color for border (0.0-1.0)
 861         @param aAlpha alpha color for border (0.0-1.0) }
 862     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 863
 864   public { Misc }
 865
 866     { set data pointer of texture data
 867         @param aData    pointer to new texture data
 868         @param aFormat  format of the data stored at aData
 869         @param aWidth   width of the texture data
 870         @param aHeight  height of the texture data }
 871     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 872       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 873
 874       { create a clone of the current object
 875         @returns clone of this object}
 876     function Clone: TglBitmapData;
 877
 878     { invert color data (bitwise not)
 879         @param aRed     invert red channel
 880         @param aGreen   invert green channel
 881         @param aBlue    invert blue channel
 882         @param aAlpha   invert alpha channel }
 883     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 884
 885     { create normal map from texture data
 886         @param aFunc      normal map function to generate normalmap with
 887         @param aScale     scale of the normale stored in the normal map
 888         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 889     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 890       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 891
 892   public { constructor }
 893
 894     { constructor - creates a texutre data object }
 895     constructor Create; overload;
 896
 897     { constructor - creates a texture data object and loads it from a file
 898         @param aFilename file to load texture from }
 899     constructor Create(const aFileName: String); overload;
 900
 901     { constructor - creates a texture data object and loads it from a stream
 902         @param aStream stream to load texture from }
 903     constructor Create(const aStream: TStream); overload;
 904
 905     { constructor - creates a texture data object with the given size, format and data
 906         @param aSize    size of the texture
 907         @param aFormat  format of the given data
 908         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 909     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 910
 911     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 912         @param aSize    size of the texture
 913         @param aFormat  format of the given data
 914         @param aFunc    callback to use for generating the data
 915         @param aArgs    user defined parameters (use at will) }
 916     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 917
 918     { constructor - creates a texture data object and loads it from a resource
 919         @param aInstance  resource handle
 920         @param aResource  resource indentifier
 921         @param aResType   resource type (if known) }
 922     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 923
 924     { constructor - creates a texture data object and loads it from a resource
 925         @param aInstance    resource handle
 926         @param aResourceID  resource ID
 927         @param aResType     resource type (if known) }
 928     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 929
 930     { destructor }
 931     destructor Destroy; override;
 932
 933   end;
 934
 935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 936   { base class for all glBitmap classes. used to manage OpenGL texture objects
 937     all operations on a bitmap object must be done from the render thread }
 938   TglBitmap = class
 939   protected
 940     fID: GLuint;                          //< name of the OpenGL texture object
 941     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 942     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 943
 944     // texture properties
 945     fFilterMin: GLenum;                   //< min filter to apply to the texture
 946     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 947     fWrapS: GLenum;                       //< texture wrapping for x axis
 948     fWrapT: GLenum;                       //< texture wrapping for y axis
 949     fWrapR: GLenum;                       //< texture wrapping for z axis
 950     fAnisotropic: Integer;                //< anisotropic level
 951     fBorderColor: array[0..3] of Single;  //< color of the texture border
 952
 953 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 954     //Swizzle
 955     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 956 {$IFEND}
 957 {$IFNDEF OPENGL_ES}
 958     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 959 {$ENDIF}
 960
 961     fDimension: TglBitmapSize;            //< size of this texture
 962     fMipMap: TglBitmapMipMap;             //< mipmap type
 963
 964     // CustomData
 965     fCustomData: Pointer;                 //< user defined data
 966     fCustomName: String;                  //< user defined name
 967     fCustomNameW: WideString;             //< user defined name
 968   protected
 969     { @returns the actual width of the texture }
 970     function GetWidth:  Integer; virtual;
 971
 972     { @returns the actual height of the texture }
 973     function GetHeight: Integer; virtual;
 974
 975   protected
 976     { set a new value for fCustomData }
 977     procedure SetCustomData(const aValue: Pointer);
 978
 979     { set a new value for fCustomName }
 980     procedure SetCustomName(const aValue: String);
 981
 982     { set a new value for fCustomNameW }
 983     procedure SetCustomNameW(const aValue: WideString);
 984
 985     { set new value for fDeleteTextureOnFree }
 986     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 987
 988     { set name of OpenGL texture object }
 989     procedure SetID(const aValue: Cardinal);
 990
 991     { set new value for fMipMap }
 992     procedure SetMipMap(const aValue: TglBitmapMipMap);
 993
 994     { set new value for target }
 995     procedure SetTarget(const aValue: Cardinal);
 996
 997     { set new value for fAnisotrophic }
 998     procedure SetAnisotropic(const aValue: Integer);
 999
1000   protected
1001     { create OpenGL texture object (delete exisiting object if exists) }
1002     procedure CreateID;
1003
1004     { setup texture parameters }
1005     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1006
1007   protected
1008     property Width:  Integer read GetWidth;   //< the actual width of the texture
1009     property Height: Integer read GetHeight;  //< the actual height of the texture
1010
1011   public
1012     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1013     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1014     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1015
1016     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1017     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1018
1019     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1020     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1021     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1022
1023     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1024 {$IFNDEF OPENGL_ES}
1025     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1026 {$ENDIF}
1027
1028     { this method is called after the constructor and sets the default values of this object }
1029     procedure AfterConstruction; override;
1030
1031     { this method is called before the destructor and does some cleanup }
1032     procedure BeforeDestruction; override;
1033
1034   public
1035 {$IFNDEF OPENGL_ES}
1036     { set the new value for texture border color
1037         @param aRed   red color for border (0.0-1.0)
1038         @param aGreen green color for border (0.0-1.0)
1039         @param aBlue  blue color for border (0.0-1.0)
1040         @param aAlpha alpha color for border (0.0-1.0) }
1041     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1042 {$ENDIF}
1043
1044   public
1045     { set new texture filer
1046         @param aMin   min filter
1047         @param aMag   mag filter }
1048     procedure SetFilter(const aMin, aMag: GLenum);
1049
1050     { set new texture wrapping
1051         @param S  texture wrapping for x axis
1052         @param T  texture wrapping for y axis
1053         @param R  texture wrapping for z axis }
1054     procedure SetWrap(
1055       const S: GLenum = GL_CLAMP_TO_EDGE;
1056       const T: GLenum = GL_CLAMP_TO_EDGE;
1057       const R: GLenum = GL_CLAMP_TO_EDGE);
1058
1059 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1060     { set new swizzle
1061         @param r  swizzle for red channel
1062         @param g  swizzle for green channel
1063         @param b  swizzle for blue channel
1064         @param a  swizzle for alpha channel }
1065     procedure SetSwizzle(const r, g, b, a: GLenum);
1066 {$IFEND}
1067
1068   public
1069     { bind texture
1070         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1071     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean = true{$ENDIF}); virtual;
1072
1073     { bind texture
1074         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1075     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean = true{$ENDIF}); virtual;
1076
1077     { upload texture data from given data object to video card
1078         @param aData        texture data object that contains the actual data
1079         @param aCheckSize   check size before upload and throw exception if something is wrong }
1080     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1081
1082 {$IFNDEF OPENGL_ES}
1083     { download texture data from video card and store it into given data object
1084         @returns @true when download was successfull, @false otherwise }
1085     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1086 {$ENDIF}
1087   public
1088     { constructor - creates an empty texture }
1089     constructor Create; overload;
1090
1091     { constructor - creates an texture object and uploads the given data }
1092     constructor Create(const aData: TglBitmapData); overload;
1093
1094   end;
1095
1096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1097 {$IF NOT DEFINED(OPENGL_ES)}
1098   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1099     all operations on a bitmap object must be done from the render thread }
1100   TglBitmap1D = class(TglBitmap)
1101   protected
1102
1103     { upload the texture data to video card
1104         @param aDataObj       texture data object that contains the actual data
1105         @param aBuildWithGlu  use glu functions to build mipmaps }
1106     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1107
1108   public
1109     property Width; //< actual with of the texture
1110
1111     { this method is called after constructor and initializes the object }
1112     procedure AfterConstruction; override;
1113
1114     { upload texture data from given data object to video card
1115         @param aData        texture data object that contains the actual data
1116         @param aCheckSize   check size before upload and throw exception if something is wrong }
1117     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1118
1119   end;
1120 {$IFEND}
1121
1122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1123   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1124     all operations on a bitmap object must be done from the render thread }
1125   TglBitmap2D = class(TglBitmap)
1126   protected
1127
1128     { upload the texture data to video card
1129         @param aDataObj       texture data object that contains the actual data
1130         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1131         @param aBuildWithGlu  use glu functions to build mipmaps }
1132     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1133       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1134
1135   public
1136     property Width;   //< actual width of the texture
1137     property Height;  //< actual height of the texture
1138
1139     { this method is called after constructor and initializes the object }
1140     procedure AfterConstruction; override;
1141
1142     { upload texture data from given data object to video card
1143         @param aData        texture data object that contains the actual data
1144         @param aCheckSize   check size before upload and throw exception if something is wrong }
1145     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1146
1147   public
1148
1149     { copy a part of the frame buffer to the texture
1150         @param aTop     topmost pixel to copy
1151         @param aLeft    leftmost pixel to copy
1152         @param aRight   rightmost pixel to copy
1153         @param aBottom  bottommost pixel to copy
1154         @param aFormat  format to store data in
1155         @param aDataObj texture data object to store the data in }
1156     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1157
1158   end;
1159
1160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1161 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1162   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1163     all operations on a bitmap object must be done from the render thread }
1164   TglBitmapCubeMap = class(TglBitmap2D)
1165   protected
1166   {$IFNDEF OPENGL_ES}
1167     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1168   {$ENDIF}
1169
1170   public
1171     { this method is called after constructor and initializes the object }
1172     procedure AfterConstruction; override;
1173
1174     { upload texture data from given data object to video card
1175         @param aData        texture data object that contains the actual data
1176         @param aCheckSize   check size before upload and throw exception if something is wrong }
1177     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1178
1179     { upload texture data from given data object to video card
1180         @param aData        texture data object that contains the actual data
1181         @param aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1182         @param aCheckSize   check size before upload and throw exception if something is wrong }
1183     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1184
1185     { bind texture
1186         @param aEnableTexCoordsGen  enable cube map generator
1187         @param aEnableTextureUnit   enable texture unit }
1188     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
1189
1190     { unbind texture
1191         @param aDisableTexCoordsGen   disable cube map generator
1192         @param aDisableTextureUnit    disable texture unit }
1193     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
1194   end;
1195 {$IFEND}
1196
1197 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1198 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1199   { wrapper class for cube normal maps
1200     all operations on a bitmap object must be done from the render thread }
1201   TglBitmapNormalMap = class(TglBitmapCubeMap)
1202   public
1203     { this method is called after constructor and initializes the object }
1204     procedure AfterConstruction; override;
1205
1206     { create cube normal map from texture data and upload it to video card
1207         @param aSize        size of each cube map texture
1208         @param aCheckSize   check size before upload and throw exception if something is wrong }
1209     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1210   end;
1211 {$IFEND}
1212
1213 const
1214   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1215
1216 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1217 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1218 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1219 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1220 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1221 procedure glBitmapSetDefaultWrap(
1222   const S: Cardinal = GL_CLAMP_TO_EDGE;
1223   const T: Cardinal = GL_CLAMP_TO_EDGE;
1224   const R: Cardinal = GL_CLAMP_TO_EDGE);
1225
1226 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1227 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1228 {$IFEND}
1229
1230 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1231 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1232 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1233 function glBitmapGetDefaultFormat: TglBitmapFormat;
1234 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1235 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1236 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1237 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1238 {$IFEND}
1239
1240 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1241 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1242 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1243 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1244 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1245 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1246 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1247
1248 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1249
1250 {$IFDEF GLB_DELPHI}
1251 function CreateGrayPalette: HPALETTE;
1252 {$ENDIF}
1253
1254 implementation
1255
1256 uses
1257   Math, syncobjs, typinfo
1258   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1259
1260
1261 var
1262   glBitmapDefaultDeleteTextureOnFree: Boolean;
1263   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1264   glBitmapDefaultFormat: TglBitmapFormat;
1265   glBitmapDefaultMipmap: TglBitmapMipMap;
1266   glBitmapDefaultFilterMin: Cardinal;
1267   glBitmapDefaultFilterMag: Cardinal;
1268   glBitmapDefaultWrapS: Cardinal;
1269   glBitmapDefaultWrapT: Cardinal;
1270   glBitmapDefaultWrapR: Cardinal;
1271   glDefaultSwizzle: array[0..3] of GLenum;
1272
1273 ////////////////////////////////////////////////////////////////////////////////////////////////////
1274 type
1275   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1276   public
1277     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1278     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1279
1280     function CreateMappingData: Pointer; virtual;
1281     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1282
1283     function IsEmpty: Boolean; virtual;
1284     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1285
1286     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1287
1288     constructor Create; virtual;
1289   public
1290     class procedure Init;
1291     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1292     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1293     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1294     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1295     class procedure Clear;
1296     class procedure Finalize;
1297   end;
1298   TFormatDescriptorClass = class of TFormatDescriptor;
1299
1300   TfdEmpty = class(TFormatDescriptor);
1301
1302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1303   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1304     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1305     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1306   end;
1307
1308   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1309     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311   end;
1312
1313   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1314     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1315     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1316   end;
1317
1318   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1319     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321   end;
1322
1323   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1324     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1325     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1326   end;
1327
1328   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1329     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1330     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1331   end;
1332
1333   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336   end;
1337
1338   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1339     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1340     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1341   end;
1342
1343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1344   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1345     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1346     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1347   end;
1348
1349   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1350     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1351     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1352   end;
1353
1354   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357   end;
1358
1359   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1360     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1361     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1362   end;
1363
1364   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1365     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1366     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1367   end;
1368
1369   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1370     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1371     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1372   end;
1373
1374   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1375     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1376     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1377   end;
1378
1379   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382   end;
1383
1384   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1385     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1386     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1387   end;
1388
1389   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1390     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1391     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1392   end;
1393
1394   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1395     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1396     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1397   end;
1398
1399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1400   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1401     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1402     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1403   end;
1404
1405   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1406     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1407     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1408   end;
1409
1410 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1411   TfdAlpha4ub1 = class(TfdAlphaUB1)
1412     procedure SetValues; override;
1413   end;
1414
1415   TfdAlpha8ub1 = class(TfdAlphaUB1)
1416     procedure SetValues; override;
1417   end;
1418
1419   TfdAlpha16us1 = class(TfdAlphaUS1)
1420     procedure SetValues; override;
1421   end;
1422
1423   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1424     procedure SetValues; override;
1425   end;
1426
1427   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1428     procedure SetValues; override;
1429   end;
1430
1431   TfdLuminance16us1 = class(TfdLuminanceUS1)
1432     procedure SetValues; override;
1433   end;
1434
1435   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1436     procedure SetValues; override;
1437   end;
1438
1439   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1440     procedure SetValues; override;
1441   end;
1442
1443   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1444     procedure SetValues; override;
1445   end;
1446
1447   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1448     procedure SetValues; override;
1449   end;
1450
1451   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1452     procedure SetValues; override;
1453   end;
1454
1455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1456   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1457     procedure SetValues; override;
1458   end;
1459
1460   TfdRGBX4us1 = class(TfdUniversalUS1)
1461     procedure SetValues; override;
1462   end;
1463
1464   TfdXRGB4us1 = class(TfdUniversalUS1)
1465     procedure SetValues; override;
1466   end;
1467
1468   TfdR5G6B5us1 = class(TfdUniversalUS1)
1469     procedure SetValues; override;
1470   end;
1471
1472   TfdRGB5X1us1 = class(TfdUniversalUS1)
1473     procedure SetValues; override;
1474   end;
1475
1476   TfdX1RGB5us1 = class(TfdUniversalUS1)
1477     procedure SetValues; override;
1478   end;
1479
1480   TfdRGB8ub3 = class(TfdRGBub3)
1481     procedure SetValues; override;
1482   end;
1483
1484   TfdRGBX8ui1 = class(TfdUniversalUI1)
1485     procedure SetValues; override;
1486   end;
1487
1488   TfdXRGB8ui1 = class(TfdUniversalUI1)
1489     procedure SetValues; override;
1490   end;
1491
1492   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1493     procedure SetValues; override;
1494   end;
1495
1496   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1497     procedure SetValues; override;
1498   end;
1499
1500   TfdRGB16us3 = class(TfdRGBus3)
1501     procedure SetValues; override;
1502   end;
1503
1504   TfdRGBA4us1 = class(TfdUniversalUS1)
1505     procedure SetValues; override;
1506   end;
1507
1508   TfdARGB4us1 = class(TfdUniversalUS1)
1509     procedure SetValues; override;
1510   end;
1511
1512   TfdRGB5A1us1 = class(TfdUniversalUS1)
1513     procedure SetValues; override;
1514   end;
1515
1516   TfdA1RGB5us1 = class(TfdUniversalUS1)
1517     procedure SetValues; override;
1518   end;
1519
1520   TfdRGBA8ui1 = class(TfdUniversalUI1)
1521     procedure SetValues; override;
1522   end;
1523
1524   TfdARGB8ui1 = class(TfdUniversalUI1)
1525     procedure SetValues; override;
1526   end;
1527
1528   TfdRGBA8ub4 = class(TfdRGBAub4)
1529     procedure SetValues; override;
1530   end;
1531
1532   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1533     procedure SetValues; override;
1534   end;
1535
1536   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1537     procedure SetValues; override;
1538   end;
1539
1540   TfdRGBA16us4 = class(TfdRGBAus4)
1541     procedure SetValues; override;
1542   end;
1543
1544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1545   TfdBGRX4us1 = class(TfdUniversalUS1)
1546     procedure SetValues; override;
1547   end;
1548
1549   TfdXBGR4us1 = class(TfdUniversalUS1)
1550     procedure SetValues; override;
1551   end;
1552
1553   TfdB5G6R5us1 = class(TfdUniversalUS1)
1554     procedure SetValues; override;
1555   end;
1556
1557   TfdBGR5X1us1 = class(TfdUniversalUS1)
1558     procedure SetValues; override;
1559   end;
1560
1561   TfdX1BGR5us1 = class(TfdUniversalUS1)
1562     procedure SetValues; override;
1563   end;
1564
1565   TfdBGR8ub3 = class(TfdBGRub3)
1566     procedure SetValues; override;
1567   end;
1568
1569   TfdBGRX8ui1 = class(TfdUniversalUI1)
1570     procedure SetValues; override;
1571   end;
1572
1573   TfdXBGR8ui1 = class(TfdUniversalUI1)
1574     procedure SetValues; override;
1575   end;
1576
1577   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1578     procedure SetValues; override;
1579   end;
1580
1581   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1582     procedure SetValues; override;
1583   end;
1584
1585   TfdBGR16us3 = class(TfdBGRus3)
1586     procedure SetValues; override;
1587   end;
1588
1589   TfdBGRA4us1 = class(TfdUniversalUS1)
1590     procedure SetValues; override;
1591   end;
1592
1593   TfdABGR4us1 = class(TfdUniversalUS1)
1594     procedure SetValues; override;
1595   end;
1596
1597   TfdBGR5A1us1 = class(TfdUniversalUS1)
1598     procedure SetValues; override;
1599   end;
1600
1601   TfdA1BGR5us1 = class(TfdUniversalUS1)
1602     procedure SetValues; override;
1603   end;
1604
1605   TfdBGRA8ui1 = class(TfdUniversalUI1)
1606     procedure SetValues; override;
1607   end;
1608
1609   TfdABGR8ui1 = class(TfdUniversalUI1)
1610     procedure SetValues; override;
1611   end;
1612
1613   TfdBGRA8ub4 = class(TfdBGRAub4)
1614     procedure SetValues; override;
1615   end;
1616
1617   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1618     procedure SetValues; override;
1619   end;
1620
1621   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1622     procedure SetValues; override;
1623   end;
1624
1625   TfdBGRA16us4 = class(TfdBGRAus4)
1626     procedure SetValues; override;
1627   end;
1628
1629   TfdDepth16us1 = class(TfdDepthUS1)
1630     procedure SetValues; override;
1631   end;
1632
1633   TfdDepth24ui1 = class(TfdDepthUI1)
1634     procedure SetValues; override;
1635   end;
1636
1637   TfdDepth32ui1 = class(TfdDepthUI1)
1638     procedure SetValues; override;
1639   end;
1640
1641   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1642     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1643     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1644     procedure SetValues; override;
1645   end;
1646
1647   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1648     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1649     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1650     procedure SetValues; override;
1651   end;
1652
1653   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1654     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1655     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1656     procedure SetValues; override;
1657   end;
1658
1659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1660   TbmpBitfieldFormat = class(TFormatDescriptor)
1661   public
1662     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1663     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1664     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1665     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1666   end;
1667
1668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1669   TbmpColorTableEnty = packed record
1670     b, g, r, a: Byte;
1671   end;
1672   TbmpColorTable = array of TbmpColorTableEnty;
1673   TbmpColorTableFormat = class(TFormatDescriptor)
1674   private
1675     fColorTable: TbmpColorTable;
1676   protected
1677     procedure SetValues; override;
1678   public
1679     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1680
1681     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1682     procedure CalcValues;
1683     procedure CreateColorTable;
1684
1685     function CreateMappingData: Pointer; override;
1686     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1687     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1688     destructor Destroy; override;
1689   end;
1690
1691 const
1692   LUMINANCE_WEIGHT_R = 0.30;
1693   LUMINANCE_WEIGHT_G = 0.59;
1694   LUMINANCE_WEIGHT_B = 0.11;
1695
1696   ALPHA_WEIGHT_R = 0.30;
1697   ALPHA_WEIGHT_G = 0.59;
1698   ALPHA_WEIGHT_B = 0.11;
1699
1700   DEPTH_WEIGHT_R = 0.333333333;
1701   DEPTH_WEIGHT_G = 0.333333333;
1702   DEPTH_WEIGHT_B = 0.333333333;
1703
1704   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1705     TfdEmpty,
1706
1707     TfdAlpha4ub1,
1708     TfdAlpha8ub1,
1709     TfdAlpha16us1,
1710
1711     TfdLuminance4ub1,
1712     TfdLuminance8ub1,
1713     TfdLuminance16us1,
1714
1715     TfdLuminance4Alpha4ub2,
1716     TfdLuminance6Alpha2ub2,
1717     TfdLuminance8Alpha8ub2,
1718     TfdLuminance12Alpha4us2,
1719     TfdLuminance16Alpha16us2,
1720
1721     TfdR3G3B2ub1,
1722     TfdRGBX4us1,
1723     TfdXRGB4us1,
1724     TfdR5G6B5us1,
1725     TfdRGB5X1us1,
1726     TfdX1RGB5us1,
1727     TfdRGB8ub3,
1728     TfdRGBX8ui1,
1729     TfdXRGB8ui1,
1730     TfdRGB10X2ui1,
1731     TfdX2RGB10ui1,
1732     TfdRGB16us3,
1733
1734     TfdRGBA4us1,
1735     TfdARGB4us1,
1736     TfdRGB5A1us1,
1737     TfdA1RGB5us1,
1738     TfdRGBA8ub4,
1739     TfdRGBA8ui1,
1740     TfdARGB8ui1,
1741     TfdRGB10A2ui1,
1742     TfdA2RGB10ui1,
1743     TfdRGBA16us4,
1744
1745     TfdBGRX4us1,
1746     TfdXBGR4us1,
1747     TfdB5G6R5us1,
1748     TfdBGR5X1us1,
1749     TfdX1BGR5us1,
1750     TfdBGR8ub3,
1751     TfdBGRX8ui1,
1752     TfdXBGR8ui1,
1753     TfdBGR10X2ui1,
1754     TfdX2BGR10ui1,
1755     TfdBGR16us3,
1756
1757     TfdBGRA4us1,
1758     TfdABGR4us1,
1759     TfdBGR5A1us1,
1760     TfdA1BGR5us1,
1761     TfdBGRA8ub4,
1762     TfdBGRA8ui1,
1763     TfdABGR8ui1,
1764     TfdBGR10A2ui1,
1765     TfdA2BGR10ui1,
1766     TfdBGRA16us4,
1767
1768     TfdDepth16us1,
1769     TfdDepth24ui1,
1770     TfdDepth32ui1,
1771
1772     TfdS3tcDtx1RGBA,
1773     TfdS3tcDtx3RGBA,
1774     TfdS3tcDtx5RGBA
1775   );
1776
1777 var
1778   FormatDescriptorCS: TCriticalSection;
1779   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1780
1781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1782 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1783 begin
1784   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1785 end;
1786
1787 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1788 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1789 begin
1790   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1791 end;
1792
1793 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1794 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1795 begin
1796   result.Fields := [];
1797   if (X >= 0) then
1798     result.Fields := result.Fields + [ffX];
1799   if (Y >= 0) then
1800     result.Fields := result.Fields + [ffY];
1801   result.X := Max(0, X);
1802   result.Y := Max(0, Y);
1803 end;
1804
1805 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1806 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1807 begin
1808   result := glBitmapSize(X, Y);
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1813 begin
1814   result.r := r;
1815   result.g := g;
1816   result.b := b;
1817   result.a := a;
1818 end;
1819
1820 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1821 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1822 begin
1823   result.r := r;
1824   result.g := g;
1825   result.b := b;
1826   result.a := a;
1827 end;
1828
1829 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1830 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1831 begin
1832   result.r := r;
1833   result.g := g;
1834   result.b := b;
1835   result.a := a;
1836 end;
1837
1838 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1840 var
1841   i: Integer;
1842 begin
1843   result := false;
1844   for i := 0 to high(r1.arr) do
1845     if (r1.arr[i] <> r2.arr[i]) then
1846       exit;
1847   result := true;
1848 end;
1849
1850 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1851 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1852 var
1853   i: Integer;
1854 begin
1855   result := false;
1856   for i := 0 to high(r1.arr) do
1857     if (r1.arr[i] <> r2.arr[i]) then
1858       exit;
1859   result := true;
1860 end;
1861
1862 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1863 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1864 var
1865   desc: TFormatDescriptor;
1866   p, tmp: PByte;
1867   x, y, i: Integer;
1868   md: Pointer;
1869   px: TglBitmapPixelData;
1870 begin
1871   result := nil;
1872   desc := TFormatDescriptor.Get(aFormat);
1873   if (desc.IsCompressed) or (desc.glFormat = 0) then
1874     exit;
1875
1876   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1877   md := desc.CreateMappingData;
1878   try
1879     tmp := p;
1880     desc.PreparePixel(px);
1881     for y := 0 to 4 do
1882       for x := 0 to 4 do begin
1883         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1884         for i := 0 to 3 do begin
1885           if ((y < 3) and (y = i)) or
1886              ((y = 3) and (i < 3)) or
1887              ((y = 4) and (i = 3))
1888           then
1889             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1890           else if ((y < 4) and (i = 3)) or
1891                   ((y = 4) and (i < 3))
1892           then
1893             px.Data.arr[i] := px.Range.arr[i]
1894           else
1895             px.Data.arr[i] := 0; //px.Range.arr[i];
1896         end;
1897         desc.Map(px, tmp, md);
1898       end;
1899   finally
1900     desc.FreeMappingData(md);
1901   end;
1902
1903   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1904 end;
1905
1906 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1907 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1908 begin
1909   result.r := r;
1910   result.g := g;
1911   result.b := b;
1912   result.a := a;
1913 end;
1914
1915 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1916 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1917 begin
1918   result := [];
1919
1920   if (aFormat in [
1921         //8bpp
1922         tfAlpha4ub1, tfAlpha8ub1,
1923         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1924
1925         //16bpp
1926         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1927         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1928         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1929
1930         //24bpp
1931         tfBGR8ub3, tfRGB8ub3,
1932
1933         //32bpp
1934         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1935         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1936   then
1937     result := result + [ ftBMP ];
1938
1939   if (aFormat in [
1940         //8bbp
1941         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1942
1943         //16bbp
1944         tfAlpha16us1, tfLuminance16us1,
1945         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1946         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1947
1948         //24bbp
1949         tfBGR8ub3,
1950
1951         //32bbp
1952         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1953         tfDepth24ui1, tfDepth32ui1])
1954   then
1955     result := result + [ftTGA];
1956
1957   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1958     result := result + [ftDDS];
1959
1960 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1961   if aFormat in [
1962       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1963       tfRGB8ub3, tfRGBA8ui1,
1964       tfBGR8ub3, tfBGRA8ui1] then
1965     result := result + [ftPNG];
1966 {$ENDIF}
1967
1968 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1969   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1970     result := result + [ftJPEG];
1971 {$ENDIF}
1972 end;
1973
1974 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1975 function IsPowerOfTwo(aNumber: Integer): Boolean;
1976 begin
1977   while (aNumber and 1) = 0 do
1978     aNumber := aNumber shr 1;
1979   result := aNumber = 1;
1980 end;
1981
1982 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1983 function GetTopMostBit(aBitSet: QWord): Integer;
1984 begin
1985   result := 0;
1986   while aBitSet > 0 do begin
1987     inc(result);
1988     aBitSet := aBitSet shr 1;
1989   end;
1990 end;
1991
1992 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1993 function CountSetBits(aBitSet: QWord): Integer;
1994 begin
1995   result := 0;
1996   while aBitSet > 0 do begin
1997     if (aBitSet and 1) = 1 then
1998       inc(result);
1999     aBitSet := aBitSet shr 1;
2000   end;
2001 end;
2002
2003 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2004 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2005 begin
2006   result := Trunc(
2007     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2008     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2009     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2010 end;
2011
2012 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2013 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2014 begin
2015   result := Trunc(
2016     DEPTH_WEIGHT_R * aPixel.Data.r +
2017     DEPTH_WEIGHT_G * aPixel.Data.g +
2018     DEPTH_WEIGHT_B * aPixel.Data.b);
2019 end;
2020
2021 {$IFDEF GLB_SDL_IMAGE}
2022 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2023 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2024 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2025 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2026 begin
2027   result := TStream(context^.unknown.data1).Seek(offset, whence);
2028 end;
2029
2030 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2031 begin
2032   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2033 end;
2034
2035 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2036 begin
2037   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2038 end;
2039
2040 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2041 begin
2042   result := 0;
2043 end;
2044
2045 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2046 begin
2047   result := SDL_AllocRW;
2048
2049   if result = nil then
2050     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2051
2052   result^.seek := glBitmapRWseek;
2053   result^.read := glBitmapRWread;
2054   result^.write := glBitmapRWwrite;
2055   result^.close := glBitmapRWclose;
2056   result^.unknown.data1 := Stream;
2057 end;
2058 {$ENDIF}
2059
2060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2061 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2062 begin
2063   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2064 end;
2065
2066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2067 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2068 begin
2069   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2070 end;
2071
2072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2073 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2074 begin
2075   glBitmapDefaultMipmap := aValue;
2076 end;
2077
2078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2079 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2080 begin
2081   glBitmapDefaultFormat := aFormat;
2082 end;
2083
2084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2085 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2086 begin
2087   glBitmapDefaultFilterMin := aMin;
2088   glBitmapDefaultFilterMag := aMag;
2089 end;
2090
2091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2092 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2093 begin
2094   glBitmapDefaultWrapS := S;
2095   glBitmapDefaultWrapT := T;
2096   glBitmapDefaultWrapR := R;
2097 end;
2098
2099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2100 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2101 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2102 begin
2103   glDefaultSwizzle[0] := r;
2104   glDefaultSwizzle[1] := g;
2105   glDefaultSwizzle[2] := b;
2106   glDefaultSwizzle[3] := a;
2107 end;
2108 {$IFEND}
2109
2110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2111 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2112 begin
2113   result := glBitmapDefaultDeleteTextureOnFree;
2114 end;
2115
2116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2117 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2118 begin
2119   result := glBitmapDefaultFreeDataAfterGenTextures;
2120 end;
2121
2122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2123 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2124 begin
2125   result := glBitmapDefaultMipmap;
2126 end;
2127
2128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2129 function glBitmapGetDefaultFormat: TglBitmapFormat;
2130 begin
2131   result := glBitmapDefaultFormat;
2132 end;
2133
2134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2135 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2136 begin
2137   aMin := glBitmapDefaultFilterMin;
2138   aMag := glBitmapDefaultFilterMag;
2139 end;
2140
2141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2142 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2143 begin
2144   S := glBitmapDefaultWrapS;
2145   T := glBitmapDefaultWrapT;
2146   R := glBitmapDefaultWrapR;
2147 end;
2148
2149 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2151 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2152 begin
2153   r := glDefaultSwizzle[0];
2154   g := glDefaultSwizzle[1];
2155   b := glDefaultSwizzle[2];
2156   a := glDefaultSwizzle[3];
2157 end;
2158 {$IFEND}
2159
2160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2161 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2163 function TFormatDescriptor.CreateMappingData: Pointer;
2164 begin
2165   result := nil;
2166 end;
2167
2168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2169 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2170 begin
2171   //DUMMY
2172 end;
2173
2174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2175 function TFormatDescriptor.IsEmpty: Boolean;
2176 begin
2177   result := (fFormat = tfEmpty);
2178 end;
2179
2180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2181 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2182 var
2183   i: Integer;
2184   m: TglBitmapRec4ul;
2185 begin
2186   result := false;
2187   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2188     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2189   m := Mask;
2190   for i := 0 to 3 do
2191     if (aMask.arr[i] <> m.arr[i]) then
2192       exit;
2193   result := true;
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2198 begin
2199   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2200   aPixel.Data   := Range;
2201   aPixel.Format := fFormat;
2202   aPixel.Range  := Range;
2203 end;
2204
2205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2206 constructor TFormatDescriptor.Create;
2207 begin
2208   inherited Create;
2209 end;
2210
2211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2214 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2215 begin
2216   aData^ := aPixel.Data.a;
2217   inc(aData);
2218 end;
2219
2220 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2221 begin
2222   aPixel.Data.r := 0;
2223   aPixel.Data.g := 0;
2224   aPixel.Data.b := 0;
2225   aPixel.Data.a := aData^;
2226   inc(aData);
2227 end;
2228
2229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2230 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2232 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2233 begin
2234   aData^ := LuminanceWeight(aPixel);
2235   inc(aData);
2236 end;
2237
2238 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2239 begin
2240   aPixel.Data.r := aData^;
2241   aPixel.Data.g := aData^;
2242   aPixel.Data.b := aData^;
2243   aPixel.Data.a := 0;
2244   inc(aData);
2245 end;
2246
2247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2248 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2250 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2251 var
2252   i: Integer;
2253 begin
2254   aData^ := 0;
2255   for i := 0 to 3 do
2256     if (Range.arr[i] > 0) then
2257       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2258   inc(aData);
2259 end;
2260
2261 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2262 var
2263   i: Integer;
2264 begin
2265   for i := 0 to 3 do
2266     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2267   inc(aData);
2268 end;
2269
2270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2271 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2273 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2274 begin
2275   inherited Map(aPixel, aData, aMapData);
2276   aData^ := aPixel.Data.a;
2277   inc(aData);
2278 end;
2279
2280 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2281 begin
2282   inherited Unmap(aData, aPixel, aMapData);
2283   aPixel.Data.a := aData^;
2284   inc(aData);
2285 end;
2286
2287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2288 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2290 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2291 begin
2292   aData^ := aPixel.Data.r;
2293   inc(aData);
2294   aData^ := aPixel.Data.g;
2295   inc(aData);
2296   aData^ := aPixel.Data.b;
2297   inc(aData);
2298 end;
2299
2300 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2301 begin
2302   aPixel.Data.r := aData^;
2303   inc(aData);
2304   aPixel.Data.g := aData^;
2305   inc(aData);
2306   aPixel.Data.b := aData^;
2307   inc(aData);
2308   aPixel.Data.a := 0;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2314 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2315 begin
2316   aData^ := aPixel.Data.b;
2317   inc(aData);
2318   aData^ := aPixel.Data.g;
2319   inc(aData);
2320   aData^ := aPixel.Data.r;
2321   inc(aData);
2322 end;
2323
2324 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2325 begin
2326   aPixel.Data.b := aData^;
2327   inc(aData);
2328   aPixel.Data.g := aData^;
2329   inc(aData);
2330   aPixel.Data.r := aData^;
2331   inc(aData);
2332   aPixel.Data.a := 0;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2337 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2338 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2339 begin
2340   inherited Map(aPixel, aData, aMapData);
2341   aData^ := aPixel.Data.a;
2342   inc(aData);
2343 end;
2344
2345 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2346 begin
2347   inherited Unmap(aData, aPixel, aMapData);
2348   aPixel.Data.a := aData^;
2349   inc(aData);
2350 end;
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2355 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2356 begin
2357   inherited Map(aPixel, aData, aMapData);
2358   aData^ := aPixel.Data.a;
2359   inc(aData);
2360 end;
2361
2362 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2363 begin
2364   inherited Unmap(aData, aPixel, aMapData);
2365   aPixel.Data.a := aData^;
2366   inc(aData);
2367 end;
2368
2369 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2372 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2373 begin
2374   PWord(aData)^ := aPixel.Data.a;
2375   inc(aData, 2);
2376 end;
2377
2378 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2379 begin
2380   aPixel.Data.r := 0;
2381   aPixel.Data.g := 0;
2382   aPixel.Data.b := 0;
2383   aPixel.Data.a := PWord(aData)^;
2384   inc(aData, 2);
2385 end;
2386
2387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2388 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2390 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2391 begin
2392   PWord(aData)^ := LuminanceWeight(aPixel);
2393   inc(aData, 2);
2394 end;
2395
2396 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2397 begin
2398   aPixel.Data.r := PWord(aData)^;
2399   aPixel.Data.g := PWord(aData)^;
2400   aPixel.Data.b := PWord(aData)^;
2401   aPixel.Data.a := 0;
2402   inc(aData, 2);
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2408 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2409 var
2410   i: Integer;
2411 begin
2412   PWord(aData)^ := 0;
2413   for i := 0 to 3 do
2414     if (Range.arr[i] > 0) then
2415       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2416   inc(aData, 2);
2417 end;
2418
2419 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2420 var
2421   i: Integer;
2422 begin
2423   for i := 0 to 3 do
2424     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2425   inc(aData, 2);
2426 end;
2427
2428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2429 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2432 begin
2433   PWord(aData)^ := DepthWeight(aPixel);
2434   inc(aData, 2);
2435 end;
2436
2437 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2438 begin
2439   aPixel.Data.r := PWord(aData)^;
2440   aPixel.Data.g := PWord(aData)^;
2441   aPixel.Data.b := PWord(aData)^;
2442   aPixel.Data.a := PWord(aData)^;;
2443   inc(aData, 2);
2444 end;
2445
2446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2447 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2450 begin
2451   inherited Map(aPixel, aData, aMapData);
2452   PWord(aData)^ := aPixel.Data.a;
2453   inc(aData, 2);
2454 end;
2455
2456 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2457 begin
2458   inherited Unmap(aData, aPixel, aMapData);
2459   aPixel.Data.a := PWord(aData)^;
2460   inc(aData, 2);
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2466 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2467 begin
2468   PWord(aData)^ := aPixel.Data.r;
2469   inc(aData, 2);
2470   PWord(aData)^ := aPixel.Data.g;
2471   inc(aData, 2);
2472   PWord(aData)^ := aPixel.Data.b;
2473   inc(aData, 2);
2474 end;
2475
2476 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2477 begin
2478   aPixel.Data.r := PWord(aData)^;
2479   inc(aData, 2);
2480   aPixel.Data.g := PWord(aData)^;
2481   inc(aData, 2);
2482   aPixel.Data.b := PWord(aData)^;
2483   inc(aData, 2);
2484   aPixel.Data.a := 0;
2485 end;
2486
2487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2488 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2491 begin
2492   PWord(aData)^ := aPixel.Data.b;
2493   inc(aData, 2);
2494   PWord(aData)^ := aPixel.Data.g;
2495   inc(aData, 2);
2496   PWord(aData)^ := aPixel.Data.r;
2497   inc(aData, 2);
2498 end;
2499
2500 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2501 begin
2502   aPixel.Data.b := PWord(aData)^;
2503   inc(aData, 2);
2504   aPixel.Data.g := PWord(aData)^;
2505   inc(aData, 2);
2506   aPixel.Data.r := PWord(aData)^;
2507   inc(aData, 2);
2508   aPixel.Data.a := 0;
2509 end;
2510
2511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2512 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2514 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2515 begin
2516   inherited Map(aPixel, aData, aMapData);
2517   PWord(aData)^ := aPixel.Data.a;
2518   inc(aData, 2);
2519 end;
2520
2521 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2522 begin
2523   inherited Unmap(aData, aPixel, aMapData);
2524   aPixel.Data.a := PWord(aData)^;
2525   inc(aData, 2);
2526 end;
2527
2528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2529 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2531 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2532 begin
2533   PWord(aData)^ := aPixel.Data.a;
2534   inc(aData, 2);
2535   inherited Map(aPixel, aData, aMapData);
2536 end;
2537
2538 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2539 begin
2540   aPixel.Data.a := PWord(aData)^;
2541   inc(aData, 2);
2542   inherited Unmap(aData, aPixel, aMapData);
2543 end;
2544
2545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2548 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2549 begin
2550   inherited Map(aPixel, aData, aMapData);
2551   PWord(aData)^ := aPixel.Data.a;
2552   inc(aData, 2);
2553 end;
2554
2555 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2556 begin
2557   inherited Unmap(aData, aPixel, aMapData);
2558   aPixel.Data.a := PWord(aData)^;
2559   inc(aData, 2);
2560 end;
2561
2562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2563 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2565 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2566 begin
2567   PWord(aData)^ := aPixel.Data.a;
2568   inc(aData, 2);
2569   inherited Map(aPixel, aData, aMapData);
2570 end;
2571
2572 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2573 begin
2574   aPixel.Data.a := PWord(aData)^;
2575   inc(aData, 2);
2576   inherited Unmap(aData, aPixel, aMapData);
2577 end;
2578
2579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2582 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2583 var
2584   i: Integer;
2585 begin
2586   PCardinal(aData)^ := 0;
2587   for i := 0 to 3 do
2588     if (Range.arr[i] > 0) then
2589       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2590   inc(aData, 4);
2591 end;
2592
2593 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 var
2595   i: Integer;
2596 begin
2597   for i := 0 to 3 do
2598     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2599   inc(aData, 2);
2600 end;
2601
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2606 begin
2607   PCardinal(aData)^ := DepthWeight(aPixel);
2608   inc(aData, 4);
2609 end;
2610
2611 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2612 begin
2613   aPixel.Data.r := PCardinal(aData)^;
2614   aPixel.Data.g := PCardinal(aData)^;
2615   aPixel.Data.b := PCardinal(aData)^;
2616   aPixel.Data.a := PCardinal(aData)^;
2617   inc(aData, 4);
2618 end;
2619
2620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 procedure TfdAlpha4ub1.SetValues;
2624 begin
2625   inherited SetValues;
2626   fBitsPerPixel     := 8;
2627   fFormat           := tfAlpha4ub1;
2628   fWithAlpha        := tfAlpha4ub1;
2629   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2630   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2631 {$IFNDEF OPENGL_ES}
2632   fOpenGLFormat     := tfAlpha4ub1;
2633   fglFormat         := GL_ALPHA;
2634   fglInternalFormat := GL_ALPHA4;
2635   fglDataFormat     := GL_UNSIGNED_BYTE;
2636 {$ELSE}
2637   fOpenGLFormat     := tfAlpha8ub1;
2638 {$ENDIF}
2639 end;
2640
2641 procedure TfdAlpha8ub1.SetValues;
2642 begin
2643   inherited SetValues;
2644   fBitsPerPixel     := 8;
2645   fFormat           := tfAlpha8ub1;
2646   fWithAlpha        := tfAlpha8ub1;
2647   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2648   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2649   fOpenGLFormat     := tfAlpha8ub1;
2650   fglFormat         := GL_ALPHA;
2651   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2652   fglDataFormat     := GL_UNSIGNED_BYTE;
2653 end;
2654
2655 procedure TfdAlpha16us1.SetValues;
2656 begin
2657   inherited SetValues;
2658   fBitsPerPixel     := 16;
2659   fFormat           := tfAlpha16us1;
2660   fWithAlpha        := tfAlpha16us1;
2661   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2662   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2663 {$IFNDEF OPENGL_ES}
2664   fOpenGLFormat     := tfAlpha16us1;
2665   fglFormat         := GL_ALPHA;
2666   fglInternalFormat := GL_ALPHA16;
2667   fglDataFormat     := GL_UNSIGNED_SHORT;
2668 {$ELSE}
2669   fOpenGLFormat     := tfAlpha8ub1;
2670 {$ENDIF}
2671 end;
2672
2673 procedure TfdLuminance4ub1.SetValues;
2674 begin
2675   inherited SetValues;
2676   fBitsPerPixel     := 8;
2677   fFormat           := tfLuminance4ub1;
2678   fWithAlpha        := tfLuminance4Alpha4ub2;
2679   fWithoutAlpha     := tfLuminance4ub1;
2680   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2681   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2682 {$IFNDEF OPENGL_ES}
2683   fOpenGLFormat     := tfLuminance4ub1;
2684   fglFormat         := GL_LUMINANCE;
2685   fglInternalFormat := GL_LUMINANCE4;
2686   fglDataFormat     := GL_UNSIGNED_BYTE;
2687 {$ELSE}
2688   fOpenGLFormat     := tfLuminance8ub1;
2689 {$ENDIF}
2690 end;
2691
2692 procedure TfdLuminance8ub1.SetValues;
2693 begin
2694   inherited SetValues;
2695   fBitsPerPixel     := 8;
2696   fFormat           := tfLuminance8ub1;
2697   fWithAlpha        := tfLuminance8Alpha8ub2;
2698   fWithoutAlpha     := tfLuminance8ub1;
2699   fOpenGLFormat     := tfLuminance8ub1;
2700   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2701   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2702   fglFormat         := GL_LUMINANCE;
2703   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2704   fglDataFormat     := GL_UNSIGNED_BYTE;
2705 end;
2706
2707 procedure TfdLuminance16us1.SetValues;
2708 begin
2709   inherited SetValues;
2710   fBitsPerPixel     := 16;
2711   fFormat           := tfLuminance16us1;
2712   fWithAlpha        := tfLuminance16Alpha16us2;
2713   fWithoutAlpha     := tfLuminance16us1;
2714   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2715   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2716 {$IFNDEF OPENGL_ES}
2717   fOpenGLFormat     := tfLuminance16us1;
2718   fglFormat         := GL_LUMINANCE;
2719   fglInternalFormat := GL_LUMINANCE16;
2720   fglDataFormat     := GL_UNSIGNED_SHORT;
2721 {$ELSE}
2722   fOpenGLFormat     := tfLuminance8ub1;
2723 {$ENDIF}
2724 end;
2725
2726 procedure TfdLuminance4Alpha4ub2.SetValues;
2727 begin
2728   inherited SetValues;
2729   fBitsPerPixel     := 16;
2730   fFormat           := tfLuminance4Alpha4ub2;
2731   fWithAlpha        := tfLuminance4Alpha4ub2;
2732   fWithoutAlpha     := tfLuminance4ub1;
2733   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2734   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2735 {$IFNDEF OPENGL_ES}
2736   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2737   fglFormat         := GL_LUMINANCE_ALPHA;
2738   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2739   fglDataFormat     := GL_UNSIGNED_BYTE;
2740 {$ELSE}
2741   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2742 {$ENDIF}
2743 end;
2744
2745 procedure TfdLuminance6Alpha2ub2.SetValues;
2746 begin
2747   inherited SetValues;
2748   fBitsPerPixel     := 16;
2749   fFormat           := tfLuminance6Alpha2ub2;
2750   fWithAlpha        := tfLuminance6Alpha2ub2;
2751   fWithoutAlpha     := tfLuminance8ub1;
2752   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2753   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2754 {$IFNDEF OPENGL_ES}
2755   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2756   fglFormat         := GL_LUMINANCE_ALPHA;
2757   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2758   fglDataFormat     := GL_UNSIGNED_BYTE;
2759 {$ELSE}
2760   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2761 {$ENDIF}
2762 end;
2763
2764 procedure TfdLuminance8Alpha8ub2.SetValues;
2765 begin
2766   inherited SetValues;
2767   fBitsPerPixel     := 16;
2768   fFormat           := tfLuminance8Alpha8ub2;
2769   fWithAlpha        := tfLuminance8Alpha8ub2;
2770   fWithoutAlpha     := tfLuminance8ub1;
2771   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2772   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2773   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2774   fglFormat         := GL_LUMINANCE_ALPHA;
2775   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2776   fglDataFormat     := GL_UNSIGNED_BYTE;
2777 end;
2778
2779 procedure TfdLuminance12Alpha4us2.SetValues;
2780 begin
2781   inherited SetValues;
2782   fBitsPerPixel     := 32;
2783   fFormat           := tfLuminance12Alpha4us2;
2784   fWithAlpha        := tfLuminance12Alpha4us2;
2785   fWithoutAlpha     := tfLuminance16us1;
2786   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2787   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2788 {$IFNDEF OPENGL_ES}
2789   fOpenGLFormat     := tfLuminance12Alpha4us2;
2790   fglFormat         := GL_LUMINANCE_ALPHA;
2791   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2792   fglDataFormat     := GL_UNSIGNED_SHORT;
2793 {$ELSE}
2794   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2795 {$ENDIF}
2796 end;
2797
2798 procedure TfdLuminance16Alpha16us2.SetValues;
2799 begin
2800   inherited SetValues;
2801   fBitsPerPixel     := 32;
2802   fFormat           := tfLuminance16Alpha16us2;
2803   fWithAlpha        := tfLuminance16Alpha16us2;
2804   fWithoutAlpha     := tfLuminance16us1;
2805   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2806   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2807 {$IFNDEF OPENGL_ES}
2808   fOpenGLFormat     := tfLuminance16Alpha16us2;
2809   fglFormat         := GL_LUMINANCE_ALPHA;
2810   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2811   fglDataFormat     := GL_UNSIGNED_SHORT;
2812 {$ELSE}
2813   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2814 {$ENDIF}
2815 end;
2816
2817 procedure TfdR3G3B2ub1.SetValues;
2818 begin
2819   inherited SetValues;
2820   fBitsPerPixel     := 8;
2821   fFormat           := tfR3G3B2ub1;
2822   fWithAlpha        := tfRGBA4us1;
2823   fWithoutAlpha     := tfR3G3B2ub1;
2824   fRGBInverted      := tfEmpty;
2825   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2826   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2827 {$IFNDEF OPENGL_ES}
2828   fOpenGLFormat     := tfR3G3B2ub1;
2829   fglFormat         := GL_RGB;
2830   fglInternalFormat := GL_R3_G3_B2;
2831   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2832 {$ELSE}
2833   fOpenGLFormat     := tfR5G6B5us1;
2834 {$ENDIF}
2835 end;
2836
2837 procedure TfdRGBX4us1.SetValues;
2838 begin
2839   inherited SetValues;
2840   fBitsPerPixel     := 16;
2841   fFormat           := tfRGBX4us1;
2842   fWithAlpha        := tfRGBA4us1;
2843   fWithoutAlpha     := tfRGBX4us1;
2844   fRGBInverted      := tfBGRX4us1;
2845   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2846   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2847 {$IFNDEF OPENGL_ES}
2848   fOpenGLFormat     := tfRGBX4us1;
2849   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2850   fglInternalFormat := GL_RGB4;
2851   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2852 {$ELSE}
2853   fOpenGLFormat     := tfR5G6B5us1;
2854 {$ENDIF}
2855 end;
2856
2857 procedure TfdXRGB4us1.SetValues;
2858 begin
2859   inherited SetValues;
2860   fBitsPerPixel     := 16;
2861   fFormat           := tfXRGB4us1;
2862   fWithAlpha        := tfARGB4us1;
2863   fWithoutAlpha     := tfXRGB4us1;
2864   fRGBInverted      := tfXBGR4us1;
2865   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2866   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2867 {$IFNDEF OPENGL_ES}
2868   fOpenGLFormat     := tfXRGB4us1;
2869   fglFormat         := GL_BGRA;
2870   fglInternalFormat := GL_RGB4;
2871   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2872 {$ELSE}
2873   fOpenGLFormat     := tfR5G6B5us1;
2874 {$ENDIF}
2875 end;
2876
2877 procedure TfdR5G6B5us1.SetValues;
2878 begin
2879   inherited SetValues;
2880   fBitsPerPixel     := 16;
2881   fFormat           := tfR5G6B5us1;
2882   fWithAlpha        := tfRGB5A1us1;
2883   fWithoutAlpha     := tfR5G6B5us1;
2884   fRGBInverted      := tfB5G6R5us1;
2885   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2886   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2887 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2888   fOpenGLFormat     := tfR5G6B5us1;
2889   fglFormat         := GL_RGB;
2890   fglInternalFormat := GL_RGB565;
2891   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2892 {$ELSE}
2893   fOpenGLFormat     := tfRGB8ub3;
2894 {$IFEND}
2895 end;
2896
2897 procedure TfdRGB5X1us1.SetValues;
2898 begin
2899   inherited SetValues;
2900   fBitsPerPixel     := 16;
2901   fFormat           := tfRGB5X1us1;
2902   fWithAlpha        := tfRGB5A1us1;
2903   fWithoutAlpha     := tfRGB5X1us1;
2904   fRGBInverted      := tfBGR5X1us1;
2905   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2906   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2907 {$IFNDEF OPENGL_ES}
2908   fOpenGLFormat     := tfRGB5X1us1;
2909   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2910   fglInternalFormat := GL_RGB5;
2911   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2912 {$ELSE}
2913   fOpenGLFormat     := tfR5G6B5us1;
2914 {$ENDIF}
2915 end;
2916
2917 procedure TfdX1RGB5us1.SetValues;
2918 begin
2919   inherited SetValues;
2920   fBitsPerPixel     := 16;
2921   fFormat           := tfX1RGB5us1;
2922   fWithAlpha        := tfA1RGB5us1;
2923   fWithoutAlpha     := tfX1RGB5us1;
2924   fRGBInverted      := tfX1BGR5us1;
2925   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2926   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2927 {$IFNDEF OPENGL_ES}
2928   fOpenGLFormat     := tfX1RGB5us1;
2929   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2930   fglInternalFormat := GL_RGB5;
2931   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2932 {$ELSE}
2933   fOpenGLFormat     := tfR5G6B5us1;
2934 {$ENDIF}
2935 end;
2936
2937 procedure TfdRGB8ub3.SetValues;
2938 begin
2939   inherited SetValues;
2940   fBitsPerPixel     := 24;
2941   fFormat           := tfRGB8ub3;
2942   fWithAlpha        := tfRGBA8ub4;
2943   fWithoutAlpha     := tfRGB8ub3;
2944   fRGBInverted      := tfBGR8ub3;
2945   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2946   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2947   fOpenGLFormat     := tfRGB8ub3;
2948   fglFormat         := GL_RGB;
2949   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2950   fglDataFormat     := GL_UNSIGNED_BYTE;
2951 end;
2952
2953 procedure TfdRGBX8ui1.SetValues;
2954 begin
2955   inherited SetValues;
2956   fBitsPerPixel     := 32;
2957   fFormat           := tfRGBX8ui1;
2958   fWithAlpha        := tfRGBA8ui1;
2959   fWithoutAlpha     := tfRGBX8ui1;
2960   fRGBInverted      := tfBGRX8ui1;
2961   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2962   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2963 {$IFNDEF OPENGL_ES}
2964   fOpenGLFormat     := tfRGBX8ui1;
2965   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2966   fglInternalFormat := GL_RGB8;
2967   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2968 {$ELSE}
2969   fOpenGLFormat     := tfRGB8ub3;
2970 {$ENDIF}
2971 end;
2972
2973 procedure TfdXRGB8ui1.SetValues;
2974 begin
2975   inherited SetValues;
2976   fBitsPerPixel     := 32;
2977   fFormat           := tfXRGB8ui1;
2978   fWithAlpha        := tfXRGB8ui1;
2979   fWithoutAlpha     := tfXRGB8ui1;
2980   fOpenGLFormat     := tfXRGB8ui1;
2981   fRGBInverted      := tfXBGR8ui1;
2982   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2983   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2984 {$IFNDEF OPENGL_ES}
2985   fOpenGLFormat     := tfXRGB8ui1;
2986   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2987   fglInternalFormat := GL_RGB8;
2988   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2989 {$ELSE}
2990   fOpenGLFormat     := tfRGB8ub3;
2991 {$ENDIF}
2992 end;
2993
2994 procedure TfdRGB10X2ui1.SetValues;
2995 begin
2996   inherited SetValues;
2997   fBitsPerPixel     := 32;
2998   fFormat           := tfRGB10X2ui1;
2999   fWithAlpha        := tfRGB10A2ui1;
3000   fWithoutAlpha     := tfRGB10X2ui1;
3001   fRGBInverted      := tfBGR10X2ui1;
3002   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3003   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3004 {$IFNDEF OPENGL_ES}
3005   fOpenGLFormat     := tfRGB10X2ui1;
3006   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3007   fglInternalFormat := GL_RGB10;
3008   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3009 {$ELSE}
3010   fOpenGLFormat     := tfRGB16us3;
3011 {$ENDIF}
3012 end;
3013
3014 procedure TfdX2RGB10ui1.SetValues;
3015 begin
3016   inherited SetValues;
3017   fBitsPerPixel     := 32;
3018   fFormat           := tfX2RGB10ui1;
3019   fWithAlpha        := tfA2RGB10ui1;
3020   fWithoutAlpha     := tfX2RGB10ui1;
3021   fRGBInverted      := tfX2BGR10ui1;
3022   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3023   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3024 {$IFNDEF OPENGL_ES}
3025   fOpenGLFormat     := tfX2RGB10ui1;
3026   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3027   fglInternalFormat := GL_RGB10;
3028   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3029 {$ELSE}
3030   fOpenGLFormat     := tfRGB16us3;
3031 {$ENDIF}
3032 end;
3033
3034 procedure TfdRGB16us3.SetValues;
3035 begin
3036   inherited SetValues;
3037   fBitsPerPixel     := 48;
3038   fFormat           := tfRGB16us3;
3039   fWithAlpha        := tfRGBA16us4;
3040   fWithoutAlpha     := tfRGB16us3;
3041   fRGBInverted      := tfBGR16us3;
3042   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3043   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3044 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3045   fOpenGLFormat     := tfRGB16us3;
3046   fglFormat         := GL_RGB;
3047   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3048   fglDataFormat     := GL_UNSIGNED_SHORT;
3049 {$ELSE}
3050   fOpenGLFormat     := tfRGB8ub3;
3051 {$IFEND}
3052 end;
3053
3054 procedure TfdRGBA4us1.SetValues;
3055 begin
3056   inherited SetValues;
3057   fBitsPerPixel     := 16;
3058   fFormat           := tfRGBA4us1;
3059   fWithAlpha        := tfRGBA4us1;
3060   fWithoutAlpha     := tfRGBX4us1;
3061   fOpenGLFormat     := tfRGBA4us1;
3062   fRGBInverted      := tfBGRA4us1;
3063   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3064   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3065   fglFormat         := GL_RGBA;
3066   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA4{$ELSE}GL_RGBA{$IFEND};
3067   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3068 end;
3069
3070 procedure TfdARGB4us1.SetValues;
3071 begin
3072   inherited SetValues;
3073   fBitsPerPixel     := 16;
3074   fFormat           := tfARGB4us1;
3075   fWithAlpha        := tfARGB4us1;
3076   fWithoutAlpha     := tfXRGB4us1;
3077   fRGBInverted      := tfABGR4us1;
3078   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3079   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3080 {$IFNDEF OPENGL_ES}
3081   fOpenGLFormat     := tfARGB4us1;
3082   fglFormat         := GL_BGRA;
3083   fglInternalFormat := GL_RGBA4;
3084   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3085 {$ELSE}
3086   fOpenGLFormat     := tfRGBA4us1;
3087 {$ENDIF}
3088 end;
3089
3090 procedure TfdRGB5A1us1.SetValues;
3091 begin
3092   inherited SetValues;
3093   fBitsPerPixel     := 16;
3094   fFormat           := tfRGB5A1us1;
3095   fWithAlpha        := tfRGB5A1us1;
3096   fWithoutAlpha     := tfRGB5X1us1;
3097   fOpenGLFormat     := tfRGB5A1us1;
3098   fRGBInverted      := tfBGR5A1us1;
3099   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3100   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3101   fglFormat         := GL_RGBA;
3102   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3103   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3104 end;
3105
3106 procedure TfdA1RGB5us1.SetValues;
3107 begin
3108   inherited SetValues;
3109   fBitsPerPixel     := 16;
3110   fFormat           := tfA1RGB5us1;
3111   fWithAlpha        := tfA1RGB5us1;
3112   fWithoutAlpha     := tfX1RGB5us1;
3113   fRGBInverted      := tfA1BGR5us1;
3114   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3115   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3116 {$IFNDEF OPENGL_ES}
3117   fOpenGLFormat     := tfA1RGB5us1;
3118   fglFormat         := GL_BGRA;
3119   fglInternalFormat := GL_RGB5_A1;
3120   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3121 {$ELSE}
3122   fOpenGLFormat     := tfRGB5A1us1;
3123 {$ENDIF}
3124 end;
3125
3126 procedure TfdRGBA8ui1.SetValues;
3127 begin
3128   inherited SetValues;
3129   fBitsPerPixel     := 32;
3130   fFormat           := tfRGBA8ui1;
3131   fWithAlpha        := tfRGBA8ui1;
3132   fWithoutAlpha     := tfRGBX8ui1;
3133   fRGBInverted      := tfBGRA8ui1;
3134   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3135   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3136 {$IFNDEF OPENGL_ES}
3137   fOpenGLFormat     := tfRGBA8ui1;
3138   fglFormat         := GL_RGBA;
3139   fglInternalFormat := GL_RGBA8;
3140   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3141 {$ELSE}
3142   fOpenGLFormat     := tfRGBA8ub4;
3143 {$ENDIF}
3144 end;
3145
3146 procedure TfdARGB8ui1.SetValues;
3147 begin
3148   inherited SetValues;
3149   fBitsPerPixel     := 32;
3150   fFormat           := tfARGB8ui1;
3151   fWithAlpha        := tfARGB8ui1;
3152   fWithoutAlpha     := tfXRGB8ui1;
3153   fRGBInverted      := tfABGR8ui1;
3154   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3155   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3156 {$IFNDEF OPENGL_ES}
3157   fOpenGLFormat     := tfARGB8ui1;
3158   fglFormat         := GL_BGRA;
3159   fglInternalFormat := GL_RGBA8;
3160   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3161 {$ELSE}
3162   fOpenGLFormat     := tfRGBA8ub4;
3163 {$ENDIF}
3164 end;
3165
3166 procedure TfdRGBA8ub4.SetValues;
3167 begin
3168   inherited SetValues;
3169   fBitsPerPixel     := 32;
3170   fFormat           := tfRGBA8ub4;
3171   fWithAlpha        := tfRGBA8ub4;
3172   fWithoutAlpha     := tfRGB8ub3;
3173   fOpenGLFormat     := tfRGBA8ub4;
3174   fRGBInverted      := tfBGRA8ub4;
3175   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3176   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3177   fglFormat         := GL_RGBA;
3178   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3179   fglDataFormat     := GL_UNSIGNED_BYTE;
3180 end;
3181
3182 procedure TfdRGB10A2ui1.SetValues;
3183 begin
3184   inherited SetValues;
3185   fBitsPerPixel     := 32;
3186   fFormat           := tfRGB10A2ui1;
3187   fWithAlpha        := tfRGB10A2ui1;
3188   fWithoutAlpha     := tfRGB10X2ui1;
3189   fRGBInverted      := tfBGR10A2ui1;
3190   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3191   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3192 {$IFNDEF OPENGL_ES}
3193   fOpenGLFormat     := tfRGB10A2ui1;
3194   fglFormat         := GL_RGBA;
3195   fglInternalFormat := GL_RGB10_A2;
3196   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3197 {$ELSE}
3198   fOpenGLFormat     := tfA2RGB10ui1;
3199 {$ENDIF}
3200 end;
3201
3202 procedure TfdA2RGB10ui1.SetValues;
3203 begin
3204   inherited SetValues;
3205   fBitsPerPixel     := 32;
3206   fFormat           := tfA2RGB10ui1;
3207   fWithAlpha        := tfA2RGB10ui1;
3208   fWithoutAlpha     := tfX2RGB10ui1;
3209   fRGBInverted      := tfA2BGR10ui1;
3210   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3211   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3212 {$IF NOT DEFINED(OPENGL_ES)}
3213   fOpenGLFormat     := tfA2RGB10ui1;
3214   fglFormat         := GL_BGRA;
3215   fglInternalFormat := GL_RGB10_A2;
3216   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3217 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3218   fOpenGLFormat     := tfA2RGB10ui1;
3219   fglFormat         := GL_RGBA;
3220   fglInternalFormat := GL_RGB10_A2;
3221   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3222 {$ELSE}
3223   fOpenGLFormat     := tfRGBA8ui1;
3224 {$IFEND}
3225 end;
3226
3227 procedure TfdRGBA16us4.SetValues;
3228 begin
3229   inherited SetValues;
3230   fBitsPerPixel     := 64;
3231   fFormat           := tfRGBA16us4;
3232   fWithAlpha        := tfRGBA16us4;
3233   fWithoutAlpha     := tfRGB16us3;
3234   fRGBInverted      := tfBGRA16us4;
3235   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3236   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3237 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3238   fOpenGLFormat     := tfRGBA16us4;
3239   fglFormat         := GL_RGBA;
3240   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3241   fglDataFormat     := GL_UNSIGNED_SHORT;
3242 {$ELSE}
3243   fOpenGLFormat     := tfRGBA8ub4;
3244 {$IFEND}
3245 end;
3246
3247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3249 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3250 procedure TfdBGRX4us1.SetValues;
3251 begin
3252   inherited SetValues;
3253   fBitsPerPixel     := 16;
3254   fFormat           := tfBGRX4us1;
3255   fWithAlpha        := tfBGRA4us1;
3256   fWithoutAlpha     := tfBGRX4us1;
3257   fRGBInverted      := tfRGBX4us1;
3258   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3259   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3260 {$IFNDEF OPENGL_ES}
3261   fOpenGLFormat     := tfBGRX4us1;
3262   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3263   fglInternalFormat := GL_RGB4;
3264   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3265 {$ELSE}
3266   fOpenGLFormat     := tfR5G6B5us1;
3267 {$ENDIF}
3268 end;
3269
3270 procedure TfdXBGR4us1.SetValues;
3271 begin
3272   inherited SetValues;
3273   fBitsPerPixel     := 16;
3274   fFormat           := tfXBGR4us1;
3275   fWithAlpha        := tfABGR4us1;
3276   fWithoutAlpha     := tfXBGR4us1;
3277   fRGBInverted      := tfXRGB4us1;
3278   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3279   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3280 {$IFNDEF OPENGL_ES}
3281   fOpenGLFormat     := tfXBGR4us1;
3282   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3283   fglInternalFormat := GL_RGB4;
3284   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3285 {$ELSE}
3286   fOpenGLFormat     := tfR5G6B5us1;
3287 {$ENDIF}
3288 end;
3289
3290 procedure TfdB5G6R5us1.SetValues;
3291 begin
3292   inherited SetValues;
3293   fBitsPerPixel     := 16;
3294   fFormat           := tfB5G6R5us1;
3295   fWithAlpha        := tfBGR5A1us1;
3296   fWithoutAlpha     := tfB5G6R5us1;
3297   fRGBInverted      := tfR5G6B5us1;
3298   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3299   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3300 {$IFNDEF OPENGL_ES}
3301   fOpenGLFormat     := tfB5G6R5us1;
3302   fglFormat         := GL_RGB;
3303   fglInternalFormat := GL_RGB565;
3304   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3305 {$ELSE}
3306   fOpenGLFormat     := tfR5G6B5us1;
3307 {$ENDIF}
3308 end;
3309
3310 procedure TfdBGR5X1us1.SetValues;
3311 begin
3312   inherited SetValues;
3313   fBitsPerPixel     := 16;
3314   fFormat           := tfBGR5X1us1;
3315   fWithAlpha        := tfBGR5A1us1;
3316   fWithoutAlpha     := tfBGR5X1us1;
3317   fRGBInverted      := tfRGB5X1us1;
3318   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3319   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3320 {$IFNDEF OPENGL_ES}
3321   fOpenGLFormat     := tfBGR5X1us1;
3322   fglFormat         := GL_BGRA;
3323   fglInternalFormat := GL_RGB5;
3324   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3325 {$ELSE}
3326   fOpenGLFormat     := tfR5G6B5us1;
3327 {$ENDIF}
3328 end;
3329
3330 procedure TfdX1BGR5us1.SetValues;
3331 begin
3332   inherited SetValues;
3333   fBitsPerPixel     := 16;
3334   fFormat           := tfX1BGR5us1;
3335   fWithAlpha        := tfA1BGR5us1;
3336   fWithoutAlpha     := tfX1BGR5us1;
3337   fRGBInverted      := tfX1RGB5us1;
3338   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3339   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3340 {$IFNDEF OPENGL_ES}
3341   fOpenGLFormat     := tfX1BGR5us1;
3342   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3343   fglInternalFormat := GL_RGB5;
3344   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3345 {$ELSE}
3346   fOpenGLFormat     := tfR5G6B5us1;
3347 {$ENDIF}
3348 end;
3349
3350 procedure TfdBGR8ub3.SetValues;
3351 begin
3352   inherited SetValues;
3353   fBitsPerPixel     := 24;
3354   fFormat           := tfBGR8ub3;
3355   fWithAlpha        := tfBGRA8ub4;
3356   fWithoutAlpha     := tfBGR8ub3;
3357   fRGBInverted      := tfRGB8ub3;
3358   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3359   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3360 {$IFNDEF OPENGL_ES}
3361   fOpenGLFormat     := tfBGR8ub3;
3362   fglFormat         := GL_BGR;
3363   fglInternalFormat := GL_RGB8;
3364   fglDataFormat     := GL_UNSIGNED_BYTE;
3365 {$ELSE}
3366   fOpenGLFormat     := tfRGB8ub3;
3367 {$ENDIF}
3368 end;
3369
3370 procedure TfdBGRX8ui1.SetValues;
3371 begin
3372   inherited SetValues;
3373   fBitsPerPixel     := 32;
3374   fFormat           := tfBGRX8ui1;
3375   fWithAlpha        := tfBGRA8ui1;
3376   fWithoutAlpha     := tfBGRX8ui1;
3377   fRGBInverted      := tfRGBX8ui1;
3378   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3379   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3380 {$IFNDEF OPENGL_ES}
3381   fOpenGLFormat     := tfBGRX8ui1;
3382   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3383   fglInternalFormat := GL_RGB8;
3384   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3385 {$ELSE}
3386   fOpenGLFormat     := tfRGB8ub3;
3387 {$ENDIF}
3388 end;
3389
3390 procedure TfdXBGR8ui1.SetValues;
3391 begin
3392   inherited SetValues;
3393   fBitsPerPixel     := 32;
3394   fFormat           := tfXBGR8ui1;
3395   fWithAlpha        := tfABGR8ui1;
3396   fWithoutAlpha     := tfXBGR8ui1;
3397   fRGBInverted      := tfXRGB8ui1;
3398   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3399   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3400 {$IFNDEF OPENGL_ES}
3401   fOpenGLFormat     := tfXBGR8ui1;
3402   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3403   fglInternalFormat := GL_RGB8;
3404   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3405 {$ELSE}
3406   fOpenGLFormat     := tfRGB8ub3;
3407 {$ENDIF}
3408 end;
3409
3410 procedure TfdBGR10X2ui1.SetValues;
3411 begin
3412   inherited SetValues;
3413   fBitsPerPixel     := 32;
3414   fFormat           := tfBGR10X2ui1;
3415   fWithAlpha        := tfBGR10A2ui1;
3416   fWithoutAlpha     := tfBGR10X2ui1;
3417   fRGBInverted      := tfRGB10X2ui1;
3418   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3419   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3420 {$IFNDEF OPENGL_ES}
3421   fOpenGLFormat     := tfBGR10X2ui1;
3422   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3423   fglInternalFormat := GL_RGB10;
3424   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3425 {$ELSE}
3426   fOpenGLFormat     := tfRGB16us3;
3427 {$ENDIF}
3428 end;
3429
3430 procedure TfdX2BGR10ui1.SetValues;
3431 begin
3432   inherited SetValues;
3433   fBitsPerPixel     := 32;
3434   fFormat           := tfX2BGR10ui1;
3435   fWithAlpha        := tfA2BGR10ui1;
3436   fWithoutAlpha     := tfX2BGR10ui1;
3437   fRGBInverted      := tfX2RGB10ui1;
3438   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3439   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3440 {$IFNDEF OPENGL_ES}
3441   fOpenGLFormat     := tfX2BGR10ui1;
3442   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3443   fglInternalFormat := GL_RGB10;
3444   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3445 {$ELSE}
3446   fOpenGLFormat     := tfRGB16us3;
3447 {$ENDIF}
3448 end;
3449
3450 procedure TfdBGR16us3.SetValues;
3451 begin
3452   inherited SetValues;
3453   fBitsPerPixel     := 48;
3454   fFormat           := tfBGR16us3;
3455   fWithAlpha        := tfBGRA16us4;
3456   fWithoutAlpha     := tfBGR16us3;
3457   fRGBInverted      := tfRGB16us3;
3458   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3459   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3460 {$IFNDEF OPENGL_ES}
3461   fOpenGLFormat     := tfBGR16us3;
3462   fglFormat         := GL_BGR;
3463   fglInternalFormat := GL_RGB16;
3464   fglDataFormat     := GL_UNSIGNED_SHORT;
3465 {$ELSE}
3466   fOpenGLFormat     := tfRGB16us3;
3467 {$ENDIF}
3468 end;
3469
3470 procedure TfdBGRA4us1.SetValues;
3471 begin
3472   inherited SetValues;
3473   fBitsPerPixel     := 16;
3474   fFormat           := tfBGRA4us1;
3475   fWithAlpha        := tfBGRA4us1;
3476   fWithoutAlpha     := tfBGRX4us1;
3477   fRGBInverted      := tfRGBA4us1;
3478   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3479   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3480 {$IFNDEF OPENGL_ES}
3481   fOpenGLFormat     := tfBGRA4us1;
3482   fglFormat         := GL_BGRA;
3483   fglInternalFormat := GL_RGBA4;
3484   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3485 {$ELSE}
3486   fOpenGLFormat     := tfRGBA4us1;
3487 {$ENDIF}
3488 end;
3489
3490 procedure TfdABGR4us1.SetValues;
3491 begin
3492   inherited SetValues;
3493   fBitsPerPixel     := 16;
3494   fFormat           := tfABGR4us1;
3495   fWithAlpha        := tfABGR4us1;
3496   fWithoutAlpha     := tfXBGR4us1;
3497   fRGBInverted      := tfARGB4us1;
3498   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3499   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3500 {$IFNDEF OPENGL_ES}
3501   fOpenGLFormat     := tfABGR4us1;
3502   fglFormat         := GL_RGBA;
3503   fglInternalFormat := GL_RGBA4;
3504   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3505 {$ELSE}
3506   fOpenGLFormat     := tfRGBA4us1;
3507 {$ENDIF}
3508 end;
3509
3510 procedure TfdBGR5A1us1.SetValues;
3511 begin
3512   inherited SetValues;
3513   fBitsPerPixel     := 16;
3514   fFormat           := tfBGR5A1us1;
3515   fWithAlpha        := tfBGR5A1us1;
3516   fWithoutAlpha     := tfBGR5X1us1;
3517   fRGBInverted      := tfRGB5A1us1;
3518   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3519   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3520 {$IFNDEF OPENGL_ES}
3521   fOpenGLFormat     := tfBGR5A1us1;
3522   fglFormat         := GL_BGRA;
3523   fglInternalFormat := GL_RGB5_A1;
3524   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3525 {$ELSE}
3526   fOpenGLFormat     := tfRGB5A1us1;
3527 {$ENDIF}
3528 end;
3529
3530 procedure TfdA1BGR5us1.SetValues;
3531 begin
3532   inherited SetValues;
3533   fBitsPerPixel     := 16;
3534   fFormat           := tfA1BGR5us1;
3535   fWithAlpha        := tfA1BGR5us1;
3536   fWithoutAlpha     := tfX1BGR5us1;
3537   fRGBInverted      := tfA1RGB5us1;
3538   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3539   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3540 {$IFNDEF OPENGL_ES}
3541   fOpenGLFormat     := tfA1BGR5us1;
3542   fglFormat         := GL_RGBA;
3543   fglInternalFormat := GL_RGB5_A1;
3544   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3545 {$ELSE}
3546   fOpenGLFormat     := tfRGB5A1us1;
3547 {$ENDIF}
3548 end;
3549
3550 procedure TfdBGRA8ui1.SetValues;
3551 begin
3552   inherited SetValues;
3553   fBitsPerPixel     := 32;
3554   fFormat           := tfBGRA8ui1;
3555   fWithAlpha        := tfBGRA8ui1;
3556   fWithoutAlpha     := tfBGRX8ui1;
3557   fRGBInverted      := tfRGBA8ui1;
3558   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3559   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3560 {$IFNDEF OPENGL_ES}
3561   fOpenGLFormat     := tfBGRA8ui1;
3562   fglFormat         := GL_BGRA;
3563   fglInternalFormat := GL_RGBA8;
3564   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3565 {$ELSE}
3566   fOpenGLFormat     := tfRGBA8ub4;
3567 {$ENDIF}
3568 end;
3569
3570 procedure TfdABGR8ui1.SetValues;
3571 begin
3572   inherited SetValues;
3573   fBitsPerPixel     := 32;
3574   fFormat           := tfABGR8ui1;
3575   fWithAlpha        := tfABGR8ui1;
3576   fWithoutAlpha     := tfXBGR8ui1;
3577   fRGBInverted      := tfARGB8ui1;
3578   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3579   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3580 {$IFNDEF OPENGL_ES}
3581   fOpenGLFormat     := tfABGR8ui1;
3582   fglFormat         := GL_RGBA;
3583   fglInternalFormat := GL_RGBA8;
3584   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3585 {$ELSE}
3586   fOpenGLFormat     := tfRGBA8ub4
3587 {$ENDIF}
3588 end;
3589
3590 procedure TfdBGRA8ub4.SetValues;
3591 begin
3592   inherited SetValues;
3593   fBitsPerPixel     := 32;
3594   fFormat           := tfBGRA8ub4;
3595   fWithAlpha        := tfBGRA8ub4;
3596   fWithoutAlpha     := tfBGR8ub3;
3597   fRGBInverted      := tfRGBA8ub4;
3598   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3599   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3600 {$IFNDEF OPENGL_ES}
3601   fOpenGLFormat     := tfBGRA8ub4;
3602   fglFormat         := GL_BGRA;
3603   fglInternalFormat := GL_RGBA8;
3604   fglDataFormat     := GL_UNSIGNED_BYTE;
3605 {$ELSE}
3606   fOpenGLFormat     := tfRGBA8ub4;
3607 {$ENDIF}
3608 end;
3609
3610 procedure TfdBGR10A2ui1.SetValues;
3611 begin
3612   inherited SetValues;
3613   fBitsPerPixel     := 32;
3614   fFormat           := tfBGR10A2ui1;
3615   fWithAlpha        := tfBGR10A2ui1;
3616   fWithoutAlpha     := tfBGR10X2ui1;
3617   fRGBInverted      := tfRGB10A2ui1;
3618   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3619   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3620 {$IFNDEF OPENGL_ES}
3621   fOpenGLFormat     := tfBGR10A2ui1;
3622   fglFormat         := GL_BGRA;
3623   fglInternalFormat := GL_RGB10_A2;
3624   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3625 {$ELSE}
3626   fOpenGLFormat     := tfA2RGB10ui1;
3627 {$ENDIF}
3628 end;
3629
3630 procedure TfdA2BGR10ui1.SetValues;
3631 begin
3632   inherited SetValues;
3633   fBitsPerPixel     := 32;
3634   fFormat           := tfA2BGR10ui1;
3635   fWithAlpha        := tfA2BGR10ui1;
3636   fWithoutAlpha     := tfX2BGR10ui1;
3637   fRGBInverted      := tfA2RGB10ui1;
3638   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3639   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3640 {$IFNDEF OPENGL_ES}
3641   fOpenGLFormat     := tfA2BGR10ui1;
3642   fglFormat         := GL_RGBA;
3643   fglInternalFormat := GL_RGB10_A2;
3644   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3645 {$ELSE}
3646   fOpenGLFormat     := tfA2RGB10ui1;
3647 {$ENDIF}
3648 end;
3649
3650 procedure TfdBGRA16us4.SetValues;
3651 begin
3652   inherited SetValues;
3653   fBitsPerPixel     := 64;
3654   fFormat           := tfBGRA16us4;
3655   fWithAlpha        := tfBGRA16us4;
3656   fWithoutAlpha     := tfBGR16us3;
3657   fRGBInverted      := tfRGBA16us4;
3658   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3659   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3660 {$IFNDEF OPENGL_ES}
3661   fOpenGLFormat     := tfBGRA16us4;
3662   fglFormat         := GL_BGRA;
3663   fglInternalFormat := GL_RGBA16;
3664   fglDataFormat     := GL_UNSIGNED_SHORT;
3665 {$ELSE}
3666   fOpenGLFormat     := tfRGBA16us4;
3667 {$ENDIF}
3668 end;
3669
3670 procedure TfdDepth16us1.SetValues;
3671 begin
3672   inherited SetValues;
3673   fBitsPerPixel     := 16;
3674   fFormat           := tfDepth16us1;
3675   fWithoutAlpha     := tfDepth16us1;
3676   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3677   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3678 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3679   fOpenGLFormat     := tfDepth16us1;
3680   fglFormat         := GL_DEPTH_COMPONENT;
3681   fglInternalFormat := GL_DEPTH_COMPONENT16;
3682   fglDataFormat     := GL_UNSIGNED_SHORT;
3683 {$IFEND}
3684 end;
3685
3686 procedure TfdDepth24ui1.SetValues;
3687 begin
3688   inherited SetValues;
3689   fBitsPerPixel     := 32;
3690   fFormat           := tfDepth24ui1;
3691   fWithoutAlpha     := tfDepth24ui1;
3692   fOpenGLFormat     := tfDepth24ui1;
3693   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3694   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3695 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3696   fOpenGLFormat     := tfDepth24ui1;
3697   fglFormat         := GL_DEPTH_COMPONENT;
3698   fglInternalFormat := GL_DEPTH_COMPONENT24;
3699   fglDataFormat     := GL_UNSIGNED_INT;
3700 {$IFEND}
3701 end;
3702
3703 procedure TfdDepth32ui1.SetValues;
3704 begin
3705   inherited SetValues;
3706   fBitsPerPixel     := 32;
3707   fFormat           := tfDepth32ui1;
3708   fWithoutAlpha     := tfDepth32ui1;
3709   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3710   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3711 {$IF NOT DEFINED(OPENGL_ES)}
3712   fOpenGLFormat     := tfDepth32ui1;
3713   fglFormat         := GL_DEPTH_COMPONENT;
3714   fglInternalFormat := GL_DEPTH_COMPONENT32;
3715   fglDataFormat     := GL_UNSIGNED_INT;
3716 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3717   fOpenGLFormat     := tfDepth24ui1;
3718 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3719   fOpenGLFormat     := tfDepth16us1;
3720 {$IFEND}
3721 end;
3722
3723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3724 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3727 begin
3728   raise EglBitmap.Create('mapping for compressed formats is not supported');
3729 end;
3730
3731 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3732 begin
3733   raise EglBitmap.Create('mapping for compressed formats is not supported');
3734 end;
3735
3736 procedure TfdS3tcDtx1RGBA.SetValues;
3737 begin
3738   inherited SetValues;
3739   fFormat           := tfS3tcDtx1RGBA;
3740   fWithAlpha        := tfS3tcDtx1RGBA;
3741   fUncompressed     := tfRGB5A1us1;
3742   fBitsPerPixel     := 4;
3743   fIsCompressed     := true;
3744 {$IFNDEF OPENGL_ES}
3745   fOpenGLFormat     := tfS3tcDtx1RGBA;
3746   fglFormat         := GL_COMPRESSED_RGBA;
3747   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3748   fglDataFormat     := GL_UNSIGNED_BYTE;
3749 {$ELSE}
3750   fOpenGLFormat     := fUncompressed;
3751 {$ENDIF}
3752 end;
3753
3754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3755 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3757 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3758 begin
3759   raise EglBitmap.Create('mapping for compressed formats is not supported');
3760 end;
3761
3762 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3763 begin
3764   raise EglBitmap.Create('mapping for compressed formats is not supported');
3765 end;
3766
3767 procedure TfdS3tcDtx3RGBA.SetValues;
3768 begin
3769   inherited SetValues;
3770   fFormat           := tfS3tcDtx3RGBA;
3771   fWithAlpha        := tfS3tcDtx3RGBA;
3772   fUncompressed     := tfRGBA8ub4;
3773   fBitsPerPixel     := 8;
3774   fIsCompressed     := true;
3775 {$IFNDEF OPENGL_ES}
3776   fOpenGLFormat     := tfS3tcDtx3RGBA;
3777   fglFormat         := GL_COMPRESSED_RGBA;
3778   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3779   fglDataFormat     := GL_UNSIGNED_BYTE;
3780 {$ELSE}
3781   fOpenGLFormat     := fUncompressed;
3782 {$ENDIF}
3783 end;
3784
3785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3786 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3789 begin
3790   raise EglBitmap.Create('mapping for compressed formats is not supported');
3791 end;
3792
3793 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3794 begin
3795   raise EglBitmap.Create('mapping for compressed formats is not supported');
3796 end;
3797
3798 procedure TfdS3tcDtx5RGBA.SetValues;
3799 begin
3800   inherited SetValues;
3801   fFormat           := tfS3tcDtx3RGBA;
3802   fWithAlpha        := tfS3tcDtx3RGBA;
3803   fUncompressed     := tfRGBA8ub4;
3804   fBitsPerPixel     := 8;
3805   fIsCompressed     := true;
3806 {$IFNDEF OPENGL_ES}
3807   fOpenGLFormat     := tfS3tcDtx3RGBA;
3808   fglFormat         := GL_COMPRESSED_RGBA;
3809   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3810   fglDataFormat     := GL_UNSIGNED_BYTE;
3811 {$ELSE}
3812   fOpenGLFormat     := fUncompressed;
3813 {$ENDIF}
3814 end;
3815
3816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3819 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3820 begin
3821   result := (fPrecision.r > 0);
3822 end;
3823
3824 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3825 begin
3826   result := (fPrecision.g > 0);
3827 end;
3828
3829 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3830 begin
3831   result := (fPrecision.b > 0);
3832 end;
3833
3834 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3835 begin
3836   result := (fPrecision.a > 0);
3837 end;
3838
3839 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3840 begin
3841   result := HasRed or HasGreen or HasBlue;
3842 end;
3843
3844 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3845 begin
3846   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3847 end;
3848
3849 function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
3850 begin
3851   result := (OpenGLFormat = Format);
3852 end;
3853
3854 procedure TglBitmapFormatDescriptor.SetValues;
3855 begin
3856   fFormat       := tfEmpty;
3857   fWithAlpha    := tfEmpty;
3858   fWithoutAlpha := tfEmpty;
3859   fOpenGLFormat := tfEmpty;
3860   fRGBInverted  := tfEmpty;
3861   fUncompressed := tfEmpty;
3862
3863   fBitsPerPixel := 0;
3864   fIsCompressed := false;
3865
3866   fglFormat         := 0;
3867   fglInternalFormat := 0;
3868   fglDataFormat     := 0;
3869
3870   FillChar(fPrecision, 0, SizeOf(fPrecision));
3871   FillChar(fShift,     0, SizeOf(fShift));
3872 end;
3873
3874 procedure TglBitmapFormatDescriptor.CalcValues;
3875 var
3876   i: Integer;
3877 begin
3878   fBytesPerPixel := fBitsPerPixel / 8;
3879   fChannelCount  := 0;
3880   for i := 0 to 3 do begin
3881     if (fPrecision.arr[i] > 0) then
3882       inc(fChannelCount);
3883     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3884     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3885   end;
3886 end;
3887
3888 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3889 var
3890   w, h: Integer;
3891 begin
3892   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3893     w := Max(1, aSize.X);
3894     h := Max(1, aSize.Y);
3895     result := GetSize(w, h);
3896   end else
3897     result := 0;
3898 end;
3899
3900 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3901 begin
3902   result := 0;
3903   if (aWidth <= 0) or (aHeight <= 0) then
3904     exit;
3905   result := Ceil(aWidth * aHeight * BytesPerPixel);
3906 end;
3907
3908 constructor TglBitmapFormatDescriptor.Create;
3909 begin
3910   inherited Create;
3911   SetValues;
3912   CalcValues;
3913 end;
3914
3915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3916 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3917 var
3918   f: TglBitmapFormat;
3919 begin
3920   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3921     result := TFormatDescriptor.Get(f);
3922     if (result.glInternalFormat = aInternalFormat) then
3923       exit;
3924   end;
3925   result := TFormatDescriptor.Get(tfEmpty);
3926 end;
3927
3928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3929 class function TglBitmapFormatDescriptor.GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor;
3930 begin
3931   result := TFormatDescriptor.Get(aFormat);
3932   if not Assigned(result) then
3933     result := TFormatDescriptor.Get(tfEmpty);
3934 end;
3935
3936 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3937 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3939 class procedure TFormatDescriptor.Init;
3940 begin
3941   if not Assigned(FormatDescriptorCS) then
3942     FormatDescriptorCS := TCriticalSection.Create;
3943 end;
3944
3945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3946 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3947 begin
3948   FormatDescriptorCS.Enter;
3949   try
3950     result := FormatDescriptors[aFormat];
3951     if not Assigned(result) then begin
3952       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3953       FormatDescriptors[aFormat] := result;
3954     end;
3955   finally
3956     FormatDescriptorCS.Leave;
3957   end;
3958 end;
3959
3960 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3961 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3962 begin
3963   result := Get(Get(aFormat).WithAlpha);
3964 end;
3965
3966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3967 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3968 var
3969   ft: TglBitmapFormat;
3970 begin
3971   // find matching format with OpenGL support
3972   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3973     result := Get(ft);
3974     if (result.MaskMatch(aMask))      and
3975        (result.glFormat <> 0)         and
3976        (result.glInternalFormat <> 0) and
3977        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3978     then
3979       exit;
3980   end;
3981
3982   // find matching format without OpenGL Support
3983   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3984     result := Get(ft);
3985     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3986       exit;
3987   end;
3988
3989   result := TFormatDescriptor.Get(tfEmpty);
3990 end;
3991
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3994 var
3995   ft: TglBitmapFormat;
3996 begin
3997   // find matching format with OpenGL support
3998   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3999     result := Get(ft);
4000     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4001        glBitmapRec4ubCompare(result.Precision, aPrec) and
4002        (result.glFormat <> 0)         and
4003        (result.glInternalFormat <> 0) and
4004        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4005     then
4006       exit;
4007   end;
4008
4009   // find matching format without OpenGL Support
4010   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4011     result := Get(ft);
4012     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4013        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4014        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4015       exit;
4016   end;
4017
4018   result := TFormatDescriptor.Get(tfEmpty);
4019 end;
4020
4021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 class procedure TFormatDescriptor.Clear;
4023 var
4024   f: TglBitmapFormat;
4025 begin
4026   FormatDescriptorCS.Enter;
4027   try
4028     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4029       FreeAndNil(FormatDescriptors[f]);
4030   finally
4031     FormatDescriptorCS.Leave;
4032   end;
4033 end;
4034
4035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4036 class procedure TFormatDescriptor.Finalize;
4037 begin
4038   Clear;
4039   FreeAndNil(FormatDescriptorCS);
4040 end;
4041
4042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4043 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4046 var
4047   i: Integer;
4048 begin
4049   for i := 0 to 3 do begin
4050     fShift.arr[i] := 0;
4051     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4052       aMask.arr[i] := aMask.arr[i] shr 1;
4053       inc(fShift.arr[i]);
4054     end;
4055     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4056   end;
4057   fBitsPerPixel := aBPP;
4058   CalcValues;
4059 end;
4060
4061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4062 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4063 begin
4064   fBitsPerPixel := aBBP;
4065   fPrecision    := aPrec;
4066   fShift        := aShift;
4067   CalcValues;
4068 end;
4069
4070 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4071 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4072 var
4073   data: QWord;
4074 begin
4075   data :=
4076     ((aPixel.Data.r and Range.r) shl Shift.r) or
4077     ((aPixel.Data.g and Range.g) shl Shift.g) or
4078     ((aPixel.Data.b and Range.b) shl Shift.b) or
4079     ((aPixel.Data.a and Range.a) shl Shift.a);
4080   case BitsPerPixel of
4081     8:           aData^  := data;
4082    16:     PWord(aData)^ := data;
4083    32: PCardinal(aData)^ := data;
4084    64:    PQWord(aData)^ := data;
4085   else
4086     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4087   end;
4088   inc(aData, Round(BytesPerPixel));
4089 end;
4090
4091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4092 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4093 var
4094   data: QWord;
4095   i: Integer;
4096 begin
4097   case BitsPerPixel of
4098      8: data :=           aData^;
4099     16: data :=     PWord(aData)^;
4100     32: data := PCardinal(aData)^;
4101     64: data :=    PQWord(aData)^;
4102   else
4103     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4104   end;
4105   for i := 0 to 3 do
4106     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4107   inc(aData, Round(BytesPerPixel));
4108 end;
4109
4110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4111 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 procedure TbmpColorTableFormat.SetValues;
4114 begin
4115   inherited SetValues;
4116   fShift := glBitmapRec4ub(8, 8, 8, 0);
4117 end;
4118
4119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4120 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4121 begin
4122   fFormat       := aFormat;
4123   fBitsPerPixel := aBPP;
4124   fPrecision    := aPrec;
4125   fShift        := aShift;
4126   CalcValues;
4127 end;
4128
4129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4130 procedure TbmpColorTableFormat.CalcValues;
4131 begin
4132   inherited CalcValues;
4133 end;
4134
4135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4136 procedure TbmpColorTableFormat.CreateColorTable;
4137 var
4138   i: Integer;
4139 begin
4140   SetLength(fColorTable, 256);
4141   if not HasColor then begin
4142     // alpha
4143     for i := 0 to High(fColorTable) do begin
4144       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4145       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4146       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4147       fColorTable[i].a := 0;
4148     end;
4149   end else begin
4150     // normal
4151     for i := 0 to High(fColorTable) do begin
4152       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4153       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4154       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4155       fColorTable[i].a := 0;
4156     end;
4157   end;
4158 end;
4159
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 function TbmpColorTableFormat.CreateMappingData: Pointer;
4162 begin
4163   result := Pointer(0);
4164 end;
4165
4166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4167 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4168 begin
4169   if (BitsPerPixel <> 8) then
4170     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4171   if not HasColor then
4172     // alpha
4173     aData^ := aPixel.Data.a
4174   else
4175     // normal
4176     aData^ := Round(
4177       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4178       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4179       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4180   inc(aData);
4181 end;
4182
4183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4184 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4185
4186   function ReadValue: Byte;
4187   var
4188     i: PtrUInt;
4189   begin
4190     if (BitsPerPixel = 8) then begin
4191       result := aData^;
4192       inc(aData);
4193     end else begin
4194       i := {%H-}PtrUInt(aMapData);
4195       if (BitsPerPixel > 1) then
4196         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4197       else
4198         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4199       inc(i, BitsPerPixel);
4200       while (i >= 8) do begin
4201         inc(aData);
4202         dec(i, 8);
4203       end;
4204       aMapData := {%H-}Pointer(i);
4205     end;
4206   end;
4207
4208 begin
4209   if (BitsPerPixel > 8) then
4210     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4211   with fColorTable[ReadValue] do begin
4212     aPixel.Data.r := r;
4213     aPixel.Data.g := g;
4214     aPixel.Data.b := b;
4215     aPixel.Data.a := a;
4216   end;
4217 end;
4218
4219 destructor TbmpColorTableFormat.Destroy;
4220 begin
4221   SetLength(fColorTable, 0);
4222   inherited Destroy;
4223 end;
4224
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4229 var
4230   i: Integer;
4231 begin
4232   for i := 0 to 3 do begin
4233     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4234       if (aSourceFD.Range.arr[i] > 0) then
4235         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4236       else
4237         aPixel.Data.arr[i] := 0;
4238     end;
4239   end;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4244 begin
4245   with aFuncRec do begin
4246     if (Source.Range.r   > 0) then
4247       Dest.Data.r := Source.Data.r;
4248     if (Source.Range.g > 0) then
4249       Dest.Data.g := Source.Data.g;
4250     if (Source.Range.b  > 0) then
4251       Dest.Data.b := Source.Data.b;
4252     if (Source.Range.a > 0) then
4253       Dest.Data.a := Source.Data.a;
4254   end;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4259 var
4260   i: Integer;
4261 begin
4262   with aFuncRec do begin
4263     for i := 0 to 3 do
4264       if (Source.Range.arr[i] > 0) then
4265         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4266   end;
4267 end;
4268
4269 type
4270   TShiftData = packed record
4271     case Integer of
4272       0: (r, g, b, a: SmallInt);
4273       1: (arr: array[0..3] of SmallInt);
4274   end;
4275   PShiftData = ^TShiftData;
4276
4277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4278 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4279 var
4280   i: Integer;
4281 begin
4282   with aFuncRec do
4283     for i := 0 to 3 do
4284       if (Source.Range.arr[i] > 0) then
4285         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4286 end;
4287
4288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4289 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4290 var
4291   i: Integer;
4292 begin
4293   with aFuncRec do begin
4294     Dest.Data := Source.Data;
4295     for i := 0 to 3 do
4296       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4297         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4298   end;
4299 end;
4300
4301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4302 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4303 var
4304   i: Integer;
4305 begin
4306   with aFuncRec do begin
4307     for i := 0 to 3 do
4308       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4309   end;
4310 end;
4311
4312 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4313 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4314 var
4315   Temp: Single;
4316 begin
4317   with FuncRec do begin
4318     if (FuncRec.Args = nil) then begin //source has no alpha
4319       Temp :=
4320         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4321         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4322         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4323       Dest.Data.a := Round(Dest.Range.a * Temp);
4324     end else
4325       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4326   end;
4327 end;
4328
4329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4330 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4331 type
4332   PglBitmapPixelData = ^TglBitmapPixelData;
4333 begin
4334   with FuncRec do begin
4335     Dest.Data.r := Source.Data.r;
4336     Dest.Data.g := Source.Data.g;
4337     Dest.Data.b := Source.Data.b;
4338
4339     with PglBitmapPixelData(Args)^ do
4340       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4341           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4342           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4343         Dest.Data.a := 0
4344       else
4345         Dest.Data.a := Dest.Range.a;
4346   end;
4347 end;
4348
4349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4350 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4351 begin
4352   with FuncRec do begin
4353     Dest.Data.r := Source.Data.r;
4354     Dest.Data.g := Source.Data.g;
4355     Dest.Data.b := Source.Data.b;
4356     Dest.Data.a := PCardinal(Args)^;
4357   end;
4358 end;
4359
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4362 type
4363   PRGBPix = ^TRGBPix;
4364   TRGBPix = array [0..2] of byte;
4365 var
4366   Temp: Byte;
4367 begin
4368   while aWidth > 0 do begin
4369     Temp := PRGBPix(aData)^[0];
4370     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4371     PRGBPix(aData)^[2] := Temp;
4372
4373     if aHasAlpha then
4374       Inc(aData, 4)
4375     else
4376       Inc(aData, 3);
4377     dec(aWidth);
4378   end;
4379 end;
4380
4381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4382 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4384 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4385 begin
4386   result := TFormatDescriptor.Get(fFormat);
4387 end;
4388
4389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4390 function TglBitmapData.GetWidth: Integer;
4391 begin
4392   if (ffX in fDimension.Fields) then
4393     result := fDimension.X
4394   else
4395     result := -1;
4396 end;
4397
4398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4399 function TglBitmapData.GetHeight: Integer;
4400 begin
4401   if (ffY in fDimension.Fields) then
4402     result := fDimension.Y
4403   else
4404     result := -1;
4405 end;
4406
4407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4408 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4409 begin
4410   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4411     result := fScanlines[aIndex]
4412   else
4413     result := nil;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4418 begin
4419   if fFormat = aValue then
4420     exit;
4421   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4422     raise EglBitmapUnsupportedFormat.Create(Format);
4423   SetData(fData, aValue, Width, Height);
4424 end;
4425
4426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4427 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4428 var
4429   TempPos: Integer;
4430 begin
4431   if not Assigned(aResType) then begin
4432     TempPos   := Pos('.', aResource);
4433     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4434     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4435   end;
4436 end;
4437
4438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4439 procedure TglBitmapData.UpdateScanlines;
4440 var
4441   w, h, i, LineWidth: Integer;
4442 begin
4443   w := Width;
4444   h := Height;
4445   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4446   if fHasScanlines then begin
4447     SetLength(fScanlines, h);
4448     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4449     for i := 0 to h-1 do begin
4450       fScanlines[i] := fData;
4451       Inc(fScanlines[i], i * LineWidth);
4452     end;
4453   end else
4454     SetLength(fScanlines, 0);
4455 end;
4456
4457 {$IFDEF GLB_SUPPORT_PNG_READ}
4458 {$IF DEFINED(GLB_LAZ_PNG)}
4459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4460 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4462 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4463 const
4464   MAGIC_LEN = 8;
4465   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4466 var
4467   reader: TLazReaderPNG;
4468   intf: TLazIntfImage;
4469   StreamPos: Int64;
4470   magic: String[MAGIC_LEN];
4471 begin
4472   result := true;
4473   StreamPos := aStream.Position;
4474
4475   SetLength(magic, MAGIC_LEN);
4476   aStream.Read(magic[1], MAGIC_LEN);
4477   aStream.Position := StreamPos;
4478   if (magic <> PNG_MAGIC) then begin
4479     result := false;
4480     exit;
4481   end;
4482
4483   intf   := TLazIntfImage.Create(0, 0);
4484   reader := TLazReaderPNG.Create;
4485   try try
4486     reader.UpdateDescription := true;
4487     reader.ImageRead(aStream, intf);
4488     AssignFromLazIntfImage(intf);
4489   except
4490     result := false;
4491     aStream.Position := StreamPos;
4492     exit;
4493   end;
4494   finally
4495     reader.Free;
4496     intf.Free;
4497   end;
4498 end;
4499
4500 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4501 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4502 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4503 var
4504   Surface: PSDL_Surface;
4505   RWops: PSDL_RWops;
4506 begin
4507   result := false;
4508   RWops := glBitmapCreateRWops(aStream);
4509   try
4510     if IMG_isPNG(RWops) > 0 then begin
4511       Surface := IMG_LoadPNG_RW(RWops);
4512       try
4513         AssignFromSurface(Surface);
4514         result := true;
4515       finally
4516         SDL_FreeSurface(Surface);
4517       end;
4518     end;
4519   finally
4520     SDL_FreeRW(RWops);
4521   end;
4522 end;
4523
4524 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4526 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4527 begin
4528   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4529 end;
4530
4531 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4532 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4533 var
4534   StreamPos: Int64;
4535   signature: array [0..7] of byte;
4536   png: png_structp;
4537   png_info: png_infop;
4538
4539   TempHeight, TempWidth: Integer;
4540   Format: TglBitmapFormat;
4541
4542   png_data: pByte;
4543   png_rows: array of pByte;
4544   Row, LineSize: Integer;
4545 begin
4546   result := false;
4547
4548   if not init_libPNG then
4549     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4550
4551   try
4552     // signature
4553     StreamPos := aStream.Position;
4554     aStream.Read(signature{%H-}, 8);
4555     aStream.Position := StreamPos;
4556
4557     if png_check_sig(@signature, 8) <> 0 then begin
4558       // png read struct
4559       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4560       if png = nil then
4561         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4562
4563       // png info
4564       png_info := png_create_info_struct(png);
4565       if png_info = nil then begin
4566         png_destroy_read_struct(@png, nil, nil);
4567         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4568       end;
4569
4570       // set read callback
4571       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4572
4573       // read informations
4574       png_read_info(png, png_info);
4575
4576       // size
4577       TempHeight := png_get_image_height(png, png_info);
4578       TempWidth := png_get_image_width(png, png_info);
4579
4580       // format
4581       case png_get_color_type(png, png_info) of
4582         PNG_COLOR_TYPE_GRAY:
4583           Format := tfLuminance8ub1;
4584         PNG_COLOR_TYPE_GRAY_ALPHA:
4585           Format := tfLuminance8Alpha8us1;
4586         PNG_COLOR_TYPE_RGB:
4587           Format := tfRGB8ub3;
4588         PNG_COLOR_TYPE_RGB_ALPHA:
4589           Format := tfRGBA8ub4;
4590         else
4591           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4592       end;
4593
4594       // cut upper 8 bit from 16 bit formats
4595       if png_get_bit_depth(png, png_info) > 8 then
4596         png_set_strip_16(png);
4597
4598       // expand bitdepth smaller than 8
4599       if png_get_bit_depth(png, png_info) < 8 then
4600         png_set_expand(png);
4601
4602       // allocating mem for scanlines
4603       LineSize := png_get_rowbytes(png, png_info);
4604       GetMem(png_data, TempHeight * LineSize);
4605       try
4606         SetLength(png_rows, TempHeight);
4607         for Row := Low(png_rows) to High(png_rows) do begin
4608           png_rows[Row] := png_data;
4609           Inc(png_rows[Row], Row * LineSize);
4610         end;
4611
4612         // read complete image into scanlines
4613         png_read_image(png, @png_rows[0]);
4614
4615         // read end
4616         png_read_end(png, png_info);
4617
4618         // destroy read struct
4619         png_destroy_read_struct(@png, @png_info, nil);
4620
4621         SetLength(png_rows, 0);
4622
4623         // set new data
4624         SetData(png_data, Format, TempWidth, TempHeight);
4625
4626         result := true;
4627       except
4628         if Assigned(png_data) then
4629           FreeMem(png_data);
4630         raise;
4631       end;
4632     end;
4633   finally
4634     quit_libPNG;
4635   end;
4636 end;
4637
4638 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4640 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4641 var
4642   StreamPos: Int64;
4643   Png: TPNGObject;
4644   Header: String[8];
4645   Row, Col, PixSize, LineSize: Integer;
4646   NewImage, pSource, pDest, pAlpha: pByte;
4647   PngFormat: TglBitmapFormat;
4648   FormatDesc: TFormatDescriptor;
4649
4650 const
4651   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4652
4653 begin
4654   result := false;
4655
4656   StreamPos := aStream.Position;
4657   aStream.Read(Header[0], SizeOf(Header));
4658   aStream.Position := StreamPos;
4659
4660   {Test if the header matches}
4661   if Header = PngHeader then begin
4662     Png := TPNGObject.Create;
4663     try
4664       Png.LoadFromStream(aStream);
4665
4666       case Png.Header.ColorType of
4667         COLOR_GRAYSCALE:
4668           PngFormat := tfLuminance8ub1;
4669         COLOR_GRAYSCALEALPHA:
4670           PngFormat := tfLuminance8Alpha8us1;
4671         COLOR_RGB:
4672           PngFormat := tfBGR8ub3;
4673         COLOR_RGBALPHA:
4674           PngFormat := tfBGRA8ub4;
4675         else
4676           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4677       end;
4678
4679       FormatDesc := TFormatDescriptor.Get(PngFormat);
4680       PixSize    := Round(FormatDesc.PixelSize);
4681       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4682
4683       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4684       try
4685         pDest := NewImage;
4686
4687         case Png.Header.ColorType of
4688           COLOR_RGB, COLOR_GRAYSCALE:
4689             begin
4690               for Row := 0 to Png.Height -1 do begin
4691                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4692                 Inc(pDest, LineSize);
4693               end;
4694             end;
4695           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4696             begin
4697               PixSize := PixSize -1;
4698
4699               for Row := 0 to Png.Height -1 do begin
4700                 pSource := Png.Scanline[Row];
4701                 pAlpha := pByte(Png.AlphaScanline[Row]);
4702
4703                 for Col := 0 to Png.Width -1 do begin
4704                   Move (pSource^, pDest^, PixSize);
4705                   Inc(pSource, PixSize);
4706                   Inc(pDest, PixSize);
4707
4708                   pDest^ := pAlpha^;
4709                   inc(pAlpha);
4710                   Inc(pDest);
4711                 end;
4712               end;
4713             end;
4714           else
4715             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4716         end;
4717
4718         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4719
4720         result := true;
4721       except
4722         if Assigned(NewImage) then
4723           FreeMem(NewImage);
4724         raise;
4725       end;
4726     finally
4727       Png.Free;
4728     end;
4729   end;
4730 end;
4731 {$IFEND}
4732 {$ENDIF}
4733
4734 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4735 {$IFDEF GLB_LIB_PNG}
4736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4737 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4738 begin
4739   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4740 end;
4741 {$ENDIF}
4742
4743 {$IF DEFINED(GLB_LAZ_PNG)}
4744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4745 procedure TglBitmapData.SavePNG(const aStream: TStream);
4746 var
4747   png: TPortableNetworkGraphic;
4748   intf: TLazIntfImage;
4749   raw: TRawImage;
4750 begin
4751   png  := TPortableNetworkGraphic.Create;
4752   intf := TLazIntfImage.Create(0, 0);
4753   try
4754     if not AssignToLazIntfImage(intf) then
4755       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4756     intf.GetRawImage(raw);
4757     png.LoadFromRawImage(raw, false);
4758     png.SaveToStream(aStream);
4759   finally
4760     png.Free;
4761     intf.Free;
4762   end;
4763 end;
4764
4765 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4766 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4767 procedure TglBitmapData.SavePNG(const aStream: TStream);
4768 var
4769   png: png_structp;
4770   png_info: png_infop;
4771   png_rows: array of pByte;
4772   LineSize: Integer;
4773   ColorType: Integer;
4774   Row: Integer;
4775   FormatDesc: TFormatDescriptor;
4776 begin
4777   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4778     raise EglBitmapUnsupportedFormat.Create(Format);
4779
4780   if not init_libPNG then
4781     raise Exception.Create('unable to initialize libPNG.');
4782
4783   try
4784     case Format of
4785       tfAlpha8ub1, tfLuminance8ub1:
4786         ColorType := PNG_COLOR_TYPE_GRAY;
4787       tfLuminance8Alpha8us1:
4788         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4789       tfBGR8ub3, tfRGB8ub3:
4790         ColorType := PNG_COLOR_TYPE_RGB;
4791       tfBGRA8ub4, tfRGBA8ub4:
4792         ColorType := PNG_COLOR_TYPE_RGBA;
4793       else
4794         raise EglBitmapUnsupportedFormat.Create(Format);
4795     end;
4796
4797     FormatDesc := TFormatDescriptor.Get(Format);
4798     LineSize := FormatDesc.GetSize(Width, 1);
4799
4800     // creating array for scanline
4801     SetLength(png_rows, Height);
4802     try
4803       for Row := 0 to Height - 1 do begin
4804         png_rows[Row] := Data;
4805         Inc(png_rows[Row], Row * LineSize)
4806       end;
4807
4808       // write struct
4809       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4810       if png = nil then
4811         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4812
4813       // create png info
4814       png_info := png_create_info_struct(png);
4815       if png_info = nil then begin
4816         png_destroy_write_struct(@png, nil);
4817         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4818       end;
4819
4820       // set read callback
4821       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4822
4823       // set compression
4824       png_set_compression_level(png, 6);
4825
4826       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4827         png_set_bgr(png);
4828
4829       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4830       png_write_info(png, png_info);
4831       png_write_image(png, @png_rows[0]);
4832       png_write_end(png, png_info);
4833       png_destroy_write_struct(@png, @png_info);
4834     finally
4835       SetLength(png_rows, 0);
4836     end;
4837   finally
4838     quit_libPNG;
4839   end;
4840 end;
4841
4842 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4844 procedure TglBitmapData.SavePNG(const aStream: TStream);
4845 var
4846   Png: TPNGObject;
4847
4848   pSource, pDest: pByte;
4849   X, Y, PixSize: Integer;
4850   ColorType: Cardinal;
4851   Alpha: Boolean;
4852
4853   pTemp: pByte;
4854   Temp: Byte;
4855 begin
4856   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4857     raise EglBitmapUnsupportedFormat.Create(Format);
4858
4859   case Format of
4860     tfAlpha8ub1, tfLuminance8ub1: begin
4861       ColorType := COLOR_GRAYSCALE;
4862       PixSize   := 1;
4863       Alpha     := false;
4864     end;
4865     tfLuminance8Alpha8us1: begin
4866       ColorType := COLOR_GRAYSCALEALPHA;
4867       PixSize   := 1;
4868       Alpha     := true;
4869     end;
4870     tfBGR8ub3, tfRGB8ub3: begin
4871       ColorType := COLOR_RGB;
4872       PixSize   := 3;
4873       Alpha     := false;
4874     end;
4875     tfBGRA8ub4, tfRGBA8ub4: begin
4876       ColorType := COLOR_RGBALPHA;
4877       PixSize   := 3;
4878       Alpha     := true
4879     end;
4880   else
4881     raise EglBitmapUnsupportedFormat.Create(Format);
4882   end;
4883
4884   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4885   try
4886     // Copy ImageData
4887     pSource := Data;
4888     for Y := 0 to Height -1 do begin
4889       pDest := png.ScanLine[Y];
4890       for X := 0 to Width -1 do begin
4891         Move(pSource^, pDest^, PixSize);
4892         Inc(pDest, PixSize);
4893         Inc(pSource, PixSize);
4894         if Alpha then begin
4895           png.AlphaScanline[Y]^[X] := pSource^;
4896           Inc(pSource);
4897         end;
4898       end;
4899
4900       // convert RGB line to BGR
4901       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4902         pTemp := png.ScanLine[Y];
4903         for X := 0 to Width -1 do begin
4904           Temp := pByteArray(pTemp)^[0];
4905           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4906           pByteArray(pTemp)^[2] := Temp;
4907           Inc(pTemp, 3);
4908         end;
4909       end;
4910     end;
4911
4912     // Save to Stream
4913     Png.CompressionLevel := 6;
4914     Png.SaveToStream(aStream);
4915   finally
4916     FreeAndNil(Png);
4917   end;
4918 end;
4919 {$IFEND}
4920 {$ENDIF}
4921
4922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4923 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4924 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4925 {$IFDEF GLB_LIB_JPEG}
4926 type
4927   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4928   glBitmap_libJPEG_source_mgr = record
4929     pub: jpeg_source_mgr;
4930
4931     SrcStream: TStream;
4932     SrcBuffer: array [1..4096] of byte;
4933   end;
4934
4935   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4936   glBitmap_libJPEG_dest_mgr = record
4937     pub: jpeg_destination_mgr;
4938
4939     DestStream: TStream;
4940     DestBuffer: array [1..4096] of byte;
4941   end;
4942
4943 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4944 begin
4945   //DUMMY
4946 end;
4947
4948
4949 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4950 begin
4951   //DUMMY
4952 end;
4953
4954
4955 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4956 begin
4957   //DUMMY
4958 end;
4959
4960 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4961 begin
4962   //DUMMY
4963 end;
4964
4965
4966 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4967 begin
4968   //DUMMY
4969 end;
4970
4971
4972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4973 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4974 var
4975   src: glBitmap_libJPEG_source_mgr_ptr;
4976   bytes: integer;
4977 begin
4978   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4979
4980   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4981         if (bytes <= 0) then begin
4982                 src^.SrcBuffer[1] := $FF;
4983                 src^.SrcBuffer[2] := JPEG_EOI;
4984                 bytes := 2;
4985         end;
4986
4987         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4988         src^.pub.bytes_in_buffer := bytes;
4989
4990   result := true;
4991 end;
4992
4993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4994 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4995 var
4996   src: glBitmap_libJPEG_source_mgr_ptr;
4997 begin
4998   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4999
5000   if num_bytes > 0 then begin
5001     // wanted byte isn't in buffer so set stream position and read buffer
5002     if num_bytes > src^.pub.bytes_in_buffer then begin
5003       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5004       src^.pub.fill_input_buffer(cinfo);
5005     end else begin
5006       // wanted byte is in buffer so only skip
5007                 inc(src^.pub.next_input_byte, num_bytes);
5008                 dec(src^.pub.bytes_in_buffer, num_bytes);
5009     end;
5010   end;
5011 end;
5012
5013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5014 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5015 var
5016   dest: glBitmap_libJPEG_dest_mgr_ptr;
5017 begin
5018   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5019
5020   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5021     // write complete buffer
5022     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5023
5024     // reset buffer
5025     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5026     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5027   end;
5028
5029   result := true;
5030 end;
5031
5032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5033 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5034 var
5035   Idx: Integer;
5036   dest: glBitmap_libJPEG_dest_mgr_ptr;
5037 begin
5038   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5039
5040   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5041     // check for endblock
5042     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5043       // write endblock
5044       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5045
5046       // leave
5047       break;
5048     end else
5049       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5050   end;
5051 end;
5052 {$ENDIF}
5053
5054 {$IFDEF GLB_SUPPORT_JPEG_READ}
5055 {$IF DEFINED(GLB_LAZ_JPEG)}
5056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5057 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5058 const
5059   MAGIC_LEN = 2;
5060   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5061 var
5062   intf: TLazIntfImage;
5063   reader: TFPReaderJPEG;
5064   StreamPos: Int64;
5065   magic: String[MAGIC_LEN];
5066 begin
5067   result := true;
5068   StreamPos := aStream.Position;
5069
5070   SetLength(magic, MAGIC_LEN);
5071   aStream.Read(magic[1], MAGIC_LEN);
5072   aStream.Position := StreamPos;
5073   if (magic <> JPEG_MAGIC) then begin
5074     result := false;
5075     exit;
5076   end;
5077
5078   reader := TFPReaderJPEG.Create;
5079   intf := TLazIntfImage.Create(0, 0);
5080   try try
5081     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5082     reader.ImageRead(aStream, intf);
5083     AssignFromLazIntfImage(intf);
5084   except
5085     result := false;
5086     aStream.Position := StreamPos;
5087     exit;
5088   end;
5089   finally
5090     reader.Free;
5091     intf.Free;
5092   end;
5093 end;
5094
5095 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5097 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5098 var
5099   Surface: PSDL_Surface;
5100   RWops: PSDL_RWops;
5101 begin
5102   result := false;
5103
5104   RWops := glBitmapCreateRWops(aStream);
5105   try
5106     if IMG_isJPG(RWops) > 0 then begin
5107       Surface := IMG_LoadJPG_RW(RWops);
5108       try
5109         AssignFromSurface(Surface);
5110         result := true;
5111       finally
5112         SDL_FreeSurface(Surface);
5113       end;
5114     end;
5115   finally
5116     SDL_FreeRW(RWops);
5117   end;
5118 end;
5119
5120 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5122 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5123 var
5124   StreamPos: Int64;
5125   Temp: array[0..1]of Byte;
5126
5127   jpeg: jpeg_decompress_struct;
5128   jpeg_err: jpeg_error_mgr;
5129
5130   IntFormat: TglBitmapFormat;
5131   pImage: pByte;
5132   TempHeight, TempWidth: Integer;
5133
5134   pTemp: pByte;
5135   Row: Integer;
5136
5137   FormatDesc: TFormatDescriptor;
5138 begin
5139   result := false;
5140
5141   if not init_libJPEG then
5142     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5143
5144   try
5145     // reading first two bytes to test file and set cursor back to begin
5146     StreamPos := aStream.Position;
5147     aStream.Read({%H-}Temp[0], 2);
5148     aStream.Position := StreamPos;
5149
5150     // if Bitmap then read file.
5151     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5152       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5153       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5154
5155       // error managment
5156       jpeg.err := jpeg_std_error(@jpeg_err);
5157       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5158       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5159
5160       // decompression struct
5161       jpeg_create_decompress(@jpeg);
5162
5163       // allocation space for streaming methods
5164       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5165
5166       // seeting up custom functions
5167       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5168         pub.init_source       := glBitmap_libJPEG_init_source;
5169         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5170         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5171         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5172         pub.term_source       := glBitmap_libJPEG_term_source;
5173
5174         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5175         pub.next_input_byte := nil;   // until buffer loaded
5176
5177         SrcStream := aStream;
5178       end;
5179
5180       // set global decoding state
5181       jpeg.global_state := DSTATE_START;
5182
5183       // read header of jpeg
5184       jpeg_read_header(@jpeg, false);
5185
5186       // setting output parameter
5187       case jpeg.jpeg_color_space of
5188         JCS_GRAYSCALE:
5189           begin
5190             jpeg.out_color_space := JCS_GRAYSCALE;
5191             IntFormat := tfLuminance8ub1;
5192           end;
5193         else
5194           jpeg.out_color_space := JCS_RGB;
5195           IntFormat := tfRGB8ub3;
5196       end;
5197
5198       // reading image
5199       jpeg_start_decompress(@jpeg);
5200
5201       TempHeight := jpeg.output_height;
5202       TempWidth := jpeg.output_width;
5203
5204       FormatDesc := TFormatDescriptor.Get(IntFormat);
5205
5206       // creating new image
5207       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5208       try
5209         pTemp := pImage;
5210
5211         for Row := 0 to TempHeight -1 do begin
5212           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5213           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5214         end;
5215
5216         // finish decompression
5217         jpeg_finish_decompress(@jpeg);
5218
5219         // destroy decompression
5220         jpeg_destroy_decompress(@jpeg);
5221
5222         SetData(pImage, IntFormat, TempWidth, TempHeight);
5223
5224         result := true;
5225       except
5226         if Assigned(pImage) then
5227           FreeMem(pImage);
5228         raise;
5229       end;
5230     end;
5231   finally
5232     quit_libJPEG;
5233   end;
5234 end;
5235
5236 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5238 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5239 var
5240   bmp: TBitmap;
5241   jpg: TJPEGImage;
5242   StreamPos: Int64;
5243   Temp: array[0..1]of Byte;
5244 begin
5245   result := false;
5246
5247   // reading first two bytes to test file and set cursor back to begin
5248   StreamPos := aStream.Position;
5249   aStream.Read(Temp[0], 2);
5250   aStream.Position := StreamPos;
5251
5252   // if Bitmap then read file.
5253   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5254     bmp := TBitmap.Create;
5255     try
5256       jpg := TJPEGImage.Create;
5257       try
5258         jpg.LoadFromStream(aStream);
5259         bmp.Assign(jpg);
5260         result := AssignFromBitmap(bmp);
5261       finally
5262         jpg.Free;
5263       end;
5264     finally
5265       bmp.Free;
5266     end;
5267   end;
5268 end;
5269 {$IFEND}
5270 {$ENDIF}
5271
5272 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5273 {$IF DEFINED(GLB_LAZ_JPEG)}
5274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5275 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5276 var
5277   jpeg: TJPEGImage;
5278   intf: TLazIntfImage;
5279   raw: TRawImage;
5280 begin
5281   jpeg := TJPEGImage.Create;
5282   intf := TLazIntfImage.Create(0, 0);
5283   try
5284     if not AssignToLazIntfImage(intf) then
5285       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5286     intf.GetRawImage(raw);
5287     jpeg.LoadFromRawImage(raw, false);
5288     jpeg.SaveToStream(aStream);
5289   finally
5290     intf.Free;
5291     jpeg.Free;
5292   end;
5293 end;
5294
5295 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5297 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5298 var
5299   jpeg: jpeg_compress_struct;
5300   jpeg_err: jpeg_error_mgr;
5301   Row: Integer;
5302   pTemp, pTemp2: pByte;
5303
5304   procedure CopyRow(pDest, pSource: pByte);
5305   var
5306     X: Integer;
5307   begin
5308     for X := 0 to Width - 1 do begin
5309       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5310       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5311       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5312       Inc(pDest, 3);
5313       Inc(pSource, 3);
5314     end;
5315   end;
5316
5317 begin
5318   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5319     raise EglBitmapUnsupportedFormat.Create(Format);
5320
5321   if not init_libJPEG then
5322     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5323
5324   try
5325     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5326     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5327
5328     // error managment
5329     jpeg.err := jpeg_std_error(@jpeg_err);
5330     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5331     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5332
5333     // compression struct
5334     jpeg_create_compress(@jpeg);
5335
5336     // allocation space for streaming methods
5337     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5338
5339     // seeting up custom functions
5340     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5341       pub.init_destination    := glBitmap_libJPEG_init_destination;
5342       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5343       pub.term_destination    := glBitmap_libJPEG_term_destination;
5344
5345       pub.next_output_byte  := @DestBuffer[1];
5346       pub.free_in_buffer    := Length(DestBuffer);
5347
5348       DestStream := aStream;
5349     end;
5350
5351     // very important state
5352     jpeg.global_state := CSTATE_START;
5353     jpeg.image_width  := Width;
5354     jpeg.image_height := Height;
5355     case Format of
5356       tfAlpha8ub1, tfLuminance8ub1: begin
5357         jpeg.input_components := 1;
5358         jpeg.in_color_space   := JCS_GRAYSCALE;
5359       end;
5360       tfRGB8ub3, tfBGR8ub3: begin
5361         jpeg.input_components := 3;
5362         jpeg.in_color_space   := JCS_RGB;
5363       end;
5364     end;
5365
5366     jpeg_set_defaults(@jpeg);
5367     jpeg_set_quality(@jpeg, 95, true);
5368     jpeg_start_compress(@jpeg, true);
5369     pTemp := Data;
5370
5371     if Format = tfBGR8ub3 then
5372       GetMem(pTemp2, fRowSize)
5373     else
5374       pTemp2 := pTemp;
5375
5376     try
5377       for Row := 0 to jpeg.image_height -1 do begin
5378         // prepare row
5379         if Format = tfBGR8ub3 then
5380           CopyRow(pTemp2, pTemp)
5381         else
5382           pTemp2 := pTemp;
5383
5384         // write row
5385         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5386         inc(pTemp, fRowSize);
5387       end;
5388     finally
5389       // free memory
5390       if Format = tfBGR8ub3 then
5391         FreeMem(pTemp2);
5392     end;
5393     jpeg_finish_compress(@jpeg);
5394     jpeg_destroy_compress(@jpeg);
5395   finally
5396     quit_libJPEG;
5397   end;
5398 end;
5399
5400 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5402 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5403 var
5404   Bmp: TBitmap;
5405   Jpg: TJPEGImage;
5406 begin
5407   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5408     raise EglBitmapUnsupportedFormat.Create(Format);
5409
5410   Bmp := TBitmap.Create;
5411   try
5412     Jpg := TJPEGImage.Create;
5413     try
5414       AssignToBitmap(Bmp);
5415       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5416         Jpg.Grayscale   := true;
5417         Jpg.PixelFormat := jf8Bit;
5418       end;
5419       Jpg.Assign(Bmp);
5420       Jpg.SaveToStream(aStream);
5421     finally
5422       FreeAndNil(Jpg);
5423     end;
5424   finally
5425     FreeAndNil(Bmp);
5426   end;
5427 end;
5428 {$IFEND}
5429 {$ENDIF}
5430
5431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5432 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 type
5435   RawHeader = packed record
5436     Magic:        String[5];
5437     Version:      Byte;
5438     Width:        Integer;
5439     Height:       Integer;
5440     DataSize:     Integer;
5441     BitsPerPixel: Integer;
5442     Precision:    TglBitmapRec4ub;
5443     Shift:        TglBitmapRec4ub;
5444   end;
5445
5446 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5447 var
5448   header: RawHeader;
5449   StartPos: Int64;
5450   fd: TFormatDescriptor;
5451   buf: PByte;
5452 begin
5453   result := false;
5454   StartPos := aStream.Position;
5455   aStream.Read(header{%H-}, SizeOf(header));
5456   if (header.Magic <> 'glBMP') then begin
5457     aStream.Position := StartPos;
5458     exit;
5459   end;
5460
5461   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5462   if (fd.Format = tfEmpty) then
5463     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5464
5465   buf := GetMemory(header.DataSize);
5466   aStream.Read(buf^, header.DataSize);
5467   SetData(buf, fd.Format, header.Width, header.Height);
5468
5469   result := true;
5470 end;
5471
5472 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5473 var
5474   header: RawHeader;
5475   fd: TFormatDescriptor;
5476 begin
5477   fd := TFormatDescriptor.Get(Format);
5478   header.Magic        := 'glBMP';
5479   header.Version      := 1;
5480   header.Width        := Width;
5481   header.Height       := Height;
5482   header.DataSize     := fd.GetSize(fDimension);
5483   header.BitsPerPixel := fd.BitsPerPixel;
5484   header.Precision    := fd.Precision;
5485   header.Shift        := fd.Shift;
5486   aStream.Write(header, SizeOf(header));
5487   aStream.Write(Data^,  header.DataSize);
5488 end;
5489
5490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5491 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5493 const
5494   BMP_MAGIC          = $4D42;
5495
5496   BMP_COMP_RGB       = 0;
5497   BMP_COMP_RLE8      = 1;
5498   BMP_COMP_RLE4      = 2;
5499   BMP_COMP_BITFIELDS = 3;
5500
5501 type
5502   TBMPHeader = packed record
5503     bfType: Word;
5504     bfSize: Cardinal;
5505     bfReserved1: Word;
5506     bfReserved2: Word;
5507     bfOffBits: Cardinal;
5508   end;
5509
5510   TBMPInfo = packed record
5511     biSize: Cardinal;
5512     biWidth: Longint;
5513     biHeight: Longint;
5514     biPlanes: Word;
5515     biBitCount: Word;
5516     biCompression: Cardinal;
5517     biSizeImage: Cardinal;
5518     biXPelsPerMeter: Longint;
5519     biYPelsPerMeter: Longint;
5520     biClrUsed: Cardinal;
5521     biClrImportant: Cardinal;
5522   end;
5523
5524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5525 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5526
5527   //////////////////////////////////////////////////////////////////////////////////////////////////
5528   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5529   var
5530     tmp, i: Cardinal;
5531   begin
5532     result := tfEmpty;
5533     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5534     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5535
5536     //Read Compression
5537     case aInfo.biCompression of
5538       BMP_COMP_RLE4,
5539       BMP_COMP_RLE8: begin
5540         raise EglBitmap.Create('RLE compression is not supported');
5541       end;
5542       BMP_COMP_BITFIELDS: begin
5543         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5544           for i := 0 to 2 do begin
5545             aStream.Read(tmp{%H-}, SizeOf(tmp));
5546             aMask.arr[i] := tmp;
5547           end;
5548         end else
5549           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5550       end;
5551     end;
5552
5553     //get suitable format
5554     case aInfo.biBitCount of
5555        8: result := tfLuminance8ub1;
5556       16: result := tfX1RGB5us1;
5557       24: result := tfBGR8ub3;
5558       32: result := tfXRGB8ui1;
5559     end;
5560   end;
5561
5562   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5563   var
5564     i, c: Integer;
5565     fd: TFormatDescriptor;
5566     ColorTable: TbmpColorTable;
5567   begin
5568     result := nil;
5569     if (aInfo.biBitCount >= 16) then
5570       exit;
5571     aFormat := tfLuminance8ub1;
5572     c := aInfo.biClrUsed;
5573     if (c = 0) then
5574       c := 1 shl aInfo.biBitCount;
5575     SetLength(ColorTable, c);
5576     for i := 0 to c-1 do begin
5577       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5578       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5579         aFormat := tfRGB8ub3;
5580     end;
5581
5582     fd := TFormatDescriptor.Get(aFormat);
5583     result := TbmpColorTableFormat.Create;
5584     result.ColorTable   := ColorTable;
5585     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5586   end;
5587
5588   //////////////////////////////////////////////////////////////////////////////////////////////////
5589   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5590   var
5591     fd: TFormatDescriptor;
5592   begin
5593     result := nil;
5594     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5595
5596       // find suitable format ...
5597       fd := TFormatDescriptor.GetFromMask(aMask);
5598       if (fd.Format <> tfEmpty) then begin
5599         aFormat := fd.Format;
5600         exit;
5601       end;
5602
5603       // or create custom bitfield format
5604       result := TbmpBitfieldFormat.Create;
5605       result.SetCustomValues(aInfo.biBitCount, aMask);
5606     end;
5607   end;
5608
5609 var
5610   //simple types
5611   StartPos: Int64;
5612   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5613   PaddingBuff: Cardinal;
5614   LineBuf, ImageData, TmpData: PByte;
5615   SourceMD, DestMD: Pointer;
5616   BmpFormat: TglBitmapFormat;
5617
5618   //records
5619   Mask: TglBitmapRec4ul;
5620   Header: TBMPHeader;
5621   Info: TBMPInfo;
5622
5623   //classes
5624   SpecialFormat: TFormatDescriptor;
5625   FormatDesc: TFormatDescriptor;
5626
5627   //////////////////////////////////////////////////////////////////////////////////////////////////
5628   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5629   var
5630     i: Integer;
5631     Pixel: TglBitmapPixelData;
5632   begin
5633     aStream.Read(aLineBuf^, rbLineSize);
5634     SpecialFormat.PreparePixel(Pixel);
5635     for i := 0 to Info.biWidth-1 do begin
5636       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5637       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5638       FormatDesc.Map(Pixel, aData, DestMD);
5639     end;
5640   end;
5641
5642 begin
5643   result        := false;
5644   BmpFormat     := tfEmpty;
5645   SpecialFormat := nil;
5646   LineBuf       := nil;
5647   SourceMD      := nil;
5648   DestMD        := nil;
5649
5650   // Header
5651   StartPos := aStream.Position;
5652   aStream.Read(Header{%H-}, SizeOf(Header));
5653
5654   if Header.bfType = BMP_MAGIC then begin
5655     try try
5656       BmpFormat        := ReadInfo(Info, Mask);
5657       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5658       if not Assigned(SpecialFormat) then
5659         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5660       aStream.Position := StartPos + Header.bfOffBits;
5661
5662       if (BmpFormat <> tfEmpty) then begin
5663         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5664         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5665         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5666         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5667
5668         //get Memory
5669         DestMD    := FormatDesc.CreateMappingData;
5670         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5671         GetMem(ImageData, ImageSize);
5672         if Assigned(SpecialFormat) then begin
5673           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5674           SourceMD := SpecialFormat.CreateMappingData;
5675         end;
5676
5677         //read Data
5678         try try
5679           FillChar(ImageData^, ImageSize, $FF);
5680           TmpData := ImageData;
5681           if (Info.biHeight > 0) then
5682             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5683           for i := 0 to Abs(Info.biHeight)-1 do begin
5684             if Assigned(SpecialFormat) then
5685               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5686             else
5687               aStream.Read(TmpData^, wbLineSize);   //else only read data
5688             if (Info.biHeight > 0) then
5689               dec(TmpData, wbLineSize)
5690             else
5691               inc(TmpData, wbLineSize);
5692             aStream.Read(PaddingBuff{%H-}, Padding);
5693           end;
5694           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5695           result := true;
5696         finally
5697           if Assigned(LineBuf) then
5698             FreeMem(LineBuf);
5699           if Assigned(SourceMD) then
5700             SpecialFormat.FreeMappingData(SourceMD);
5701           FormatDesc.FreeMappingData(DestMD);
5702         end;
5703         except
5704           if Assigned(ImageData) then
5705             FreeMem(ImageData);
5706           raise;
5707         end;
5708       end else
5709         raise EglBitmap.Create('LoadBMP - No suitable format found');
5710     except
5711       aStream.Position := StartPos;
5712       raise;
5713     end;
5714     finally
5715       FreeAndNil(SpecialFormat);
5716     end;
5717   end
5718     else aStream.Position := StartPos;
5719 end;
5720
5721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5722 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5723 var
5724   Header: TBMPHeader;
5725   Info: TBMPInfo;
5726   Converter: TFormatDescriptor;
5727   FormatDesc: TFormatDescriptor;
5728   SourceFD, DestFD: Pointer;
5729   pData, srcData, dstData, ConvertBuffer: pByte;
5730
5731   Pixel: TglBitmapPixelData;
5732   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5733   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5734
5735   PaddingBuff: Cardinal;
5736
5737   function GetLineWidth : Integer;
5738   begin
5739     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5740   end;
5741
5742 begin
5743   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5744     raise EglBitmapUnsupportedFormat.Create(Format);
5745
5746   Converter  := nil;
5747   FormatDesc := TFormatDescriptor.Get(Format);
5748   ImageSize  := FormatDesc.GetSize(Dimension);
5749
5750   FillChar(Header{%H-}, SizeOf(Header), 0);
5751   Header.bfType      := BMP_MAGIC;
5752   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5753   Header.bfReserved1 := 0;
5754   Header.bfReserved2 := 0;
5755   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5756
5757   FillChar(Info{%H-}, SizeOf(Info), 0);
5758   Info.biSize        := SizeOf(Info);
5759   Info.biWidth       := Width;
5760   Info.biHeight      := Height;
5761   Info.biPlanes      := 1;
5762   Info.biCompression := BMP_COMP_RGB;
5763   Info.biSizeImage   := ImageSize;
5764
5765   try
5766     case Format of
5767       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5768       begin
5769         Info.biBitCount  :=  8;
5770         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5771         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5772         Converter := TbmpColorTableFormat.Create;
5773         with (Converter as TbmpColorTableFormat) do begin
5774           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5775           CreateColorTable;
5776         end;
5777       end;
5778
5779       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5780       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5781       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5782       begin
5783         Info.biBitCount    := 16;
5784         Info.biCompression := BMP_COMP_BITFIELDS;
5785       end;
5786
5787       tfBGR8ub3, tfRGB8ub3:
5788       begin
5789         Info.biBitCount := 24;
5790         if (Format = tfRGB8ub3) then
5791           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5792       end;
5793
5794       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5795       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5796       begin
5797         Info.biBitCount    := 32;
5798         Info.biCompression := BMP_COMP_BITFIELDS;
5799       end;
5800     else
5801       raise EglBitmapUnsupportedFormat.Create(Format);
5802     end;
5803     Info.biXPelsPerMeter := 2835;
5804     Info.biYPelsPerMeter := 2835;
5805
5806     // prepare bitmasks
5807     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5808       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5809       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5810
5811       RedMask    := FormatDesc.Mask.r;
5812       GreenMask  := FormatDesc.Mask.g;
5813       BlueMask   := FormatDesc.Mask.b;
5814       AlphaMask  := FormatDesc.Mask.a;
5815     end;
5816
5817     // headers
5818     aStream.Write(Header, SizeOf(Header));
5819     aStream.Write(Info, SizeOf(Info));
5820
5821     // colortable
5822     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5823       with (Converter as TbmpColorTableFormat) do
5824         aStream.Write(ColorTable[0].b,
5825           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5826
5827     // bitmasks
5828     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5829       aStream.Write(RedMask,   SizeOf(Cardinal));
5830       aStream.Write(GreenMask, SizeOf(Cardinal));
5831       aStream.Write(BlueMask,  SizeOf(Cardinal));
5832       aStream.Write(AlphaMask, SizeOf(Cardinal));
5833     end;
5834
5835     // image data
5836     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5837     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5838     Padding     := GetLineWidth - wbLineSize;
5839     PaddingBuff := 0;
5840
5841     pData := Data;
5842     inc(pData, (Height-1) * rbLineSize);
5843
5844     // prepare row buffer. But only for RGB because RGBA supports color masks
5845     // so it's possible to change color within the image.
5846     if Assigned(Converter) then begin
5847       FormatDesc.PreparePixel(Pixel);
5848       GetMem(ConvertBuffer, wbLineSize);
5849       SourceFD := FormatDesc.CreateMappingData;
5850       DestFD   := Converter.CreateMappingData;
5851     end else
5852       ConvertBuffer := nil;
5853
5854     try
5855       for LineIdx := 0 to Height - 1 do begin
5856         // preparing row
5857         if Assigned(Converter) then begin
5858           srcData := pData;
5859           dstData := ConvertBuffer;
5860           for PixelIdx := 0 to Info.biWidth-1 do begin
5861             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5862             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5863             Converter.Map(Pixel, dstData, DestFD);
5864           end;
5865           aStream.Write(ConvertBuffer^, wbLineSize);
5866         end else begin
5867           aStream.Write(pData^, rbLineSize);
5868         end;
5869         dec(pData, rbLineSize);
5870         if (Padding > 0) then
5871           aStream.Write(PaddingBuff, Padding);
5872       end;
5873     finally
5874       // destroy row buffer
5875       if Assigned(ConvertBuffer) then begin
5876         FormatDesc.FreeMappingData(SourceFD);
5877         Converter.FreeMappingData(DestFD);
5878         FreeMem(ConvertBuffer);
5879       end;
5880     end;
5881   finally
5882     if Assigned(Converter) then
5883       Converter.Free;
5884   end;
5885 end;
5886
5887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5888 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5890 type
5891   TTGAHeader = packed record
5892     ImageID: Byte;
5893     ColorMapType: Byte;
5894     ImageType: Byte;
5895     //ColorMapSpec: Array[0..4] of Byte;
5896     ColorMapStart: Word;
5897     ColorMapLength: Word;
5898     ColorMapEntrySize: Byte;
5899     OrigX: Word;
5900     OrigY: Word;
5901     Width: Word;
5902     Height: Word;
5903     Bpp: Byte;
5904     ImageDesc: Byte;
5905   end;
5906
5907 const
5908   TGA_UNCOMPRESSED_RGB  =  2;
5909   TGA_UNCOMPRESSED_GRAY =  3;
5910   TGA_COMPRESSED_RGB    = 10;
5911   TGA_COMPRESSED_GRAY   = 11;
5912
5913   TGA_NONE_COLOR_TABLE  = 0;
5914
5915 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5916 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5917 var
5918   Header: TTGAHeader;
5919   ImageData: System.PByte;
5920   StartPosition: Int64;
5921   PixelSize, LineSize: Integer;
5922   tgaFormat: TglBitmapFormat;
5923   FormatDesc: TFormatDescriptor;
5924   Counter: packed record
5925     X, Y: packed record
5926       low, high, dir: Integer;
5927     end;
5928   end;
5929
5930 const
5931   CACHE_SIZE = $4000;
5932
5933   ////////////////////////////////////////////////////////////////////////////////////////
5934   procedure ReadUncompressed;
5935   var
5936     i, j: Integer;
5937     buf, tmp1, tmp2: System.PByte;
5938   begin
5939     buf := nil;
5940     if (Counter.X.dir < 0) then
5941       GetMem(buf, LineSize);
5942     try
5943       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5944         tmp1 := ImageData;
5945         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5946         if (Counter.X.dir < 0) then begin               //flip X
5947           aStream.Read(buf^, LineSize);
5948           tmp2 := buf;
5949           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5950           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5951             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5952               tmp1^ := tmp2^;
5953               inc(tmp1);
5954               inc(tmp2);
5955             end;
5956             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5957           end;
5958         end else
5959           aStream.Read(tmp1^, LineSize);
5960         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5961       end;
5962     finally
5963       if Assigned(buf) then
5964         FreeMem(buf);
5965     end;
5966   end;
5967
5968   ////////////////////////////////////////////////////////////////////////////////////////
5969   procedure ReadCompressed;
5970
5971     /////////////////////////////////////////////////////////////////
5972     var
5973       TmpData: System.PByte;
5974       LinePixelsRead: Integer;
5975     procedure CheckLine;
5976     begin
5977       if (LinePixelsRead >= Header.Width) then begin
5978         LinePixelsRead := 0;
5979         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5980         TmpData := ImageData;
5981         inc(TmpData, Counter.Y.low * LineSize);           //set line
5982         if (Counter.X.dir < 0) then                       //if x flipped then
5983           inc(TmpData, LineSize - PixelSize);             //set last pixel
5984       end;
5985     end;
5986
5987     /////////////////////////////////////////////////////////////////
5988     var
5989       Cache: PByte;
5990       CacheSize, CachePos: Integer;
5991     procedure CachedRead(out Buffer; Count: Integer);
5992     var
5993       BytesRead: Integer;
5994     begin
5995       if (CachePos + Count > CacheSize) then begin
5996         //if buffer overflow save non read bytes
5997         BytesRead := 0;
5998         if (CacheSize - CachePos > 0) then begin
5999           BytesRead := CacheSize - CachePos;
6000           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6001           inc(CachePos, BytesRead);
6002         end;
6003
6004         //load cache from file
6005         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6006         aStream.Read(Cache^, CacheSize);
6007         CachePos := 0;
6008
6009         //read rest of requested bytes
6010         if (Count - BytesRead > 0) then begin
6011           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6012           inc(CachePos, Count - BytesRead);
6013         end;
6014       end else begin
6015         //if no buffer overflow just read the data
6016         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6017         inc(CachePos, Count);
6018       end;
6019     end;
6020
6021     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6022     begin
6023       case PixelSize of
6024         1: begin
6025           aBuffer^ := aData^;
6026           inc(aBuffer, Counter.X.dir);
6027         end;
6028         2: begin
6029           PWord(aBuffer)^ := PWord(aData)^;
6030           inc(aBuffer, 2 * Counter.X.dir);
6031         end;
6032         3: begin
6033           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6034           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6035           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6036           inc(aBuffer, 3 * Counter.X.dir);
6037         end;
6038         4: begin
6039           PCardinal(aBuffer)^ := PCardinal(aData)^;
6040           inc(aBuffer, 4 * Counter.X.dir);
6041         end;
6042       end;
6043     end;
6044
6045   var
6046     TotalPixelsToRead, TotalPixelsRead: Integer;
6047     Temp: Byte;
6048     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6049     PixelRepeat: Boolean;
6050     PixelsToRead, PixelCount: Integer;
6051   begin
6052     CacheSize := 0;
6053     CachePos  := 0;
6054
6055     TotalPixelsToRead := Header.Width * Header.Height;
6056     TotalPixelsRead   := 0;
6057     LinePixelsRead    := 0;
6058
6059     GetMem(Cache, CACHE_SIZE);
6060     try
6061       TmpData := ImageData;
6062       inc(TmpData, Counter.Y.low * LineSize);           //set line
6063       if (Counter.X.dir < 0) then                       //if x flipped then
6064         inc(TmpData, LineSize - PixelSize);             //set last pixel
6065
6066       repeat
6067         //read CommandByte
6068         CachedRead(Temp, 1);
6069         PixelRepeat  := (Temp and $80) > 0;
6070         PixelsToRead := (Temp and $7F) + 1;
6071         inc(TotalPixelsRead, PixelsToRead);
6072
6073         if PixelRepeat then
6074           CachedRead(buf[0], PixelSize);
6075         while (PixelsToRead > 0) do begin
6076           CheckLine;
6077           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6078           while (PixelCount > 0) do begin
6079             if not PixelRepeat then
6080               CachedRead(buf[0], PixelSize);
6081             PixelToBuffer(@buf[0], TmpData);
6082             inc(LinePixelsRead);
6083             dec(PixelsToRead);
6084             dec(PixelCount);
6085           end;
6086         end;
6087       until (TotalPixelsRead >= TotalPixelsToRead);
6088     finally
6089       FreeMem(Cache);
6090     end;
6091   end;
6092
6093   function IsGrayFormat: Boolean;
6094   begin
6095     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6096   end;
6097
6098 begin
6099   result := false;
6100
6101   // reading header to test file and set cursor back to begin
6102   StartPosition := aStream.Position;
6103   aStream.Read(Header{%H-}, SizeOf(Header));
6104
6105   // no colormapped files
6106   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6107     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6108   begin
6109     try
6110       if Header.ImageID <> 0 then       // skip image ID
6111         aStream.Position := aStream.Position + Header.ImageID;
6112
6113       tgaFormat := tfEmpty;
6114       case Header.Bpp of
6115          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6116                0: tgaFormat := tfLuminance8ub1;
6117                8: tgaFormat := tfAlpha8ub1;
6118             end;
6119
6120         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6121                0: tgaFormat := tfLuminance16us1;
6122                8: tgaFormat := tfLuminance8Alpha8ub2;
6123             end else case (Header.ImageDesc and $F) of
6124                0: tgaFormat := tfX1RGB5us1;
6125                1: tgaFormat := tfA1RGB5us1;
6126                4: tgaFormat := tfARGB4us1;
6127             end;
6128
6129         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6130                0: tgaFormat := tfBGR8ub3;
6131             end;
6132
6133         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6134                0: tgaFormat := tfDepth32ui1;
6135             end else case (Header.ImageDesc and $F) of
6136                0: tgaFormat := tfX2RGB10ui1;
6137                2: tgaFormat := tfA2RGB10ui1;
6138                8: tgaFormat := tfARGB8ui1;
6139             end;
6140       end;
6141
6142       if (tgaFormat = tfEmpty) then
6143         raise EglBitmap.Create('LoadTga - unsupported format');
6144
6145       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6146       PixelSize  := FormatDesc.GetSize(1, 1);
6147       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6148
6149       GetMem(ImageData, LineSize * Header.Height);
6150       try
6151         //column direction
6152         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6153           Counter.X.low  := Header.Height-1;;
6154           Counter.X.high := 0;
6155           Counter.X.dir  := -1;
6156         end else begin
6157           Counter.X.low  := 0;
6158           Counter.X.high := Header.Height-1;
6159           Counter.X.dir  := 1;
6160         end;
6161
6162         // Row direction
6163         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6164           Counter.Y.low  := 0;
6165           Counter.Y.high := Header.Height-1;
6166           Counter.Y.dir  := 1;
6167         end else begin
6168           Counter.Y.low  := Header.Height-1;;
6169           Counter.Y.high := 0;
6170           Counter.Y.dir  := -1;
6171         end;
6172
6173         // Read Image
6174         case Header.ImageType of
6175           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6176             ReadUncompressed;
6177           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6178             ReadCompressed;
6179         end;
6180
6181         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6182         result := true;
6183       except
6184         if Assigned(ImageData) then
6185           FreeMem(ImageData);
6186         raise;
6187       end;
6188     finally
6189       aStream.Position := StartPosition;
6190     end;
6191   end
6192     else aStream.Position := StartPosition;
6193 end;
6194
6195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6196 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6197 var
6198   Header: TTGAHeader;
6199   Size: Integer;
6200   FormatDesc: TFormatDescriptor;
6201 begin
6202   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6203     raise EglBitmapUnsupportedFormat.Create(Format);
6204
6205   //prepare header
6206   FormatDesc := TFormatDescriptor.Get(Format);
6207   FillChar(Header{%H-}, SizeOf(Header), 0);
6208   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6209   Header.Bpp       := FormatDesc.BitsPerPixel;
6210   Header.Width     := Width;
6211   Header.Height    := Height;
6212   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6213   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6214     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6215   else
6216     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6217   aStream.Write(Header, SizeOf(Header));
6218
6219   // write Data
6220   Size := FormatDesc.GetSize(Dimension);
6221   aStream.Write(Data^, Size);
6222 end;
6223
6224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6225 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6227 const
6228   DDS_MAGIC: Cardinal         = $20534444;
6229
6230   // DDS_header.dwFlags
6231   DDSD_CAPS                   = $00000001;
6232   DDSD_HEIGHT                 = $00000002;
6233   DDSD_WIDTH                  = $00000004;
6234   DDSD_PIXELFORMAT            = $00001000;
6235
6236   // DDS_header.sPixelFormat.dwFlags
6237   DDPF_ALPHAPIXELS            = $00000001;
6238   DDPF_ALPHA                  = $00000002;
6239   DDPF_FOURCC                 = $00000004;
6240   DDPF_RGB                    = $00000040;
6241   DDPF_LUMINANCE              = $00020000;
6242
6243   // DDS_header.sCaps.dwCaps1
6244   DDSCAPS_TEXTURE             = $00001000;
6245
6246   // DDS_header.sCaps.dwCaps2
6247   DDSCAPS2_CUBEMAP            = $00000200;
6248
6249   D3DFMT_DXT1                 = $31545844;
6250   D3DFMT_DXT3                 = $33545844;
6251   D3DFMT_DXT5                 = $35545844;
6252
6253 type
6254   TDDSPixelFormat = packed record
6255     dwSize: Cardinal;
6256     dwFlags: Cardinal;
6257     dwFourCC: Cardinal;
6258     dwRGBBitCount: Cardinal;
6259     dwRBitMask: Cardinal;
6260     dwGBitMask: Cardinal;
6261     dwBBitMask: Cardinal;
6262     dwABitMask: Cardinal;
6263   end;
6264
6265   TDDSCaps = packed record
6266     dwCaps1: Cardinal;
6267     dwCaps2: Cardinal;
6268     dwDDSX: Cardinal;
6269     dwReserved: Cardinal;
6270   end;
6271
6272   TDDSHeader = packed record
6273     dwSize: Cardinal;
6274     dwFlags: Cardinal;
6275     dwHeight: Cardinal;
6276     dwWidth: Cardinal;
6277     dwPitchOrLinearSize: Cardinal;
6278     dwDepth: Cardinal;
6279     dwMipMapCount: Cardinal;
6280     dwReserved: array[0..10] of Cardinal;
6281     PixelFormat: TDDSPixelFormat;
6282     Caps: TDDSCaps;
6283     dwReserved2: Cardinal;
6284   end;
6285
6286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6287 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6288 var
6289   Header: TDDSHeader;
6290   Converter: TbmpBitfieldFormat;
6291
6292   function GetDDSFormat: TglBitmapFormat;
6293   var
6294     fd: TFormatDescriptor;
6295     i: Integer;
6296     Mask: TglBitmapRec4ul;
6297     Range: TglBitmapRec4ui;
6298     match: Boolean;
6299   begin
6300     result := tfEmpty;
6301     with Header.PixelFormat do begin
6302       // Compresses
6303       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6304         case Header.PixelFormat.dwFourCC of
6305           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6306           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6307           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6308         end;
6309       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6310         // prepare masks
6311         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6312           Mask.r := dwRBitMask;
6313           Mask.g := dwGBitMask;
6314           Mask.b := dwBBitMask;
6315         end else begin
6316           Mask.r := dwRBitMask;
6317           Mask.g := dwRBitMask;
6318           Mask.b := dwRBitMask;
6319         end;
6320         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6321           Mask.a := dwABitMask
6322         else
6323           Mask.a := 0;;
6324
6325         //find matching format
6326         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6327         result := fd.Format;
6328         if (result <> tfEmpty) then
6329           exit;
6330
6331         //find format with same Range
6332         for i := 0 to 3 do
6333           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6334         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6335           fd := TFormatDescriptor.Get(result);
6336           match := true;
6337           for i := 0 to 3 do
6338             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6339               match := false;
6340               break;
6341             end;
6342           if match then
6343             break;
6344         end;
6345
6346         //no format with same range found -> use default
6347         if (result = tfEmpty) then begin
6348           if (dwABitMask > 0) then
6349             result := tfRGBA8ui1
6350           else
6351             result := tfRGB8ub3;
6352         end;
6353
6354         Converter := TbmpBitfieldFormat.Create;
6355         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6356       end;
6357     end;
6358   end;
6359
6360 var
6361   StreamPos: Int64;
6362   x, y, LineSize, RowSize, Magic: Cardinal;
6363   NewImage, TmpData, RowData, SrcData: System.PByte;
6364   SourceMD, DestMD: Pointer;
6365   Pixel: TglBitmapPixelData;
6366   ddsFormat: TglBitmapFormat;
6367   FormatDesc: TFormatDescriptor;
6368
6369 begin
6370   result    := false;
6371   Converter := nil;
6372   StreamPos := aStream.Position;
6373
6374   // Magic
6375   aStream.Read(Magic{%H-}, sizeof(Magic));
6376   if (Magic <> DDS_MAGIC) then begin
6377     aStream.Position := StreamPos;
6378     exit;
6379   end;
6380
6381   //Header
6382   aStream.Read(Header{%H-}, sizeof(Header));
6383   if (Header.dwSize <> SizeOf(Header)) or
6384      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6385         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6386   begin
6387     aStream.Position := StreamPos;
6388     exit;
6389   end;
6390
6391   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6392     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6393
6394   ddsFormat := GetDDSFormat;
6395   try
6396     if (ddsFormat = tfEmpty) then
6397       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6398
6399     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6400     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6401     GetMem(NewImage, Header.dwHeight * LineSize);
6402     try
6403       TmpData := NewImage;
6404
6405       //Converter needed
6406       if Assigned(Converter) then begin
6407         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6408         GetMem(RowData, RowSize);
6409         SourceMD := Converter.CreateMappingData;
6410         DestMD   := FormatDesc.CreateMappingData;
6411         try
6412           for y := 0 to Header.dwHeight-1 do begin
6413             TmpData := NewImage;
6414             inc(TmpData, y * LineSize);
6415             SrcData := RowData;
6416             aStream.Read(SrcData^, RowSize);
6417             for x := 0 to Header.dwWidth-1 do begin
6418               Converter.Unmap(SrcData, Pixel, SourceMD);
6419               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6420               FormatDesc.Map(Pixel, TmpData, DestMD);
6421             end;
6422           end;
6423         finally
6424           Converter.FreeMappingData(SourceMD);
6425           FormatDesc.FreeMappingData(DestMD);
6426           FreeMem(RowData);
6427         end;
6428       end else
6429
6430       // Compressed
6431       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6432         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6433         for Y := 0 to Header.dwHeight-1 do begin
6434           aStream.Read(TmpData^, RowSize);
6435           Inc(TmpData, LineSize);
6436         end;
6437       end else
6438
6439       // Uncompressed
6440       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6441         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6442         for Y := 0 to Header.dwHeight-1 do begin
6443           aStream.Read(TmpData^, RowSize);
6444           Inc(TmpData, LineSize);
6445         end;
6446       end else
6447         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6448
6449       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6450       result := true;
6451     except
6452       if Assigned(NewImage) then
6453         FreeMem(NewImage);
6454       raise;
6455     end;
6456   finally
6457     FreeAndNil(Converter);
6458   end;
6459 end;
6460
6461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6462 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6463 var
6464   Header: TDDSHeader;
6465   FormatDesc: TFormatDescriptor;
6466 begin
6467   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6468     raise EglBitmapUnsupportedFormat.Create(Format);
6469
6470   FormatDesc := TFormatDescriptor.Get(Format);
6471
6472   // Generell
6473   FillChar(Header{%H-}, SizeOf(Header), 0);
6474   Header.dwSize  := SizeOf(Header);
6475   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6476
6477   Header.dwWidth  := Max(1, Width);
6478   Header.dwHeight := Max(1, Height);
6479
6480   // Caps
6481   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6482
6483   // Pixelformat
6484   Header.PixelFormat.dwSize := sizeof(Header);
6485   if (FormatDesc.IsCompressed) then begin
6486     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6487     case Format of
6488       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6489       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6490       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6491     end;
6492   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6493     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6494     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6495     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6496   end else if FormatDesc.IsGrayscale then begin
6497     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6498     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6499     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6500     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6501   end else begin
6502     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6503     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6504     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6505     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6506     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6507     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6508   end;
6509
6510   if (FormatDesc.HasAlpha) then
6511     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6512
6513   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6514   aStream.Write(Header, SizeOf(Header));
6515   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6516 end;
6517
6518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6519 function TglBitmapData.FlipHorz: Boolean;
6520 var
6521   fd: TglBitmapFormatDescriptor;
6522   Col, RowSize, PixelSize: Integer;
6523   pTempDest, pDest, pSource: PByte;
6524 begin
6525   result    := false;
6526   fd        := FormatDescriptor;
6527   PixelSize := Ceil(fd.BytesPerPixel);
6528   RowSize   := fd.GetSize(Width, 1);
6529   if Assigned(Data) and not fd.IsCompressed then begin
6530     pSource := Data;
6531     GetMem(pDest, RowSize);
6532     try
6533       pTempDest := pDest;
6534       Inc(pTempDest, RowSize);
6535       for Col := 0 to Width-1 do begin
6536         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6537         Move(pSource^, pTempDest^, PixelSize);
6538         Inc(pSource, PixelSize);
6539       end;
6540       SetData(pDest, Format, Width);
6541       result := true;
6542     except
6543       if Assigned(pDest) then
6544         FreeMem(pDest);
6545       raise;
6546     end;
6547   end;
6548 end;
6549
6550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6551 function TglBitmapData.FlipVert: Boolean;
6552 var
6553   fd: TglBitmapFormatDescriptor;
6554   Row, RowSize, PixelSize: Integer;
6555   TempDestData, DestData, SourceData: PByte;
6556 begin
6557   result    := false;
6558   fd        := FormatDescriptor;
6559   PixelSize := Ceil(fd.BytesPerPixel);
6560   RowSize   := fd.GetSize(Width, 1);
6561   if Assigned(Data) then begin
6562     SourceData := Data;
6563     GetMem(DestData, Height * RowSize);
6564     try
6565       TempDestData := DestData;
6566       Inc(TempDestData, Width * (Height -1) * PixelSize);
6567       for Row := 0 to Height -1 do begin
6568         Move(SourceData^, TempDestData^, RowSize);
6569         Dec(TempDestData, RowSize);
6570         Inc(SourceData, RowSize);
6571       end;
6572       SetData(DestData, Format, Width, Height);
6573       result := true;
6574     except
6575       if Assigned(DestData) then
6576         FreeMem(DestData);
6577       raise;
6578     end;
6579   end;
6580 end;
6581
6582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6583 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6584 var
6585   fs: TFileStream;
6586 begin
6587   if not FileExists(aFilename) then
6588     raise EglBitmap.Create('file does not exist: ' + aFilename);
6589   fs := TFileStream.Create(aFilename, fmOpenRead);
6590   try
6591     fs.Position := 0;
6592     LoadFromStream(fs);
6593     fFilename := aFilename;
6594   finally
6595     fs.Free;
6596   end;
6597 end;
6598
6599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6600 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6601 begin
6602   {$IFDEF GLB_SUPPORT_PNG_READ}
6603   if not LoadPNG(aStream) then
6604   {$ENDIF}
6605   {$IFDEF GLB_SUPPORT_JPEG_READ}
6606   if not LoadJPEG(aStream) then
6607   {$ENDIF}
6608   if not LoadDDS(aStream) then
6609   if not LoadTGA(aStream) then
6610   if not LoadBMP(aStream) then
6611   if not LoadRAW(aStream) then
6612     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6613 end;
6614
6615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6616 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6617   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6618 var
6619   tmpData: PByte;
6620   size: Integer;
6621 begin
6622   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6623   GetMem(tmpData, size);
6624   try
6625     FillChar(tmpData^, size, #$FF);
6626     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6627   except
6628     if Assigned(tmpData) then
6629       FreeMem(tmpData);
6630     raise;
6631   end;
6632   Convert(Self, aFunc, false, aFormat, aArgs);
6633 end;
6634
6635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6636 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6637 var
6638   rs: TResourceStream;
6639 begin
6640   PrepareResType(aResource, aResType);
6641   rs := TResourceStream.Create(aInstance, aResource, aResType);
6642   try
6643     LoadFromStream(rs);
6644   finally
6645     rs.Free;
6646   end;
6647 end;
6648
6649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6650 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6651 var
6652   rs: TResourceStream;
6653 begin
6654   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6655   try
6656     LoadFromStream(rs);
6657   finally
6658     rs.Free;
6659   end;
6660 end;
6661
6662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6663 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6664 var
6665   fs: TFileStream;
6666 begin
6667   fs := TFileStream.Create(aFileName, fmCreate);
6668   try
6669     fs.Position := 0;
6670     SaveToStream(fs, aFileType);
6671   finally
6672     fs.Free;
6673   end;
6674 end;
6675
6676 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6677 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6678 begin
6679   case aFileType of
6680     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6681     ftPNG:  SavePNG(aStream);
6682     {$ENDIF}
6683     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6684     ftJPEG: SaveJPEG(aStream);
6685     {$ENDIF}
6686     ftDDS:  SaveDDS(aStream);
6687     ftTGA:  SaveTGA(aStream);
6688     ftBMP:  SaveBMP(aStream);
6689     ftRAW:  SaveRAW(aStream);
6690   end;
6691 end;
6692
6693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6694 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6695 begin
6696   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6697 end;
6698
6699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6700 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6701   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6702 var
6703   DestData, TmpData, SourceData: pByte;
6704   TempHeight, TempWidth: Integer;
6705   SourceFD, DestFD: TFormatDescriptor;
6706   SourceMD, DestMD: Pointer;
6707
6708   FuncRec: TglBitmapFunctionRec;
6709 begin
6710   Assert(Assigned(Data));
6711   Assert(Assigned(aSource));
6712   Assert(Assigned(aSource.Data));
6713
6714   result := false;
6715   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6716     SourceFD := TFormatDescriptor.Get(aSource.Format);
6717     DestFD   := TFormatDescriptor.Get(aFormat);
6718
6719     if (SourceFD.IsCompressed) then
6720       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6721     if (DestFD.IsCompressed) then
6722       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6723
6724     // inkompatible Formats so CreateTemp
6725     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6726       aCreateTemp := true;
6727
6728     // Values
6729     TempHeight := Max(1, aSource.Height);
6730     TempWidth  := Max(1, aSource.Width);
6731
6732     FuncRec.Sender := Self;
6733     FuncRec.Args   := aArgs;
6734
6735     TmpData := nil;
6736     if aCreateTemp then begin
6737       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6738       DestData := TmpData;
6739     end else
6740       DestData := Data;
6741
6742     try
6743       SourceFD.PreparePixel(FuncRec.Source);
6744       DestFD.PreparePixel  (FuncRec.Dest);
6745
6746       SourceMD := SourceFD.CreateMappingData;
6747       DestMD   := DestFD.CreateMappingData;
6748
6749       FuncRec.Size            := aSource.Dimension;
6750       FuncRec.Position.Fields := FuncRec.Size.Fields;
6751
6752       try
6753         SourceData := aSource.Data;
6754         FuncRec.Position.Y := 0;
6755         while FuncRec.Position.Y < TempHeight do begin
6756           FuncRec.Position.X := 0;
6757           while FuncRec.Position.X < TempWidth do begin
6758             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6759             aFunc(FuncRec);
6760             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6761             inc(FuncRec.Position.X);
6762           end;
6763           inc(FuncRec.Position.Y);
6764         end;
6765
6766         // Updating Image or InternalFormat
6767         if aCreateTemp then
6768           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6769         else if (aFormat <> fFormat) then
6770           Format := aFormat;
6771
6772         result := true;
6773       finally
6774         SourceFD.FreeMappingData(SourceMD);
6775         DestFD.FreeMappingData(DestMD);
6776       end;
6777     except
6778       if aCreateTemp and Assigned(TmpData) then
6779         FreeMem(TmpData);
6780       raise;
6781     end;
6782   end;
6783 end;
6784
6785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6786 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6787 var
6788   SourceFD, DestFD: TFormatDescriptor;
6789   SourcePD, DestPD: TglBitmapPixelData;
6790   ShiftData: TShiftData;
6791
6792   function DataIsIdentical: Boolean;
6793   begin
6794     result := SourceFD.MaskMatch(DestFD.Mask);
6795   end;
6796
6797   function CanCopyDirect: Boolean;
6798   begin
6799     result :=
6800       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6801       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6802       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6803       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6804   end;
6805
6806   function CanShift: Boolean;
6807   begin
6808     result :=
6809       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6810       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6811       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6812       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6813   end;
6814
6815   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6816   begin
6817     result := 0;
6818     while (aSource > aDest) and (aSource > 0) do begin
6819       inc(result);
6820       aSource := aSource shr 1;
6821     end;
6822   end;
6823
6824 begin
6825   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6826     SourceFD := TFormatDescriptor.Get(Format);
6827     DestFD   := TFormatDescriptor.Get(aFormat);
6828
6829     if DataIsIdentical then begin
6830       result := true;
6831       Format := aFormat;
6832       exit;
6833     end;
6834
6835     SourceFD.PreparePixel(SourcePD);
6836     DestFD.PreparePixel  (DestPD);
6837
6838     if CanCopyDirect then
6839       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6840     else if CanShift then begin
6841       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6842       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6843       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6844       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6845       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6846     end else
6847       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6848   end else
6849     result := true;
6850 end;
6851
6852 {$IFDEF GLB_SDL}
6853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6854 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6855 var
6856   Row, RowSize: Integer;
6857   SourceData, TmpData: PByte;
6858   TempDepth: Integer;
6859   FormatDesc: TFormatDescriptor;
6860
6861   function GetRowPointer(Row: Integer): pByte;
6862   begin
6863     result := aSurface.pixels;
6864     Inc(result, Row * RowSize);
6865   end;
6866
6867 begin
6868   result := false;
6869
6870   FormatDesc := TFormatDescriptor.Get(Format);
6871   if FormatDesc.IsCompressed then
6872     raise EglBitmapUnsupportedFormat.Create(Format);
6873
6874   if Assigned(Data) then begin
6875     case Trunc(FormatDesc.PixelSize) of
6876       1: TempDepth :=  8;
6877       2: TempDepth := 16;
6878       3: TempDepth := 24;
6879       4: TempDepth := 32;
6880     else
6881       raise EglBitmapUnsupportedFormat.Create(Format);
6882     end;
6883
6884     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6885       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6886     SourceData := Data;
6887     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6888
6889     for Row := 0 to FileHeight-1 do begin
6890       TmpData := GetRowPointer(Row);
6891       if Assigned(TmpData) then begin
6892         Move(SourceData^, TmpData^, RowSize);
6893         inc(SourceData, RowSize);
6894       end;
6895     end;
6896     result := true;
6897   end;
6898 end;
6899
6900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6901 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6902 var
6903   pSource, pData, pTempData: PByte;
6904   Row, RowSize, TempWidth, TempHeight: Integer;
6905   IntFormat: TglBitmapFormat;
6906   fd: TFormatDescriptor;
6907   Mask: TglBitmapMask;
6908
6909   function GetRowPointer(Row: Integer): pByte;
6910   begin
6911     result := aSurface^.pixels;
6912     Inc(result, Row * RowSize);
6913   end;
6914
6915 begin
6916   result := false;
6917   if (Assigned(aSurface)) then begin
6918     with aSurface^.format^ do begin
6919       Mask.r := RMask;
6920       Mask.g := GMask;
6921       Mask.b := BMask;
6922       Mask.a := AMask;
6923       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6924       if (IntFormat = tfEmpty) then
6925         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6926     end;
6927
6928     fd := TFormatDescriptor.Get(IntFormat);
6929     TempWidth  := aSurface^.w;
6930     TempHeight := aSurface^.h;
6931     RowSize := fd.GetSize(TempWidth, 1);
6932     GetMem(pData, TempHeight * RowSize);
6933     try
6934       pTempData := pData;
6935       for Row := 0 to TempHeight -1 do begin
6936         pSource := GetRowPointer(Row);
6937         if (Assigned(pSource)) then begin
6938           Move(pSource^, pTempData^, RowSize);
6939           Inc(pTempData, RowSize);
6940         end;
6941       end;
6942       SetData(pData, IntFormat, TempWidth, TempHeight);
6943       result := true;
6944     except
6945       if Assigned(pData) then
6946         FreeMem(pData);
6947       raise;
6948     end;
6949   end;
6950 end;
6951
6952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6953 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6954 var
6955   Row, Col, AlphaInterleave: Integer;
6956   pSource, pDest: PByte;
6957
6958   function GetRowPointer(Row: Integer): pByte;
6959   begin
6960     result := aSurface.pixels;
6961     Inc(result, Row * Width);
6962   end;
6963
6964 begin
6965   result := false;
6966   if Assigned(Data) then begin
6967     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6968       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6969
6970       AlphaInterleave := 0;
6971       case Format of
6972         tfLuminance8Alpha8ub2:
6973           AlphaInterleave := 1;
6974         tfBGRA8ub4, tfRGBA8ub4:
6975           AlphaInterleave := 3;
6976       end;
6977
6978       pSource := Data;
6979       for Row := 0 to Height -1 do begin
6980         pDest := GetRowPointer(Row);
6981         if Assigned(pDest) then begin
6982           for Col := 0 to Width -1 do begin
6983             Inc(pSource, AlphaInterleave);
6984             pDest^ := pSource^;
6985             Inc(pDest);
6986             Inc(pSource);
6987           end;
6988         end;
6989       end;
6990       result := true;
6991     end;
6992   end;
6993 end;
6994
6995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6996 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6997 var
6998   bmp: TglBitmap2D;
6999 begin
7000   bmp := TglBitmap2D.Create;
7001   try
7002     bmp.AssignFromSurface(aSurface);
7003     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
7004   finally
7005     bmp.Free;
7006   end;
7007 end;
7008 {$ENDIF}
7009
7010 {$IFDEF GLB_DELPHI}
7011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7012 function CreateGrayPalette: HPALETTE;
7013 var
7014   Idx: Integer;
7015   Pal: PLogPalette;
7016 begin
7017   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
7018
7019   Pal.palVersion := $300;
7020   Pal.palNumEntries := 256;
7021
7022   for Idx := 0 to Pal.palNumEntries - 1 do begin
7023     Pal.palPalEntry[Idx].peRed   := Idx;
7024     Pal.palPalEntry[Idx].peGreen := Idx;
7025     Pal.palPalEntry[Idx].peBlue  := Idx;
7026     Pal.palPalEntry[Idx].peFlags := 0;
7027   end;
7028   Result := CreatePalette(Pal^);
7029   FreeMem(Pal);
7030 end;
7031
7032 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7033 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7034 var
7035   Row, RowSize: Integer;
7036   pSource, pData: PByte;
7037 begin
7038   result := false;
7039   if Assigned(Data) then begin
7040     if Assigned(aBitmap) then begin
7041       aBitmap.Width  := Width;
7042       aBitmap.Height := Height;
7043
7044       case Format of
7045         tfAlpha8ub1, tfLuminance8ub1: begin
7046           aBitmap.PixelFormat := pf8bit;
7047           aBitmap.Palette     := CreateGrayPalette;
7048         end;
7049         tfRGB5A1us1:
7050           aBitmap.PixelFormat := pf15bit;
7051         tfR5G6B5us1:
7052           aBitmap.PixelFormat := pf16bit;
7053         tfRGB8ub3, tfBGR8ub3:
7054           aBitmap.PixelFormat := pf24bit;
7055         tfRGBA8ub4, tfBGRA8ub4:
7056           aBitmap.PixelFormat := pf32bit;
7057       else
7058         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7059       end;
7060
7061       RowSize := FormatDescriptor.GetSize(Width, 1);
7062       pSource := Data;
7063       for Row := 0 to Height-1 do begin
7064         pData := aBitmap.Scanline[Row];
7065         Move(pSource^, pData^, RowSize);
7066         Inc(pSource, RowSize);
7067         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7068           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7069       end;
7070       result := true;
7071     end;
7072   end;
7073 end;
7074
7075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7076 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7077 var
7078   pSource, pData, pTempData: PByte;
7079   Row, RowSize, TempWidth, TempHeight: Integer;
7080   IntFormat: TglBitmapFormat;
7081 begin
7082   result := false;
7083
7084   if (Assigned(aBitmap)) then begin
7085     case aBitmap.PixelFormat of
7086       pf8bit:
7087         IntFormat := tfLuminance8ub1;
7088       pf15bit:
7089         IntFormat := tfRGB5A1us1;
7090       pf16bit:
7091         IntFormat := tfR5G6B5us1;
7092       pf24bit:
7093         IntFormat := tfBGR8ub3;
7094       pf32bit:
7095         IntFormat := tfBGRA8ub4;
7096     else
7097       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7098     end;
7099
7100     TempWidth  := aBitmap.Width;
7101     TempHeight := aBitmap.Height;
7102     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7103     GetMem(pData, TempHeight * RowSize);
7104     try
7105       pTempData := pData;
7106       for Row := 0 to TempHeight -1 do begin
7107         pSource := aBitmap.Scanline[Row];
7108         if (Assigned(pSource)) then begin
7109           Move(pSource^, pTempData^, RowSize);
7110           Inc(pTempData, RowSize);
7111         end;
7112       end;
7113       SetData(pData, IntFormat, TempWidth, TempHeight);
7114       result := true;
7115     except
7116       if Assigned(pData) then
7117         FreeMem(pData);
7118       raise;
7119     end;
7120   end;
7121 end;
7122
7123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7124 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7125 var
7126   Row, Col, AlphaInterleave: Integer;
7127   pSource, pDest: PByte;
7128 begin
7129   result := false;
7130
7131   if Assigned(Data) then begin
7132     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7133       if Assigned(aBitmap) then begin
7134         aBitmap.PixelFormat := pf8bit;
7135         aBitmap.Palette     := CreateGrayPalette;
7136         aBitmap.Width       := Width;
7137         aBitmap.Height      := Height;
7138
7139         case Format of
7140           tfLuminance8Alpha8ub2:
7141             AlphaInterleave := 1;
7142           tfRGBA8ub4, tfBGRA8ub4:
7143             AlphaInterleave := 3;
7144           else
7145             AlphaInterleave := 0;
7146         end;
7147
7148         // Copy Data
7149         pSource := Data;
7150
7151         for Row := 0 to Height -1 do begin
7152           pDest := aBitmap.Scanline[Row];
7153           if Assigned(pDest) then begin
7154             for Col := 0 to Width -1 do begin
7155               Inc(pSource, AlphaInterleave);
7156               pDest^ := pSource^;
7157               Inc(pDest);
7158               Inc(pSource);
7159             end;
7160           end;
7161         end;
7162         result := true;
7163       end;
7164     end;
7165   end;
7166 end;
7167
7168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7169 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7170 var
7171   data: TglBitmapData;
7172 begin
7173   data := TglBitmapData.Create;
7174   try
7175     data.AssignFromBitmap(aBitmap);
7176     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7177   finally
7178     data.Free;
7179   end;
7180 end;
7181 {$ENDIF}
7182
7183 {$IFDEF GLB_LAZARUS}
7184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7185 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7186 var
7187   rid: TRawImageDescription;
7188   FormatDesc: TFormatDescriptor;
7189 begin
7190   if not Assigned(Data) then
7191     raise EglBitmap.Create('no pixel data assigned. load data before save');
7192
7193   result := false;
7194   if not Assigned(aImage) or (Format = tfEmpty) then
7195     exit;
7196   FormatDesc := TFormatDescriptor.Get(Format);
7197   if FormatDesc.IsCompressed then
7198     exit;
7199
7200   FillChar(rid{%H-}, SizeOf(rid), 0);
7201   if FormatDesc.IsGrayscale then
7202     rid.Format := ricfGray
7203   else
7204     rid.Format := ricfRGBA;
7205
7206   rid.Width        := Width;
7207   rid.Height       := Height;
7208   rid.Depth        := FormatDesc.BitsPerPixel;
7209   rid.BitOrder     := riboBitsInOrder;
7210   rid.ByteOrder    := riboLSBFirst;
7211   rid.LineOrder    := riloTopToBottom;
7212   rid.LineEnd      := rileTight;
7213   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7214   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7215   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7216   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7217   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7218   rid.RedShift     := FormatDesc.Shift.r;
7219   rid.GreenShift   := FormatDesc.Shift.g;
7220   rid.BlueShift    := FormatDesc.Shift.b;
7221   rid.AlphaShift   := FormatDesc.Shift.a;
7222
7223   rid.MaskBitsPerPixel  := 0;
7224   rid.PaletteColorCount := 0;
7225
7226   aImage.DataDescription := rid;
7227   aImage.CreateData;
7228
7229   if not Assigned(aImage.PixelData) then
7230     raise EglBitmap.Create('error while creating LazIntfImage');
7231   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7232
7233   result := true;
7234 end;
7235
7236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7237 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7238 var
7239   f: TglBitmapFormat;
7240   FormatDesc: TFormatDescriptor;
7241   ImageData: PByte;
7242   ImageSize: Integer;
7243   CanCopy: Boolean;
7244   Mask: TglBitmapRec4ul;
7245
7246   procedure CopyConvert;
7247   var
7248     bfFormat: TbmpBitfieldFormat;
7249     pSourceLine, pDestLine: PByte;
7250     pSourceMD, pDestMD: Pointer;
7251     Shift, Prec: TglBitmapRec4ub;
7252     x, y: Integer;
7253     pixel: TglBitmapPixelData;
7254   begin
7255     bfFormat  := TbmpBitfieldFormat.Create;
7256     with aImage.DataDescription do begin
7257       Prec.r := RedPrec;
7258       Prec.g := GreenPrec;
7259       Prec.b := BluePrec;
7260       Prec.a := AlphaPrec;
7261       Shift.r := RedShift;
7262       Shift.g := GreenShift;
7263       Shift.b := BlueShift;
7264       Shift.a := AlphaShift;
7265       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7266     end;
7267     pSourceMD := bfFormat.CreateMappingData;
7268     pDestMD   := FormatDesc.CreateMappingData;
7269     try
7270       for y := 0 to aImage.Height-1 do begin
7271         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7272         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7273         for x := 0 to aImage.Width-1 do begin
7274           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7275           FormatDesc.Map(pixel, pDestLine, pDestMD);
7276         end;
7277       end;
7278     finally
7279       FormatDesc.FreeMappingData(pDestMD);
7280       bfFormat.FreeMappingData(pSourceMD);
7281       bfFormat.Free;
7282     end;
7283   end;
7284
7285 begin
7286   result := false;
7287   if not Assigned(aImage) then
7288     exit;
7289
7290   with aImage.DataDescription do begin
7291     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7292     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7293     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7294     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7295   end;
7296   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7297   f          := FormatDesc.Format;
7298   if (f = tfEmpty) then
7299     exit;
7300
7301   CanCopy :=
7302     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7303     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7304
7305   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7306   ImageData := GetMem(ImageSize);
7307   try
7308     if CanCopy then
7309       Move(aImage.PixelData^, ImageData^, ImageSize)
7310     else
7311       CopyConvert;
7312     SetData(ImageData, f, aImage.Width, aImage.Height);
7313   except
7314     if Assigned(ImageData) then
7315       FreeMem(ImageData);
7316     raise;
7317   end;
7318
7319   result := true;
7320 end;
7321
7322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7323 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7324 var
7325   rid: TRawImageDescription;
7326   FormatDesc: TFormatDescriptor;
7327   Pixel: TglBitmapPixelData;
7328   x, y: Integer;
7329   srcMD: Pointer;
7330   src, dst: PByte;
7331 begin
7332   result := false;
7333   if not Assigned(aImage) or (Format = tfEmpty) then
7334     exit;
7335   FormatDesc := TFormatDescriptor.Get(Format);
7336   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7337     exit;
7338
7339   FillChar(rid{%H-}, SizeOf(rid), 0);
7340   rid.Format       := ricfGray;
7341   rid.Width        := Width;
7342   rid.Height       := Height;
7343   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7344   rid.BitOrder     := riboBitsInOrder;
7345   rid.ByteOrder    := riboLSBFirst;
7346   rid.LineOrder    := riloTopToBottom;
7347   rid.LineEnd      := rileTight;
7348   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7349   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7350   rid.GreenPrec    := 0;
7351   rid.BluePrec     := 0;
7352   rid.AlphaPrec    := 0;
7353   rid.RedShift     := 0;
7354   rid.GreenShift   := 0;
7355   rid.BlueShift    := 0;
7356   rid.AlphaShift   := 0;
7357
7358   rid.MaskBitsPerPixel  := 0;
7359   rid.PaletteColorCount := 0;
7360
7361   aImage.DataDescription := rid;
7362   aImage.CreateData;
7363
7364   srcMD := FormatDesc.CreateMappingData;
7365   try
7366     FormatDesc.PreparePixel(Pixel);
7367     src := Data;
7368     dst := aImage.PixelData;
7369     for y := 0 to Height-1 do
7370       for x := 0 to Width-1 do begin
7371         FormatDesc.Unmap(src, Pixel, srcMD);
7372         case rid.BitsPerPixel of
7373            8: begin
7374             dst^ := Pixel.Data.a;
7375             inc(dst);
7376           end;
7377           16: begin
7378             PWord(dst)^ := Pixel.Data.a;
7379             inc(dst, 2);
7380           end;
7381           24: begin
7382             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7383             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7384             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7385             inc(dst, 3);
7386           end;
7387           32: begin
7388             PCardinal(dst)^ := Pixel.Data.a;
7389             inc(dst, 4);
7390           end;
7391         else
7392           raise EglBitmapUnsupportedFormat.Create(Format);
7393         end;
7394       end;
7395   finally
7396     FormatDesc.FreeMappingData(srcMD);
7397   end;
7398   result := true;
7399 end;
7400
7401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7402 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7403 var
7404   data: TglBitmapData;
7405 begin
7406   data := TglBitmapData.Create;
7407   try
7408     data.AssignFromLazIntfImage(aImage);
7409     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7410   finally
7411     data.Free;
7412   end;
7413 end;
7414 {$ENDIF}
7415
7416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7417 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7418   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7419 var
7420   rs: TResourceStream;
7421 begin
7422   PrepareResType(aResource, aResType);
7423   rs := TResourceStream.Create(aInstance, aResource, aResType);
7424   try
7425     result := AddAlphaFromStream(rs, aFunc, aArgs);
7426   finally
7427     rs.Free;
7428   end;
7429 end;
7430
7431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7432 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7433   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7434 var
7435   rs: TResourceStream;
7436 begin
7437   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7438   try
7439     result := AddAlphaFromStream(rs, aFunc, aArgs);
7440   finally
7441     rs.Free;
7442   end;
7443 end;
7444
7445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7446 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7447 begin
7448   if TFormatDescriptor.Get(Format).IsCompressed then
7449     raise EglBitmapUnsupportedFormat.Create(Format);
7450   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7451 end;
7452
7453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7454 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7455 var
7456   FS: TFileStream;
7457 begin
7458   FS := TFileStream.Create(aFileName, fmOpenRead);
7459   try
7460     result := AddAlphaFromStream(FS, aFunc, aArgs);
7461   finally
7462     FS.Free;
7463   end;
7464 end;
7465
7466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7467 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7468 var
7469   data: TglBitmapData;
7470 begin
7471   data := TglBitmapData.Create(aStream);
7472   try
7473     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7474   finally
7475     data.Free;
7476   end;
7477 end;
7478
7479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7480 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7481 var
7482   DestData, DestData2, SourceData: pByte;
7483   TempHeight, TempWidth: Integer;
7484   SourceFD, DestFD: TFormatDescriptor;
7485   SourceMD, DestMD, DestMD2: Pointer;
7486
7487   FuncRec: TglBitmapFunctionRec;
7488 begin
7489   result := false;
7490
7491   Assert(Assigned(Data));
7492   Assert(Assigned(aDataObj));
7493   Assert(Assigned(aDataObj.Data));
7494
7495   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7496     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7497
7498     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7499     DestFD   := TFormatDescriptor.Get(Format);
7500
7501     if not Assigned(aFunc) then begin
7502       aFunc        := glBitmapAlphaFunc;
7503       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7504     end else
7505       FuncRec.Args := aArgs;
7506
7507     // Values
7508     TempWidth  := aDataObj.Width;
7509     TempHeight := aDataObj.Height;
7510     if (TempWidth <= 0) or (TempHeight <= 0) then
7511       exit;
7512
7513     FuncRec.Sender          := Self;
7514     FuncRec.Size            := Dimension;
7515     FuncRec.Position.Fields := FuncRec.Size.Fields;
7516
7517     DestData   := Data;
7518     DestData2  := Data;
7519     SourceData := aDataObj.Data;
7520
7521     // Mapping
7522     SourceFD.PreparePixel(FuncRec.Source);
7523     DestFD.PreparePixel  (FuncRec.Dest);
7524
7525     SourceMD := SourceFD.CreateMappingData;
7526     DestMD   := DestFD.CreateMappingData;
7527     DestMD2  := DestFD.CreateMappingData;
7528     try
7529       FuncRec.Position.Y := 0;
7530       while FuncRec.Position.Y < TempHeight do begin
7531         FuncRec.Position.X := 0;
7532         while FuncRec.Position.X < TempWidth do begin
7533           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7534           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7535           aFunc(FuncRec);
7536           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7537           inc(FuncRec.Position.X);
7538         end;
7539         inc(FuncRec.Position.Y);
7540       end;
7541     finally
7542       SourceFD.FreeMappingData(SourceMD);
7543       DestFD.FreeMappingData(DestMD);
7544       DestFD.FreeMappingData(DestMD2);
7545     end;
7546   end;
7547 end;
7548
7549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7550 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7551 begin
7552   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7553 end;
7554
7555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7556 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7557 var
7558   PixelData: TglBitmapPixelData;
7559 begin
7560   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7561   result := AddAlphaFromColorKeyFloat(
7562     aRed   / PixelData.Range.r,
7563     aGreen / PixelData.Range.g,
7564     aBlue  / PixelData.Range.b,
7565     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7566 end;
7567
7568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7569 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7570 var
7571   values: array[0..2] of Single;
7572   tmp: Cardinal;
7573   i: Integer;
7574   PixelData: TglBitmapPixelData;
7575 begin
7576   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7577   with PixelData do begin
7578     values[0] := aRed;
7579     values[1] := aGreen;
7580     values[2] := aBlue;
7581
7582     for i := 0 to 2 do begin
7583       tmp          := Trunc(Range.arr[i] * aDeviation);
7584       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7585       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7586     end;
7587     Data.a  := 0;
7588     Range.a := 0;
7589   end;
7590   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7591 end;
7592
7593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7594 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7595 begin
7596   result := AddAlphaFromValueFloat(aAlpha / $FF);
7597 end;
7598
7599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7600 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7601 var
7602   PixelData: TglBitmapPixelData;
7603 begin
7604   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7605   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7606 end;
7607
7608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7609 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7610 var
7611   PixelData: TglBitmapPixelData;
7612 begin
7613   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7614   with PixelData do
7615     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7616   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7617 end;
7618
7619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7620 function TglBitmapData.RemoveAlpha: Boolean;
7621 var
7622   FormatDesc: TFormatDescriptor;
7623 begin
7624   result := false;
7625   FormatDesc := TFormatDescriptor.Get(Format);
7626   if Assigned(Data) then begin
7627     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7628       raise EglBitmapUnsupportedFormat.Create(Format);
7629     result := ConvertTo(FormatDesc.WithoutAlpha);
7630   end;
7631 end;
7632
7633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7634 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7635   const aAlpha: Byte);
7636 begin
7637   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7638 end;
7639
7640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7641 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7642 var
7643   PixelData: TglBitmapPixelData;
7644 begin
7645   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7646   FillWithColorFloat(
7647     aRed   / PixelData.Range.r,
7648     aGreen / PixelData.Range.g,
7649     aBlue  / PixelData.Range.b,
7650     aAlpha / PixelData.Range.a);
7651 end;
7652
7653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7654 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7655 var
7656   PixelData: TglBitmapPixelData;
7657 begin
7658   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7659   with PixelData do begin
7660     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7661     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7662     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7663     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7664   end;
7665   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7666 end;
7667
7668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7669 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7670 begin
7671   if (Data <> aData) then begin
7672     if (Assigned(Data)) then
7673       FreeMem(Data);
7674     fData := aData;
7675   end;
7676
7677   if Assigned(fData) then begin
7678     FillChar(fDimension, SizeOf(fDimension), 0);
7679     if aWidth <> -1 then begin
7680       fDimension.Fields := fDimension.Fields + [ffX];
7681       fDimension.X := aWidth;
7682     end;
7683
7684     if aHeight <> -1 then begin
7685       fDimension.Fields := fDimension.Fields + [ffY];
7686       fDimension.Y := aHeight;
7687     end;
7688
7689     fFormat := aFormat;
7690   end else
7691     fFormat := tfEmpty;
7692
7693   UpdateScanlines;
7694 end;
7695
7696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7697 function TglBitmapData.Clone: TglBitmapData;
7698 var
7699   Temp: TglBitmapData;
7700   TempPtr: PByte;
7701   Size: Integer;
7702 begin
7703   result := nil;
7704   Temp := (ClassType.Create as TglBitmapData);
7705   try
7706     // copy texture data if assigned
7707     if Assigned(Data) then begin
7708       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7709       GetMem(TempPtr, Size);
7710       try
7711         Move(Data^, TempPtr^, Size);
7712         Temp.SetData(TempPtr, Format, Width, Height);
7713       except
7714         if Assigned(TempPtr) then
7715           FreeMem(TempPtr);
7716         raise;
7717       end;
7718     end else begin
7719       TempPtr := nil;
7720       Temp.SetData(TempPtr, Format, Width, Height);
7721     end;
7722
7723           // copy properties
7724     Temp.fFormat := Format;
7725     result := Temp;
7726   except
7727     FreeAndNil(Temp);
7728     raise;
7729   end;
7730 end;
7731
7732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7733 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7734 var
7735   mask: PtrInt;
7736 begin
7737   mask :=
7738      (Byte(aRed)   and 1)        or
7739     ((Byte(aGreen) and 1) shl 1) or
7740     ((Byte(aBlue)  and 1) shl 2) or
7741     ((Byte(aAlpha) and 1) shl 3);
7742   if (mask > 0) then
7743     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7744 end;
7745
7746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7747 type
7748   TMatrixItem = record
7749     X, Y: Integer;
7750     W: Single;
7751   end;
7752
7753   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7754   TglBitmapToNormalMapRec = Record
7755     Scale: Single;
7756     Heights: array of Single;
7757     MatrixU : array of TMatrixItem;
7758     MatrixV : array of TMatrixItem;
7759   end;
7760
7761 const
7762   ONE_OVER_255 = 1 / 255;
7763
7764   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7765 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7766 var
7767   Val: Single;
7768 begin
7769   with FuncRec do begin
7770     Val :=
7771       Source.Data.r * LUMINANCE_WEIGHT_R +
7772       Source.Data.g * LUMINANCE_WEIGHT_G +
7773       Source.Data.b * LUMINANCE_WEIGHT_B;
7774     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7775   end;
7776 end;
7777
7778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7779 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7780 begin
7781   with FuncRec do
7782     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7783 end;
7784
7785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7786 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7787 type
7788   TVec = Array[0..2] of Single;
7789 var
7790   Idx: Integer;
7791   du, dv: Double;
7792   Len: Single;
7793   Vec: TVec;
7794
7795   function GetHeight(X, Y: Integer): Single;
7796   begin
7797     with FuncRec do begin
7798       X := Max(0, Min(Size.X -1, X));
7799       Y := Max(0, Min(Size.Y -1, Y));
7800       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7801     end;
7802   end;
7803
7804 begin
7805   with FuncRec do begin
7806     with PglBitmapToNormalMapRec(Args)^ do begin
7807       du := 0;
7808       for Idx := Low(MatrixU) to High(MatrixU) do
7809         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7810
7811       dv := 0;
7812       for Idx := Low(MatrixU) to High(MatrixU) do
7813         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7814
7815       Vec[0] := -du * Scale;
7816       Vec[1] := -dv * Scale;
7817       Vec[2] := 1;
7818     end;
7819
7820     // Normalize
7821     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7822     if Len <> 0 then begin
7823       Vec[0] := Vec[0] * Len;
7824       Vec[1] := Vec[1] * Len;
7825       Vec[2] := Vec[2] * Len;
7826     end;
7827
7828     // Farbe zuweisem
7829     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7830     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7831     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7832   end;
7833 end;
7834
7835 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7836 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7837 var
7838   Rec: TglBitmapToNormalMapRec;
7839
7840   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7841   begin
7842     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7843       Matrix[Index].X := X;
7844       Matrix[Index].Y := Y;
7845       Matrix[Index].W := W;
7846     end;
7847   end;
7848
7849 begin
7850   if TFormatDescriptor.Get(Format).IsCompressed then
7851     raise EglBitmapUnsupportedFormat.Create(Format);
7852
7853   if aScale > 100 then
7854     Rec.Scale := 100
7855   else if aScale < -100 then
7856     Rec.Scale := -100
7857   else
7858     Rec.Scale := aScale;
7859
7860   SetLength(Rec.Heights, Width * Height);
7861   try
7862     case aFunc of
7863       nm4Samples: begin
7864         SetLength(Rec.MatrixU, 2);
7865         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7866         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7867
7868         SetLength(Rec.MatrixV, 2);
7869         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7870         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7871       end;
7872
7873       nmSobel: begin
7874         SetLength(Rec.MatrixU, 6);
7875         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7876         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7877         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7878         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7879         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7880         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7881
7882         SetLength(Rec.MatrixV, 6);
7883         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7884         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7885         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7886         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7887         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7888         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7889       end;
7890
7891       nm3x3: begin
7892         SetLength(Rec.MatrixU, 6);
7893         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7894         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7895         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7896         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7897         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7898         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7899
7900         SetLength(Rec.MatrixV, 6);
7901         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7902         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7903         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7904         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7905         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7906         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7907       end;
7908
7909       nm5x5: begin
7910         SetLength(Rec.MatrixU, 20);
7911         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7912         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7913         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7914         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7915         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7916         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7917         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7918         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7919         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7920         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7921         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7922         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7923         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7924         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7925         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7926         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7927         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7928         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7929         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7930         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7931
7932         SetLength(Rec.MatrixV, 20);
7933         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7934         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7935         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7936         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7937         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7938         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7939         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7940         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7941         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7942         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7943         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7944         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7945         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7946         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7947         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7948         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7949         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7950         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7951         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7952         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7953       end;
7954     end;
7955
7956     // Daten Sammeln
7957     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7958       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7959     else
7960       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7961     Convert(glBitmapToNormalMapFunc, false, @Rec);
7962   finally
7963     SetLength(Rec.Heights, 0);
7964   end;
7965 end;
7966
7967 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7968 constructor TglBitmapData.Create;
7969 begin
7970   inherited Create;
7971   fFormat := glBitmapDefaultFormat;
7972 end;
7973
7974 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7975 constructor TglBitmapData.Create(const aFileName: String);
7976 begin
7977   Create;
7978   LoadFromFile(aFileName);
7979 end;
7980
7981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7982 constructor TglBitmapData.Create(const aStream: TStream);
7983 begin
7984   Create;
7985   LoadFromStream(aStream);
7986 end;
7987
7988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7989 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7990 var
7991   ImageSize: Integer;
7992 begin
7993   Create;
7994   if not Assigned(aData) then begin
7995     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7996     GetMem(aData, ImageSize);
7997     try
7998       FillChar(aData^, ImageSize, #$FF);
7999       SetData(aData, aFormat, aSize.X, aSize.Y);
8000     except
8001       if Assigned(aData) then
8002         FreeMem(aData);
8003       raise;
8004     end;
8005   end else begin
8006     SetData(aData, aFormat, aSize.X, aSize.Y);
8007   end;
8008 end;
8009
8010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8011 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
8012 begin
8013   Create;
8014   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
8015 end;
8016
8017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8018 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
8019 begin
8020   Create;
8021   LoadFromResource(aInstance, aResource, aResType);
8022 end;
8023
8024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8025 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8026 begin
8027   Create;
8028   LoadFromResourceID(aInstance, aResourceID, aResType);
8029 end;
8030
8031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8032 destructor TglBitmapData.Destroy;
8033 begin
8034   SetData(nil, tfEmpty);
8035   inherited Destroy;
8036 end;
8037
8038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8039 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8041 function TglBitmap.GetWidth: Integer;
8042 begin
8043   if (ffX in fDimension.Fields) then
8044     result := fDimension.X
8045   else
8046     result := -1;
8047 end;
8048
8049 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8050 function TglBitmap.GetHeight: Integer;
8051 begin
8052   if (ffY in fDimension.Fields) then
8053     result := fDimension.Y
8054   else
8055     result := -1;
8056 end;
8057
8058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8059 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8060 begin
8061   if fCustomData = aValue then
8062     exit;
8063   fCustomData := aValue;
8064 end;
8065
8066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8067 procedure TglBitmap.SetCustomName(const aValue: String);
8068 begin
8069   if fCustomName = aValue then
8070     exit;
8071   fCustomName := aValue;
8072 end;
8073
8074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8075 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8076 begin
8077   if fCustomNameW = aValue then
8078     exit;
8079   fCustomNameW := aValue;
8080 end;
8081
8082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8083 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8084 begin
8085   if fDeleteTextureOnFree = aValue then
8086     exit;
8087   fDeleteTextureOnFree := aValue;
8088 end;
8089
8090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8091 procedure TglBitmap.SetID(const aValue: Cardinal);
8092 begin
8093   if fID = aValue then
8094     exit;
8095   fID := aValue;
8096 end;
8097
8098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8099 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8100 begin
8101   if fMipMap = aValue then
8102     exit;
8103   fMipMap := aValue;
8104 end;
8105
8106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8107 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8108 begin
8109   if fTarget = aValue then
8110     exit;
8111   fTarget := aValue;
8112 end;
8113
8114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8115 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8116 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8117 var
8118   MaxAnisotropic: Integer;
8119 {$IFEND}
8120 begin
8121   fAnisotropic := aValue;
8122   if (ID > 0) then begin
8123 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8124     if GL_EXT_texture_filter_anisotropic then begin
8125       if fAnisotropic > 0 then begin
8126         Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8127         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8128         if aValue > MaxAnisotropic then
8129           fAnisotropic := MaxAnisotropic;
8130         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8131       end;
8132     end else begin
8133       fAnisotropic := 0;
8134     end;
8135 {$ELSE}
8136     fAnisotropic := 0;
8137 {$IFEND}
8138   end;
8139 end;
8140
8141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8142 procedure TglBitmap.CreateID;
8143 begin
8144   if (ID <> 0) then
8145     glDeleteTextures(1, @fID);
8146   glGenTextures(1, @fID);
8147   Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8148 end;
8149
8150 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8151 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8152 begin
8153   // Set Up Parameters
8154   SetWrap(fWrapS, fWrapT, fWrapR);
8155   SetFilter(fFilterMin, fFilterMag);
8156   SetAnisotropic(fAnisotropic);
8157
8158 {$IFNDEF OPENGL_ES}
8159   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8160   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8161     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8162 {$ENDIF}
8163
8164 {$IFNDEF OPENGL_ES}
8165   // Mip Maps Generation Mode
8166   aBuildWithGlu := false;
8167   if (MipMap = mmMipmap) then begin
8168     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8169       glTexParameteri(Target, GL_GENERATE_MIPMAP, GLint(GL_TRUE))
8170     else
8171       aBuildWithGlu := true;
8172   end else if (MipMap = mmMipmapGlu) then
8173     aBuildWithGlu := true;
8174 {$ELSE}
8175   if (MipMap = mmMipmap) then
8176     glGenerateMipmap(Target);
8177 {$ENDIF}
8178 end;
8179
8180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8181 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8183 procedure TglBitmap.AfterConstruction;
8184 begin
8185   inherited AfterConstruction;
8186
8187   fID         := 0;
8188   fTarget     := 0;
8189 {$IFNDEF OPENGL_ES}
8190   fIsResident := false;
8191 {$ENDIF}
8192
8193   fMipMap              := glBitmapDefaultMipmap;
8194   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8195
8196   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8197   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8198 {$IFNDEF OPENGL_ES}
8199   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8200 {$ENDIF}
8201 end;
8202
8203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8204 procedure TglBitmap.BeforeDestruction;
8205 begin
8206   if (fID > 0) and fDeleteTextureOnFree then
8207     glDeleteTextures(1, @fID);
8208   inherited BeforeDestruction;
8209 end;
8210
8211 {$IFNDEF OPENGL_ES}
8212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8213 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8214 begin
8215   fBorderColor[0] := aRed;
8216   fBorderColor[1] := aGreen;
8217   fBorderColor[2] := aBlue;
8218   fBorderColor[3] := aAlpha;
8219   if (ID > 0) then begin
8220     Bind(false);
8221     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8222   end;
8223 end;
8224 {$ENDIF}
8225
8226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8227 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8228 begin
8229   //check MIN filter
8230   case aMin of
8231     GL_NEAREST:
8232       fFilterMin := GL_NEAREST;
8233     GL_LINEAR:
8234       fFilterMin := GL_LINEAR;
8235     GL_NEAREST_MIPMAP_NEAREST:
8236       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8237     GL_LINEAR_MIPMAP_NEAREST:
8238       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8239     GL_NEAREST_MIPMAP_LINEAR:
8240       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8241     GL_LINEAR_MIPMAP_LINEAR:
8242       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8243     else
8244       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8245   end;
8246
8247   //check MAG filter
8248   case aMag of
8249     GL_NEAREST:
8250       fFilterMag := GL_NEAREST;
8251     GL_LINEAR:
8252       fFilterMag := GL_LINEAR;
8253     else
8254       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8255   end;
8256
8257   //apply filter
8258   if (ID > 0) then begin
8259     Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8260     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8261
8262     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8263       case fFilterMin of
8264         GL_NEAREST, GL_LINEAR:
8265           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8266         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8267           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8268         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8269           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8270       end;
8271     end else
8272       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8273   end;
8274 end;
8275
8276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8277 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8278
8279   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8280   begin
8281     case aValue of
8282 {$IFNDEF OPENGL_ES}
8283       GL_CLAMP:
8284         aTarget := GL_CLAMP;
8285 {$ENDIF}
8286
8287       GL_REPEAT:
8288         aTarget := GL_REPEAT;
8289
8290       GL_CLAMP_TO_EDGE: begin
8291 {$IFNDEF OPENGL_ES}
8292         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8293           aTarget := GL_CLAMP
8294         else
8295 {$ENDIF}
8296           aTarget := GL_CLAMP_TO_EDGE;
8297       end;
8298
8299 {$IFNDEF OPENGL_ES}
8300       GL_CLAMP_TO_BORDER: begin
8301         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8302           aTarget := GL_CLAMP_TO_BORDER
8303         else
8304           aTarget := GL_CLAMP;
8305       end;
8306 {$ENDIF}
8307
8308 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8309       GL_MIRRORED_REPEAT: begin
8310   {$IFNDEF OPENGL_ES}
8311         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8312   {$ELSE}
8313         if GL_VERSION_2_0 then
8314   {$ENDIF}
8315           aTarget := GL_MIRRORED_REPEAT
8316         else
8317           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8318       end;
8319 {$IFEND}
8320     else
8321       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8322     end;
8323   end;
8324
8325 begin
8326   CheckAndSetWrap(S, fWrapS);
8327   CheckAndSetWrap(T, fWrapT);
8328   CheckAndSetWrap(R, fWrapR);
8329
8330   if (ID > 0) then begin
8331     Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8332     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8333     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8334 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8335     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8336     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8337 {$IFEND}
8338   end;
8339 end;
8340
8341 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8343 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8344
8345   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8346   begin
8347     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8348        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8349       fSwizzle[aIndex] := aValue
8350     else
8351       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8352   end;
8353
8354 begin
8355 {$IFNDEF OPENGL_ES}
8356   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8357     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8358 {$ELSE}
8359   if not GL_VERSION_3_0 then
8360     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8361 {$ENDIF}
8362   CheckAndSetValue(r, 0);
8363   CheckAndSetValue(g, 1);
8364   CheckAndSetValue(b, 2);
8365   CheckAndSetValue(a, 3);
8366
8367   if (ID > 0) then begin
8368     Bind(false);
8369 {$IFNDEF OPENGL_ES}
8370     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8371 {$ELSE}
8372     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8373     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8374     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8375     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8376 {$ENDIF}
8377   end;
8378 end;
8379 {$IFEND}
8380
8381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8382 procedure TglBitmap.Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean{$ENDIF});
8383 begin
8384 {$IFNDEF OPENGL_ES}
8385   if aEnableTextureUnit then
8386     glEnable(Target);
8387 {$ENDIF}
8388   if (ID > 0) then
8389     glBindTexture(Target, ID);
8390 end;
8391
8392 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8393 procedure TglBitmap.Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean{$ENDIF});
8394 begin
8395 {$IFNDEF OPENGL_ES}
8396   if aDisableTextureUnit then
8397     glDisable(Target);
8398 {$ENDIF}
8399   glBindTexture(Target, 0);
8400 end;
8401
8402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8403 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8404 var
8405   w, h: Integer;
8406 begin
8407   w := aDataObj.Width;
8408   h := aDataObj.Height;
8409   fDimension.Fields := [];
8410   if (w > 0) then
8411     fDimension.Fields := fDimension.Fields + [ffX];
8412   if (h > 0) then
8413     fDimension.Fields := fDimension.Fields + [ffY];
8414   fDimension.X := w;
8415   fDimension.Y := h;
8416 end;
8417
8418 {$IFNDEF OPENGL_ES}
8419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8420 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8421 var
8422   Temp: PByte;
8423   TempWidth, TempHeight: Integer;
8424   TempIntFormat: GLint;
8425   IntFormat: TglBitmapFormat;
8426   FormatDesc: TFormatDescriptor;
8427 begin
8428   result := false;
8429   Bind;
8430
8431   // Request Data
8432   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8433   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8434   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8435
8436   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8437   IntFormat  := FormatDesc.Format;
8438
8439   // Getting data from OpenGL
8440   FormatDesc := TFormatDescriptor.Get(IntFormat);
8441   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8442   try
8443     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8444     if FormatDesc.IsCompressed then begin
8445       if not Assigned(glGetCompressedTexImage) then
8446         raise EglBitmap.Create('compressed formats not supported by video adapter');
8447       glGetCompressedTexImage(Target, 0, Temp)
8448     end else
8449       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8450     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8451     result := true;
8452   except
8453     if Assigned(Temp) then
8454       FreeMem(Temp);
8455     raise;
8456   end;
8457 end;
8458 {$ENDIF}
8459
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 constructor TglBitmap.Create;
8462 begin
8463   if (ClassType = TglBitmap) then
8464     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8465   inherited Create;
8466 end;
8467
8468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8469 constructor TglBitmap.Create(const aData: TglBitmapData);
8470 begin
8471   Create;
8472   UploadData(aData);
8473 end;
8474
8475 {$IFNDEF OPENGL_ES}
8476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8477 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8479 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8480 var
8481   fd: TglBitmapFormatDescriptor;
8482 begin
8483   // Upload data
8484   fd := aDataObj.FormatDescriptor;
8485   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8486     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8487
8488   if fd.IsCompressed then begin
8489     if not Assigned(glCompressedTexImage1D) then
8490       raise EglBitmap.Create('compressed formats not supported by video adapter');
8491     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8492   end else if aBuildWithGlu then
8493     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8494   else
8495     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8496 end;
8497
8498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8499 procedure TglBitmap1D.AfterConstruction;
8500 begin
8501   inherited;
8502   Target := GL_TEXTURE_1D;
8503 end;
8504
8505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8506 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8507 var
8508   BuildWithGlu, TexRec: Boolean;
8509   TexSize: Integer;
8510 begin
8511   if not Assigned(aDataObj) then
8512     exit;
8513
8514   // Check Texture Size
8515   if (aCheckSize) then begin
8516     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8517
8518     if (aDataObj.Width > TexSize) then
8519       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8520
8521     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8522               (Target = GL_TEXTURE_RECTANGLE);
8523     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8524       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8525   end;
8526
8527   if (fID = 0) then
8528     CreateID;
8529   SetupParameters(BuildWithGlu);
8530   UploadDataIntern(aDataObj, BuildWithGlu);
8531   glAreTexturesResident(1, @fID, @fIsResident);
8532
8533   inherited UploadData(aDataObj, aCheckSize);
8534 end;
8535 {$ENDIF}
8536
8537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8538 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8540 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8541 var
8542   fd: TglBitmapFormatDescriptor;
8543 begin
8544   fd := aDataObj.FormatDescriptor;
8545   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8546     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8547
8548   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8549
8550   if fd.IsCompressed then begin
8551     if not Assigned(glCompressedTexImage2D) then
8552       raise EglBitmap.Create('compressed formats not supported by video adapter');
8553     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8554 {$IFNDEF OPENGL_ES}
8555   end else if aBuildWithGlu then begin
8556     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8557 {$ENDIF}
8558   end else begin
8559     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8560   end;
8561 end;
8562
8563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8564 procedure TglBitmap2D.AfterConstruction;
8565 begin
8566   inherited;
8567   Target := GL_TEXTURE_2D;
8568 end;
8569
8570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8571 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8572 var
8573   {$IFNDEF OPENGL_ES}
8574   BuildWithGlu, TexRec: Boolean;
8575   {$ENDIF}
8576   PotTex: Boolean;
8577   TexSize: Integer;
8578 begin
8579   if not Assigned(aDataObj) then
8580     exit;
8581
8582   // Check Texture Size
8583   if (aCheckSize) then begin
8584     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8585
8586     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8587       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8588
8589     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8590 {$IF NOT DEFINED(OPENGL_ES)}
8591     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8592     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8593       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8594 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8595     if not PotTex and not GL_OES_texture_npot then
8596       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8597 {$ELSE}
8598     if not PotTex then
8599       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8600 {$IFEND}
8601   end;
8602
8603   if (fID = 0) then
8604     CreateID;
8605   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8606   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8607 {$IFNDEF OPENGL_ES}
8608   glAreTexturesResident(1, @fID, @fIsResident);
8609 {$ENDIF}
8610
8611   inherited UploadData(aDataObj, aCheckSize);
8612 end;
8613
8614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8615 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8616 var
8617   Temp: pByte;
8618   Size, w, h: Integer;
8619   FormatDesc: TFormatDescriptor;
8620 begin
8621   FormatDesc := TFormatDescriptor.Get(aFormat);
8622   if FormatDesc.IsCompressed then
8623     raise EglBitmapUnsupportedFormat.Create(aFormat);
8624
8625   w    := aRight  - aLeft;
8626   h    := aBottom - aTop;
8627   Size := FormatDesc.GetSize(w, h);
8628   GetMem(Temp, Size);
8629   try
8630     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8631     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8632     aDataObj.SetData(Temp, aFormat, w, h);
8633     aDataObj.FlipVert;
8634   except
8635     if Assigned(Temp) then
8636       FreeMem(Temp);
8637     raise;
8638   end;
8639 end;
8640
8641 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8643 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8645 procedure TglBitmapCubeMap.AfterConstruction;
8646 begin
8647   inherited;
8648
8649 {$IFNDEF OPENGL_ES}
8650   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8651     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8652 {$ELSE}
8653   if not (GL_VERSION_2_0) then
8654     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8655 {$ENDIF}
8656
8657   SetWrap;
8658   Target   := GL_TEXTURE_CUBE_MAP;
8659 {$IFNDEF OPENGL_ES}
8660   fGenMode := GL_REFLECTION_MAP;
8661 {$ENDIF}
8662 end;
8663
8664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8665 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8666 begin
8667   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8668 end;
8669
8670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8671 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8672 var
8673   {$IFNDEF OPENGL_ES}
8674   BuildWithGlu: Boolean;
8675   {$ENDIF}
8676   TexSize: Integer;
8677 begin
8678   if (aCheckSize) then begin
8679     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8680
8681     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8682       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8683
8684 {$IF NOT DEFINED(OPENGL_ES)}
8685     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8686       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8687 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8688     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8689       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8690 {$ELSE}
8691     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8692       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8693 {$IFEND}
8694   end;
8695
8696   if (fID = 0) then
8697     CreateID;
8698   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8699   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8700
8701   inherited UploadData(aDataObj, aCheckSize);
8702 end;
8703
8704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8705 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean{$ENDIF});
8706 begin
8707   inherited Bind({$IFNDEF OPENGL_ES}aEnableTextureUnit{$ENDIF});
8708 {$IFNDEF OPENGL_ES}
8709   if aEnableTexCoordsGen then begin
8710     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8711     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8712     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8713     glEnable(GL_TEXTURE_GEN_S);
8714     glEnable(GL_TEXTURE_GEN_T);
8715     glEnable(GL_TEXTURE_GEN_R);
8716   end;
8717 {$ENDIF}
8718 end;
8719
8720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8721 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean{$ENDIF});
8722 begin
8723   inherited Unbind({$IFNDEF OPENGL_ES}aDisableTextureUnit{$ENDIF});
8724 {$IFNDEF OPENGL_ES}
8725   if aDisableTexCoordsGen then begin
8726     glDisable(GL_TEXTURE_GEN_S);
8727     glDisable(GL_TEXTURE_GEN_T);
8728     glDisable(GL_TEXTURE_GEN_R);
8729   end;
8730 {$ENDIF}
8731 end;
8732 {$IFEND}
8733
8734 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8736 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8738 type
8739   TVec = Array[0..2] of Single;
8740   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8741
8742   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8743   TglBitmapNormalMapRec = record
8744     HalfSize : Integer;
8745     Func: TglBitmapNormalMapGetVectorFunc;
8746   end;
8747
8748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8749 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8750 begin
8751   aVec[0] := aHalfSize;
8752   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8753   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8754 end;
8755
8756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8757 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8758 begin
8759   aVec[0] := - aHalfSize;
8760   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8761   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8762 end;
8763
8764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8765 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8766 begin
8767   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8768   aVec[1] := aHalfSize;
8769   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8770 end;
8771
8772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8773 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8774 begin
8775   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8776   aVec[1] := - aHalfSize;
8777   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8778 end;
8779
8780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8781 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8782 begin
8783   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8784   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8785   aVec[2] := aHalfSize;
8786 end;
8787
8788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8789 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8790 begin
8791   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8792   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8793   aVec[2] := - aHalfSize;
8794 end;
8795
8796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8797 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8798 var
8799   i: Integer;
8800   Vec: TVec;
8801   Len: Single;
8802 begin
8803   with FuncRec do begin
8804     with PglBitmapNormalMapRec(Args)^ do begin
8805       Func(Vec, Position, HalfSize);
8806
8807       // Normalize
8808       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8809       if Len <> 0 then begin
8810         Vec[0] := Vec[0] * Len;
8811         Vec[1] := Vec[1] * Len;
8812         Vec[2] := Vec[2] * Len;
8813       end;
8814
8815       // Scale Vector and AddVectro
8816       Vec[0] := Vec[0] * 0.5 + 0.5;
8817       Vec[1] := Vec[1] * 0.5 + 0.5;
8818       Vec[2] := Vec[2] * 0.5 + 0.5;
8819     end;
8820
8821     // Set Color
8822     for i := 0 to 2 do
8823       Dest.Data.arr[i] := Round(Vec[i] * 255);
8824   end;
8825 end;
8826
8827 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8828 procedure TglBitmapNormalMap.AfterConstruction;
8829 begin
8830   inherited;
8831 {$IFNDEF OPENGL_ES}
8832   fGenMode := GL_NORMAL_MAP;
8833 {$ENDIF}
8834 end;
8835
8836 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8837 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8838 var
8839   Rec: TglBitmapNormalMapRec;
8840   SizeRec: TglBitmapSize;
8841   DataObj: TglBitmapData;
8842 begin
8843   Rec.HalfSize := aSize div 2;
8844
8845   SizeRec.Fields := [ffX, ffY];
8846   SizeRec.X := aSize;
8847   SizeRec.Y := aSize;
8848
8849   DataObj := TglBitmapData.Create;
8850   try
8851     // Positive X
8852     Rec.Func := glBitmapNormalMapPosX;
8853     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8854     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8855
8856     // Negative X
8857     Rec.Func := glBitmapNormalMapNegX;
8858     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8859     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8860
8861     // Positive Y
8862     Rec.Func := glBitmapNormalMapPosY;
8863     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8864     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8865
8866     // Negative Y
8867     Rec.Func := glBitmapNormalMapNegY;
8868     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8869     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8870
8871     // Positive Z
8872     Rec.Func := glBitmapNormalMapPosZ;
8873     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8874     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8875
8876     // Negative Z
8877     Rec.Func := glBitmapNormalMapNegZ;
8878     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8879     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8880   finally
8881     FreeAndNil(DataObj);
8882   end;
8883 end;
8884 {$IFEND}
8885
8886 initialization
8887   glBitmapSetDefaultFormat (tfEmpty);
8888   glBitmapSetDefaultMipmap (mmMipmap);
8889   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8890   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8891 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8892   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8893 {$IFEND}
8894
8895   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8896   glBitmapSetDefaultDeleteTextureOnFree    (true);
8897
8898   TFormatDescriptor.Init;
8899
8900 finalization
8901   TFormatDescriptor.Finalize;
8902
8903 end.