uglcBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 interface
 183
 184 uses
 185   {$IFDEF OPENGL_ES}            dglOpenGLES,
 186   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 187
 188   {$IF DEFINED(GLB_WIN) AND
 189        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 190
 191   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 192   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 193   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 194
 195   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 196   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 197   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 198   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 199   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 200
 201   Classes, SysUtils;
 202
 203 type
 204 {$IFNDEF fpc}
 205   QWord   = System.UInt64;
 206   PQWord  = ^QWord;
 207
 208   PtrInt  = Longint;
 209   PtrUInt = DWord;
 210 {$ENDIF}
 211
 212
 213   { type that describes the format of the data stored in a texture.
 214     the name of formats is composed of the following constituents:
 215     - multiple channels:
 216        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 217        - width of the chanel in bit       (4, 8, 16, ...)
 218     - data type                           (e.g. ub, us, ui)
 219     - number of elements of data types }
 220   TglBitmapFormat = (
 221     tfEmpty = 0,
 222
 223     tfAlpha4ub1,                //< 1 x unsigned byte
 224     tfAlpha8ub1,                //< 1 x unsigned byte
 225     tfAlpha16us1,               //< 1 x unsigned short
 226
 227     tfLuminance4ub1,            //< 1 x unsigned byte
 228     tfLuminance8ub1,            //< 1 x unsigned byte
 229     tfLuminance16us1,           //< 1 x unsigned short
 230
 231     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 232     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 233     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 235     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 236
 237     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 238     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 239     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 240     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 241     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 242     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 243     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 244     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 245     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 246     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 247     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 248     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 249
 250     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 251     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 252     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 253     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 254     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 255     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 256     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 257     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 258     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 259     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 260
 261     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 262     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 263     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 264     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 265     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 266     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 267     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 268     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 269     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 270     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 271     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 272
 273     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 274     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 275     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 276     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 277     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 278     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 279     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 280     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 281     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 282     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 283
 284     tfDepth16us1,               //< 1 x unsigned short (depth)
 285     tfDepth24ui1,               //< 1 x unsigned int (depth)
 286     tfDepth32ui1,               //< 1 x unsigned int (depth)
 287
 288     tfS3tcDtx1RGBA,
 289     tfS3tcDtx3RGBA,
 290     tfS3tcDtx5RGBA
 291   );
 292
 293   { type to define suitable file formats }
 294   TglBitmapFileType = (
 295      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 296      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 297      ftDDS,                                             //< Direct Draw Surface file (DDS)
 298      ftTGA,                                             //< Targa Image File (TGA)
 299      ftBMP,                                             //< Windows Bitmap File (BMP)
 300      ftRAW);                                            //< glBitmap RAW file format
 301    TglBitmapFileTypes = set of TglBitmapFileType;
 302
 303   { possible mipmap types }
 304   TglBitmapMipMap = (
 305      mmNone,                //< no mipmaps
 306      mmMipmap,              //< normal mipmaps
 307      mmMipmapGlu);          //< mipmaps generated with glu functions
 308
 309   { possible normal map functions }
 310    TglBitmapNormalMapFunc = (
 311      nm4Samples,
 312      nmSobel,
 313      nm3x3,
 314      nm5x5);
 315
 316  ////////////////////////////////////////////////////////////////////////////////////////////////////
 317    EglBitmap                  = class(Exception);   //< glBitmap exception
 318    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 319    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 320    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 321    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 322    public
 323      constructor Create(const aFormat: TglBitmapFormat); overload;
 324      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 325    end;
 326
 327 ////////////////////////////////////////////////////////////////////////////////////////////////////
 328   { record that stores 4 unsigned integer values }
 329   TglBitmapRec4ui = packed record
 330   case Integer of
 331     0: (r, g, b, a: Cardinal);
 332     1: (arr: array[0..3] of Cardinal);
 333   end;
 334
 335   { record that stores 4 unsigned byte values }
 336   TglBitmapRec4ub = packed record
 337   case Integer of
 338     0: (r, g, b, a: Byte);
 339     1: (arr: array[0..3] of Byte);
 340   end;
 341
 342   { record that stores 4 unsigned long integer values }
 343   TglBitmapRec4ul = packed record
 344   case Integer of
 345     0: (r, g, b, a: QWord);
 346     1: (arr: array[0..3] of QWord);
 347   end;
 348
 349   { 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;
 459   end;
 460
 461 ////////////////////////////////////////////////////////////////////////////////////////////////////
 462   TglBitmapData = class;
 463
 464   { structure to store data for converting in }
 465   TglBitmapFunctionRec = record
 466     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 467     Size:     TglBitmapSize;          //< size of the texture
 468     Position: TglBitmapPixelPosition; //< position of the currently pixel
 469     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 470     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 471     Args:     Pointer;                //< user defined args that was passed to the convert function
 472   end;
 473
 474   { callback to use for converting texture data }
 475   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 476
 477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 478   { class to store texture data in. used to load, save and
 479     manipulate data before assigned to texture object
 480     all operations on a data object can be done from a background thread }
 481   TglBitmapData = class
 482   private { fields }
 483
 484     fData: PByte;               //< texture data
 485     fDimension: TglBitmapSize;  //< pixel size of the data
 486     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 487     fFilename: String;          //< file the data was load from
 488
 489     fScanlines:    array of PByte;  //< pointer to begin of each line
 490     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 491
 492   private { getter / setter }
 493
 494     { @returns the format descriptor suitable to the texture data format }
 495     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 496
 497     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 498     function GetWidth: Integer;
 499
 500     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 501     function GetHeight: Integer;
 502
 503     { get scanline at index aIndex
 504         @returns Pointer to start of line or @nil }
 505     function GetScanlines(const aIndex: Integer): PByte;
 506
 507     { set new value for the data format. only possible if new format has the same pixel size.
 508       if you want to convert the texture data, see ConvertTo function }
 509     procedure SetFormat(const aValue: TglBitmapFormat);
 510
 511   private { internal misc }
 512
 513     { splits a resource identifier into the resource and it's type
 514         @param aResource  resource identifier to split and store name in
 515         @param aResType   type of the resource }
 516     procedure PrepareResType(var aResource: String; var aResType: PChar);
 517
 518     { updates scanlines array }
 519     procedure UpdateScanlines;
 520
 521   private { internal load and save }
 522 {$IFDEF GLB_SUPPORT_PNG_READ}
 523     { try to load a PNG from a stream
 524         @param aStream  stream to load PNG from
 525         @returns        @true on success, @false otherwise }
 526     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 527 {$ENDIF}
 528
 529 {$ifdef GLB_SUPPORT_PNG_WRITE}
 530     { save texture data as PNG to stream
 531         @param aStream stream to save data to}
 532     procedure SavePNG(const aStream: TStream); virtual;
 533 {$ENDIF}
 534
 535 {$IFDEF GLB_SUPPORT_JPEG_READ}
 536     { try to load a JPEG from a stream
 537         @param aStream  stream to load JPEG from
 538         @returns        @true on success, @false otherwise }
 539     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 540 {$ENDIF}
 541
 542 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 543     { save texture data as JPEG to stream
 544         @param aStream stream to save data to}
 545     procedure SaveJPEG(const aStream: TStream); virtual;
 546 {$ENDIF}
 547
 548     { try to load a RAW image from a stream
 549         @param aStream  stream to load RAW image from
 550         @returns        @true on success, @false otherwise }
 551     function LoadRAW(const aStream: TStream): Boolean;
 552
 553     { save texture data as RAW image to stream
 554         @param aStream stream to save data to}
 555     procedure SaveRAW(const aStream: TStream);
 556
 557     { try to load a BMP from a stream
 558         @param aStream  stream to load BMP from
 559         @returns        @true on success, @false otherwise }
 560     function LoadBMP(const aStream: TStream): Boolean;
 561
 562     { save texture data as BMP to stream
 563         @param aStream stream to save data to}
 564     procedure SaveBMP(const aStream: TStream);
 565
 566     { try to load a TGA from a stream
 567         @param aStream  stream to load TGA from
 568         @returns        @true on success, @false otherwise }
 569     function LoadTGA(const aStream: TStream): Boolean;
 570
 571     { save texture data as TGA to stream
 572         @param aStream stream to save data to}
 573     procedure SaveTGA(const aStream: TStream);
 574
 575     { try to load a DDS from a stream
 576         @param aStream  stream to load DDS from
 577         @returns        @true on success, @false otherwise }
 578     function LoadDDS(const aStream: TStream): Boolean;
 579
 580     { save texture data as DDS to stream
 581         @param aStream stream to save data to}
 582     procedure SaveDDS(const aStream: TStream);
 583
 584   public { properties }
 585     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 586     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 587     property Filename:  String          read fFilename;                 //< file the data was loaded from
 588     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 589     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 590     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 591     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 592
 593     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 594
 595   public { flip }
 596
 597     { flip texture horizontal
 598         @returns @true in success, @false otherwise }
 599     function FlipHorz: Boolean; virtual;
 600
 601     { flip texture vertical
 602         @returns @true in success, @false otherwise }
 603     function FlipVert: Boolean; virtual;
 604
 605   public { load }
 606
 607     { load a texture from a file
 608         @param aFilename file to load texuture from }
 609     procedure LoadFromFile(const aFilename: String);
 610
 611     { load a texture from a stream
 612         @param aStream  stream to load texture from }
 613     procedure LoadFromStream(const aStream: TStream); virtual;
 614
 615     { use a function to generate texture data
 616         @param aSize    size of the texture
 617         @param aFormat  format of the texture data
 618         @param aFunc    callback to use for generation
 619         @param aArgs    user defined paramaters (use at will) }
 620     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 621
 622     { load a texture from a resource
 623         @param aInstance  resource handle
 624         @param aResource  resource indentifier
 625         @param aResType   resource type (if known) }
 626     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 627
 628     { load a texture from a resource id
 629         @param aInstance  resource handle
 630         @param aResource  resource ID
 631         @param aResType   resource type }
 632     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 633
 634   public { save }
 635
 636     { save texture data to a file
 637         @param aFilename  filename to store texture in
 638         @param aFileType  file type to store data into }
 639     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 640
 641     { save texture data to a stream
 642         @param aFilename  filename to store texture in
 643         @param aFileType  file type to store data into }
 644     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 645
 646   public { convert }
 647
 648     { convert texture data using a user defined callback
 649         @param aFunc        callback to use for converting
 650         @param aCreateTemp  create a temporary buffer to use for converting
 651         @param aArgs        user defined paramters (use at will)
 652         @returns            @true if converting was successful, @false otherwise }
 653     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 654
 655     { convert texture data using a user defined callback
 656         @param aSource      glBitmap to read data from
 657         @param aFunc        callback to use for converting
 658         @param aCreateTemp  create a temporary buffer to use for converting
 659         @param aFormat      format of the new data
 660         @param aArgs        user defined paramters (use at will)
 661         @returns            @true if converting was successful, @false otherwise }
 662     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 663       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 664
 665     { convert texture data using a specific format
 666         @param aFormat  new format of texture data
 667         @returns        @true if converting was successful, @false otherwise }
 668     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 669
 670 {$IFDEF GLB_SDL}
 671   public { SDL }
 672
 673     { assign texture data to SDL surface
 674         @param aSurface SDL surface to write data to
 675         @returns        @true on success, @false otherwise }
 676     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 677
 678     { assign texture data from SDL surface
 679         @param aSurface SDL surface to read data from
 680         @returns        @true on success, @false otherwise }
 681     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 682
 683     { assign alpha channel data to SDL surface
 684         @param aSurface SDL surface to write alpha channel data to
 685         @returns        @true on success, @false otherwise }
 686     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 687
 688     { assign alpha channel data from SDL surface
 689         @param aSurface SDL surface to read data from
 690         @param aFunc    callback to use for converting
 691         @param aArgs    user defined parameters (use at will)
 692         @returns        @true on success, @false otherwise }
 693     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 694 {$ENDIF}
 695
 696 {$IFDEF GLB_DELPHI}
 697   public { Delphi }
 698
 699     { assign texture data to TBitmap object
 700         @param aBitmap  TBitmap to write data to
 701         @returns        @true on success, @false otherwise }
 702     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 703
 704     { assign texture data from TBitmap object
 705         @param aBitmap  TBitmap to read data from
 706         @returns        @true on success, @false otherwise }
 707     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 708
 709     { assign alpha channel data to TBitmap object
 710         @param aBitmap  TBitmap to write data to
 711         @returns        @true on success, @false otherwise }
 712     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 713
 714     { assign alpha channel data from TBitmap object
 715         @param aBitmap  TBitmap to read data from
 716         @param aFunc    callback to use for converting
 717         @param aArgs    user defined parameters (use at will)
 718         @returns        @true on success, @false otherwise }
 719     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 720 {$ENDIF}
 721
 722 {$IFDEF GLB_LAZARUS}
 723   public { Lazarus }
 724
 725     { assign texture data to TLazIntfImage object
 726         @param aImage   TLazIntfImage to write data to
 727         @returns        @true on success, @false otherwise }
 728     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 729
 730     { assign texture data from TLazIntfImage object
 731         @param aImage   TLazIntfImage to read data from
 732         @returns        @true on success, @false otherwise }
 733     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 734
 735     { assign alpha channel data to TLazIntfImage object
 736         @param aImage   TLazIntfImage to write data to
 737         @returns        @true on success, @false otherwise }
 738     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 739
 740     { assign alpha channel data from TLazIntfImage object
 741         @param aImage   TLazIntfImage to read data from
 742         @param aFunc    callback to use for converting
 743         @param aArgs    user defined parameters (use at will)
 744         @returns        @true on success, @false otherwise }
 745     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 746 {$ENDIF}
 747
 748   public { Alpha }
 749     { load alpha channel data from resource
 750         @param aInstance  resource handle
 751         @param aResource  resource ID
 752         @param aResType   resource type
 753         @param aFunc      callback to use for converting
 754         @param aArgs      user defined parameters (use at will)
 755         @returns          @true on success, @false otherwise }
 756     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 757
 758     { load alpha channel data from resource ID
 759         @param aInstance    resource handle
 760         @param aResourceID  resource ID
 761         @param aResType     resource type
 762         @param aFunc        callback to use for converting
 763         @param aArgs        user defined parameters (use at will)
 764         @returns            @true on success, @false otherwise }
 765     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 766
 767     { add alpha channel data from function
 768         @param aFunc  callback to get data from
 769         @param aArgs  user defined parameters (use at will)
 770         @returns      @true on success, @false otherwise }
 771     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 772
 773     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 774         @param aFilename  file to load alpha channel data from
 775         @param aFunc      callback to use for converting
 776         @param aArgs     SetFormat user defined parameters (use at will)
 777         @returns          @true on success, @false otherwise }
 778     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 779
 780     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 781         @param aStream  stream to load alpha channel data from
 782         @param aFunc    callback to use for converting
 783         @param aArgs    user defined parameters (use at will)
 784         @returns        @true on success, @false otherwise }
 785     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 786
 787     { add alpha channel data from existing glBitmap object
 788         @param aBitmap  TglBitmap to copy alpha channel data from
 789         @param aFunc    callback to use for converting
 790         @param aArgs    user defined parameters (use at will)
 791         @returns        @true on success, @false otherwise }
 792     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 793
 794     { add alpha to pixel if the pixels color is greter than the given color value
 795         @param aRed         red threshold (0-255)
 796         @param aGreen       green threshold (0-255)
 797         @param aBlue        blue threshold (0-255)
 798         @param aDeviatation accepted deviatation (0-255)
 799         @returns            @true on success, @false otherwise }
 800     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 801
 802     { add alpha to pixel if the pixels color is greter than the given color value
 803         @param aRed         red threshold (0-Range.r)
 804         @param aGreen       green threshold (0-Range.g)
 805         @param aBlue        blue threshold (0-Range.b)
 806         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 807         @returns            @true on success, @false otherwise }
 808     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 809
 810     { add alpha to pixel if the pixels color is greter than the given color value
 811         @param aRed         red threshold (0.0-1.0)
 812         @param aGreen       green threshold (0.0-1.0)
 813         @param aBlue        blue threshold (0.0-1.0)
 814         @param aDeviatation accepted deviatation (0.0-1.0)
 815         @returns            @true on success, @false otherwise }
 816     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 817
 818     { add a constand alpha value to all pixels
 819         @param aAlpha alpha value to add (0-255)
 820         @returns      @true on success, @false otherwise }
 821     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 822
 823     { add a constand alpha value to all pixels
 824         @param aAlpha alpha value to add (0-max(Range.rgb))
 825         @returns      @true on success, @false otherwise }
 826     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 827
 828     { add a constand alpha value to all pixels
 829         @param aAlpha alpha value to add (0.0-1.0)
 830         @returns      @true on success, @false otherwise }
 831     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 832
 833     { remove alpha channel
 834         @returns  @true on success, @false otherwise }
 835     function RemoveAlpha: Boolean; virtual;
 836
 837   public { fill }
 838     { fill complete texture with one color
 839         @param aRed   red color for border (0-255)
 840         @param aGreen green color for border (0-255)
 841         @param aBlue  blue color for border (0-255)
 842         @param aAlpha alpha color for border (0-255) }
 843     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 844
 845     { fill complete texture with one color
 846         @param aRed   red color for border (0-Range.r)
 847         @param aGreen green color for border (0-Range.g)
 848         @param aBlue  blue color for border (0-Range.b)
 849         @param aAlpha alpha color for border (0-Range.a) }
 850     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 851
 852     { fill complete texture with one color
 853         @param aRed   red color for border (0.0-1.0)
 854         @param aGreen green color for border (0.0-1.0)
 855         @param aBlue  blue color for border (0.0-1.0)
 856         @param aAlpha alpha color for border (0.0-1.0) }
 857     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 858
 859   public { Misc }
 860
 861     { set data pointer of texture data
 862         @param aData    pointer to new texture data
 863         @param aFormat  format of the data stored at aData
 864         @param aWidth   width of the texture data
 865         @param aHeight  height of the texture data }
 866     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 867       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 868
 869       { create a clone of the current object
 870         @returns clone of this object}
 871     function Clone: TglBitmapData;
 872
 873     { invert color data (bitwise not)
 874         @param aRed     invert red channel
 875         @param aGreen   invert green channel
 876         @param aBlue    invert blue channel
 877         @param aAlpha   invert alpha channel }
 878     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 879
 880     { create normal map from texture data
 881         @param aFunc      normal map function to generate normalmap with
 882         @param aScale     scale of the normale stored in the normal map
 883         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 884     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 885       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 886
 887   public { constructor }
 888
 889     { constructor - creates a texutre data object }
 890     constructor Create; overload;
 891
 892     { constructor - creates a texture data object and loads it from a file
 893         @param aFilename file to load texture from }
 894     constructor Create(const aFileName: String); overload;
 895
 896     { constructor - creates a texture data object and loads it from a stream
 897         @param aStream stream to load texture from }
 898     constructor Create(const aStream: TStream); overload;
 899
 900     { constructor - creates a texture data object with the given size, format and data
 901         @param aSize    size of the texture
 902         @param aFormat  format of the given data
 903         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 904     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 905
 906     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 907         @param aSize    size of the texture
 908         @param aFormat  format of the given data
 909         @param aFunc    callback to use for generating the data
 910         @param aArgs    user defined parameters (use at will) }
 911     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 912
 913     { constructor - creates a texture data object and loads it from a resource
 914         @param aInstance  resource handle
 915         @param aResource  resource indentifier
 916         @param aResType   resource type (if known) }
 917     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 918
 919     { constructor - creates a texture data object and loads it from a resource
 920         @param aInstance    resource handle
 921         @param aResourceID  resource ID
 922         @param aResType     resource type (if known) }
 923     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 924
 925     { destructor }
 926     destructor Destroy; override;
 927
 928   end;
 929
 930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 931   { base class for all glBitmap classes. used to manage OpenGL texture objects
 932     all operations on a bitmap object must be done from the render thread }
 933   TglBitmap = class
 934   protected
 935     fID: GLuint;                          //< name of the OpenGL texture object
 936     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 937     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 938
 939     // texture properties
 940     fFilterMin: GLenum;                   //< min filter to apply to the texture
 941     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 942     fWrapS: GLenum;                       //< texture wrapping for x axis
 943     fWrapT: GLenum;                       //< texture wrapping for y axis
 944     fWrapR: GLenum;                       //< texture wrapping for z axis
 945     fAnisotropic: Integer;                //< anisotropic level
 946     fBorderColor: array[0..3] of Single;  //< color of the texture border
 947
 948 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 949     //Swizzle
 950     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 951 {$IFEND}
 952 {$IFNDEF OPENGL_ES}
 953     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 954 {$ENDIF}
 955
 956     fDimension: TglBitmapSize;            //< size of this texture
 957     fMipMap: TglBitmapMipMap;             //< mipmap type
 958
 959     // CustomData
 960     fCustomData: Pointer;                 //< user defined data
 961     fCustomName: String;                  //< user defined name
 962     fCustomNameW: WideString;             //< user defined name
 963   protected
 964     { @returns the actual width of the texture }
 965     function GetWidth:  Integer; virtual;
 966
 967     { @returns the actual height of the texture }
 968     function GetHeight: Integer; virtual;
 969
 970   protected
 971     { set a new value for fCustomData }
 972     procedure SetCustomData(const aValue: Pointer);
 973
 974     { set a new value for fCustomName }
 975     procedure SetCustomName(const aValue: String);
 976
 977     { set a new value for fCustomNameW }
 978     procedure SetCustomNameW(const aValue: WideString);
 979
 980     { set new value for fDeleteTextureOnFree }
 981     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 982
 983     { set name of OpenGL texture object }
 984     procedure SetID(const aValue: Cardinal);
 985
 986     { set new value for fMipMap }
 987     procedure SetMipMap(const aValue: TglBitmapMipMap);
 988
 989     { set new value for target }
 990     procedure SetTarget(const aValue: Cardinal);
 991
 992     { set new value for fAnisotrophic }
 993     procedure SetAnisotropic(const aValue: Integer);
 994
 995   protected
 996     { create OpenGL texture object (delete exisiting object if exists) }
 997     procedure CreateID;
 998
 999     { setup texture parameters }
1000     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1001
1002   protected
1003     property Width:  Integer read GetWidth;   //< the actual width of the texture
1004     property Height: Integer read GetHeight;  //< the actual height of the texture
1005
1006   public
1007     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1008     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1009     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1010
1011     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1012     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1013
1014     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1015     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1016     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1017
1018     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1019 {$IFNDEF OPENGL_ES}
1020     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1021 {$ENDIF}
1022
1023     { this method is called after the constructor and sets the default values of this object }
1024     procedure AfterConstruction; override;
1025
1026     { this method is called before the destructor and does some cleanup }
1027     procedure BeforeDestruction; override;
1028
1029   public
1030 {$IFNDEF OPENGL_ES}
1031     { set the new value for texture border color
1032         @param aRed   red color for border (0.0-1.0)
1033         @param aGreen green color for border (0.0-1.0)
1034         @param aBlue  blue color for border (0.0-1.0)
1035         @param aAlpha alpha color for border (0.0-1.0) }
1036     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1037 {$ENDIF}
1038
1039   public
1040     { set new texture filer
1041         @param aMin   min filter
1042         @param aMag   mag filter }
1043     procedure SetFilter(const aMin, aMag: GLenum);
1044
1045     { set new texture wrapping
1046         @param S  texture wrapping for x axis
1047         @param T  texture wrapping for y axis
1048         @param R  texture wrapping for z axis }
1049     procedure SetWrap(
1050       const S: GLenum = GL_CLAMP_TO_EDGE;
1051       const T: GLenum = GL_CLAMP_TO_EDGE;
1052       const R: GLenum = GL_CLAMP_TO_EDGE);
1053
1054 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1055     { set new swizzle
1056         @param r  swizzle for red channel
1057         @param g  swizzle for green channel
1058         @param b  swizzle for blue channel
1059         @param a  swizzle for alpha channel }
1060     procedure SetSwizzle(const r, g, b, a: GLenum);
1061 {$IFEND}
1062
1063   public
1064     { bind texture
1065         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1066     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1067
1068     { bind texture
1069         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1070     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1071
1072     { upload texture data from given data object to video card
1073         @param aData        texture data object that contains the actual data
1074         @param aCheckSize   check size before upload and throw exception if something is wrong }
1075     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1076
1077 {$IFNDEF OPENGL_ES}
1078     { download texture data from video card and store it into given data object
1079         @returns @true when download was successfull, @false otherwise }
1080     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1081 {$ENDIF}
1082   public
1083     { constructor - creates an empty texture }
1084     constructor Create; overload;
1085
1086     { constructor - creates an texture object and uploads the given data }
1087     constructor Create(const aData: TglBitmapData); overload;
1088
1089   end;
1090
1091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1092 {$IF NOT DEFINED(OPENGL_ES)}
1093   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1094     all operations on a bitmap object must be done from the render thread }
1095   TglBitmap1D = class(TglBitmap)
1096   protected
1097
1098     { upload the texture data to video card
1099         @param aDataObj       texture data object that contains the actual data
1100         @param aBuildWithGlu  use glu functions to build mipmaps }
1101     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1102
1103   public
1104     property Width; //< actual with of the texture
1105
1106     { this method is called after constructor and initializes the object }
1107     procedure AfterConstruction; override;
1108
1109     { upload texture data from given data object to video card
1110         @param aData        texture data object that contains the actual data
1111         @param aCheckSize   check size before upload and throw exception if something is wrong }
1112     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1113
1114   end;
1115 {$IFEND}
1116
1117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1118   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1119     all operations on a bitmap object must be done from the render thread }
1120   TglBitmap2D = class(TglBitmap)
1121   protected
1122
1123     { upload the texture data to video card
1124         @param aDataObj       texture data object that contains the actual data
1125         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1126         @param aBuildWithGlu  use glu functions to build mipmaps }
1127     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1128       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1129
1130   public
1131     property Width;   //< actual width of the texture
1132     property Height;  //< actual height of the texture
1133
1134     { this method is called after constructor and initializes the object }
1135     procedure AfterConstruction; override;
1136
1137     { upload texture data from given data object to video card
1138         @param aData        texture data object that contains the actual data
1139         @param aCheckSize   check size before upload and throw exception if something is wrong }
1140     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1141
1142   public
1143
1144     { copy a part of the frame buffer to the texture
1145         @param aTop     topmost pixel to copy
1146         @param aLeft    leftmost pixel to copy
1147         @param aRight   rightmost pixel to copy
1148         @param aBottom  bottommost pixel to copy
1149         @param aFormat  format to store data in
1150         @param aDataObj texture data object to store the data in }
1151     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1152
1153   end;
1154
1155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1156 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1157   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1158     all operations on a bitmap object must be done from the render thread }
1159   TglBitmapCubeMap = class(TglBitmap2D)
1160   protected
1161   {$IFNDEF OPENGL_ES}
1162     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1163   {$ENDIF}
1164
1165   public
1166     { this method is called after constructor and initializes the object }
1167     procedure AfterConstruction; override;
1168
1169     { upload texture data from given data object to video card
1170         @param aData        texture data object that contains the actual data
1171         @param aCheckSize   check size before upload and throw exception if something is wrong }
1172     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); 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 aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1177         @param aCheckSize   check size before upload and throw exception if something is wrong }
1178     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1179
1180     { bind texture
1181         @param aEnableTexCoordsGen  enable cube map generator
1182         @param aEnableTextureUnit   enable texture unit }
1183     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1184
1185     { unbind texture
1186         @param aDisableTexCoordsGen   disable cube map generator
1187         @param aDisableTextureUnit    disable texture unit }
1188     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1189   end;
1190 {$IFEND}
1191
1192 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1194   { wrapper class for cube normal maps
1195     all operations on a bitmap object must be done from the render thread }
1196   TglBitmapNormalMap = class(TglBitmapCubeMap)
1197   public
1198     { this method is called after constructor and initializes the object }
1199     procedure AfterConstruction; override;
1200
1201     { create cube normal map from texture data and upload it to video card
1202         @param aSize        size of each cube map texture
1203         @param aCheckSize   check size before upload and throw exception if something is wrong }
1204     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1205   end;
1206 {$IFEND}
1207
1208   TglcBitmapFormat    = TglBitmapFormat;
1209   TglcBitmap2D        = TglBitmap2D;
1210 {$IF NOT DEFINED(OPENGL_ES)}
1211   TglcBitmap1D        = TglBitmap1D;
1212   TglcBitmapCubeMap   = TglBitmapCubeMap;
1213   TglcBitmapNormalMap = TglBitmapNormalMap;
1214 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
1215   TglcBitmapCubeMap   = TglBitmapCubeMap;
1216   TglcBitmapNormalMap = TglBitmapNormalMap;
1217 {$IFEND}
1218
1219 const
1220   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1221
1222 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1223 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1224 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1225 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1226 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1227 procedure glBitmapSetDefaultWrap(
1228   const S: Cardinal = GL_CLAMP_TO_EDGE;
1229   const T: Cardinal = GL_CLAMP_TO_EDGE;
1230   const R: Cardinal = GL_CLAMP_TO_EDGE);
1231
1232 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1233 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1234 {$IFEND}
1235
1236 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1237 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1238 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1239 function glBitmapGetDefaultFormat: TglBitmapFormat;
1240 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1241 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1242 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1243 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1244 {$IFEND}
1245
1246 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1247 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1248 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1249 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1250 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1251 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1252 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1253
1254 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1255
1256 {$IFDEF GLB_DELPHI}
1257 function CreateGrayPalette: HPALETTE;
1258 {$ENDIF}
1259
1260 implementation
1261
1262 uses
1263   Math, syncobjs, typinfo
1264   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1265
1266
1267 var
1268   glBitmapDefaultDeleteTextureOnFree: Boolean;
1269   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1270   glBitmapDefaultFormat: TglBitmapFormat;
1271   glBitmapDefaultMipmap: TglBitmapMipMap;
1272   glBitmapDefaultFilterMin: Cardinal;
1273   glBitmapDefaultFilterMag: Cardinal;
1274   glBitmapDefaultWrapS: Cardinal;
1275   glBitmapDefaultWrapT: Cardinal;
1276   glBitmapDefaultWrapR: Cardinal;
1277   glDefaultSwizzle: array[0..3] of GLenum;
1278
1279 ////////////////////////////////////////////////////////////////////////////////////////////////////
1280 type
1281   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1282   public
1283     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1284     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1285
1286     function CreateMappingData: Pointer; virtual;
1287     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1288
1289     function IsEmpty: Boolean; virtual;
1290     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1291
1292     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1293
1294     constructor Create; virtual;
1295   public
1296     class procedure Init;
1297     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1298     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1299     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1300     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1301     class procedure Clear;
1302     class procedure Finalize;
1303   end;
1304   TFormatDescriptorClass = class of TFormatDescriptor;
1305
1306   TfdEmpty = class(TFormatDescriptor);
1307
1308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1309   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1310     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1311     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1312   end;
1313
1314   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1315     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1316     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1317   end;
1318
1319   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1320     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1321     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1322   end;
1323
1324   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1325     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327   end;
1328
1329   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1330     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1331     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1332   end;
1333
1334   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1335     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1336     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1337   end;
1338
1339   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342   end;
1343
1344   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1350   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1351     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1352     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1353   end;
1354
1355   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1356     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1357     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1358   end;
1359
1360   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1361     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1362     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1363   end;
1364
1365   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1366     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1367     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1368   end;
1369
1370   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1371     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1372     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1373   end;
1374
1375   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1376     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1377     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1378   end;
1379
1380   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1381     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1382     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1383   end;
1384
1385   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1386     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1387     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1388   end;
1389
1390   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1391     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1392     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1393   end;
1394
1395   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1396     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1397     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1398   end;
1399
1400   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1406   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1407     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1408     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1409   end;
1410
1411   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1412     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1413     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1414   end;
1415
1416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1417   TfdAlpha4ub1 = class(TfdAlphaUB1)
1418     procedure SetValues; override;
1419   end;
1420
1421   TfdAlpha8ub1 = class(TfdAlphaUB1)
1422     procedure SetValues; override;
1423   end;
1424
1425   TfdAlpha16us1 = class(TfdAlphaUS1)
1426     procedure SetValues; override;
1427   end;
1428
1429   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1430     procedure SetValues; override;
1431   end;
1432
1433   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1434     procedure SetValues; override;
1435   end;
1436
1437   TfdLuminance16us1 = class(TfdLuminanceUS1)
1438     procedure SetValues; override;
1439   end;
1440
1441   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1442     procedure SetValues; override;
1443   end;
1444
1445   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1446     procedure SetValues; override;
1447   end;
1448
1449   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1450     procedure SetValues; override;
1451   end;
1452
1453   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1454     procedure SetValues; override;
1455   end;
1456
1457   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1458     procedure SetValues; override;
1459   end;
1460
1461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1462   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1463     procedure SetValues; override;
1464   end;
1465
1466   TfdRGBX4us1 = class(TfdUniversalUS1)
1467     procedure SetValues; override;
1468   end;
1469
1470   TfdXRGB4us1 = class(TfdUniversalUS1)
1471     procedure SetValues; override;
1472   end;
1473
1474   TfdR5G6B5us1 = class(TfdUniversalUS1)
1475     procedure SetValues; override;
1476   end;
1477
1478   TfdRGB5X1us1 = class(TfdUniversalUS1)
1479     procedure SetValues; override;
1480   end;
1481
1482   TfdX1RGB5us1 = class(TfdUniversalUS1)
1483     procedure SetValues; override;
1484   end;
1485
1486   TfdRGB8ub3 = class(TfdRGBub3)
1487     procedure SetValues; override;
1488   end;
1489
1490   TfdRGBX8ui1 = class(TfdUniversalUI1)
1491     procedure SetValues; override;
1492   end;
1493
1494   TfdXRGB8ui1 = class(TfdUniversalUI1)
1495     procedure SetValues; override;
1496   end;
1497
1498   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1499     procedure SetValues; override;
1500   end;
1501
1502   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1503     procedure SetValues; override;
1504   end;
1505
1506   TfdRGB16us3 = class(TfdRGBus3)
1507     procedure SetValues; override;
1508   end;
1509
1510   TfdRGBA4us1 = class(TfdUniversalUS1)
1511     procedure SetValues; override;
1512   end;
1513
1514   TfdARGB4us1 = class(TfdUniversalUS1)
1515     procedure SetValues; override;
1516   end;
1517
1518   TfdRGB5A1us1 = class(TfdUniversalUS1)
1519     procedure SetValues; override;
1520   end;
1521
1522   TfdA1RGB5us1 = class(TfdUniversalUS1)
1523     procedure SetValues; override;
1524   end;
1525
1526   TfdRGBA8ui1 = class(TfdUniversalUI1)
1527     procedure SetValues; override;
1528   end;
1529
1530   TfdARGB8ui1 = class(TfdUniversalUI1)
1531     procedure SetValues; override;
1532   end;
1533
1534   TfdRGBA8ub4 = class(TfdRGBAub4)
1535     procedure SetValues; override;
1536   end;
1537
1538   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1539     procedure SetValues; override;
1540   end;
1541
1542   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1543     procedure SetValues; override;
1544   end;
1545
1546   TfdRGBA16us4 = class(TfdRGBAus4)
1547     procedure SetValues; override;
1548   end;
1549
1550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1551   TfdBGRX4us1 = class(TfdUniversalUS1)
1552     procedure SetValues; override;
1553   end;
1554
1555   TfdXBGR4us1 = class(TfdUniversalUS1)
1556     procedure SetValues; override;
1557   end;
1558
1559   TfdB5G6R5us1 = class(TfdUniversalUS1)
1560     procedure SetValues; override;
1561   end;
1562
1563   TfdBGR5X1us1 = class(TfdUniversalUS1)
1564     procedure SetValues; override;
1565   end;
1566
1567   TfdX1BGR5us1 = class(TfdUniversalUS1)
1568     procedure SetValues; override;
1569   end;
1570
1571   TfdBGR8ub3 = class(TfdBGRub3)
1572     procedure SetValues; override;
1573   end;
1574
1575   TfdBGRX8ui1 = class(TfdUniversalUI1)
1576     procedure SetValues; override;
1577   end;
1578
1579   TfdXBGR8ui1 = class(TfdUniversalUI1)
1580     procedure SetValues; override;
1581   end;
1582
1583   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1584     procedure SetValues; override;
1585   end;
1586
1587   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1588     procedure SetValues; override;
1589   end;
1590
1591   TfdBGR16us3 = class(TfdBGRus3)
1592     procedure SetValues; override;
1593   end;
1594
1595   TfdBGRA4us1 = class(TfdUniversalUS1)
1596     procedure SetValues; override;
1597   end;
1598
1599   TfdABGR4us1 = class(TfdUniversalUS1)
1600     procedure SetValues; override;
1601   end;
1602
1603   TfdBGR5A1us1 = class(TfdUniversalUS1)
1604     procedure SetValues; override;
1605   end;
1606
1607   TfdA1BGR5us1 = class(TfdUniversalUS1)
1608     procedure SetValues; override;
1609   end;
1610
1611   TfdBGRA8ui1 = class(TfdUniversalUI1)
1612     procedure SetValues; override;
1613   end;
1614
1615   TfdABGR8ui1 = class(TfdUniversalUI1)
1616     procedure SetValues; override;
1617   end;
1618
1619   TfdBGRA8ub4 = class(TfdBGRAub4)
1620     procedure SetValues; override;
1621   end;
1622
1623   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1624     procedure SetValues; override;
1625   end;
1626
1627   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1628     procedure SetValues; override;
1629   end;
1630
1631   TfdBGRA16us4 = class(TfdBGRAus4)
1632     procedure SetValues; override;
1633   end;
1634
1635   TfdDepth16us1 = class(TfdDepthUS1)
1636     procedure SetValues; override;
1637   end;
1638
1639   TfdDepth24ui1 = class(TfdDepthUI1)
1640     procedure SetValues; override;
1641   end;
1642
1643   TfdDepth32ui1 = class(TfdDepthUI1)
1644     procedure SetValues; override;
1645   end;
1646
1647   TfdS3tcDtx1RGBA = 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   TfdS3tcDtx3RGBA = 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   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1660     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1661     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1662     procedure SetValues; override;
1663   end;
1664
1665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1666   TbmpBitfieldFormat = class(TFormatDescriptor)
1667   public
1668     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1669     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1670     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1671     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1672   end;
1673
1674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1675   TbmpColorTableEnty = packed record
1676     b, g, r, a: Byte;
1677   end;
1678   TbmpColorTable = array of TbmpColorTableEnty;
1679   TbmpColorTableFormat = class(TFormatDescriptor)
1680   private
1681     fColorTable: TbmpColorTable;
1682   protected
1683     procedure SetValues; override;
1684   public
1685     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1686
1687     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1688     procedure CalcValues;
1689     procedure CreateColorTable;
1690
1691     function CreateMappingData: Pointer; override;
1692     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1693     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1694     destructor Destroy; override;
1695   end;
1696
1697 const
1698   LUMINANCE_WEIGHT_R = 0.30;
1699   LUMINANCE_WEIGHT_G = 0.59;
1700   LUMINANCE_WEIGHT_B = 0.11;
1701
1702   ALPHA_WEIGHT_R = 0.30;
1703   ALPHA_WEIGHT_G = 0.59;
1704   ALPHA_WEIGHT_B = 0.11;
1705
1706   DEPTH_WEIGHT_R = 0.333333333;
1707   DEPTH_WEIGHT_G = 0.333333333;
1708   DEPTH_WEIGHT_B = 0.333333333;
1709
1710   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1711     TfdEmpty,
1712
1713     TfdAlpha4ub1,
1714     TfdAlpha8ub1,
1715     TfdAlpha16us1,
1716
1717     TfdLuminance4ub1,
1718     TfdLuminance8ub1,
1719     TfdLuminance16us1,
1720
1721     TfdLuminance4Alpha4ub2,
1722     TfdLuminance6Alpha2ub2,
1723     TfdLuminance8Alpha8ub2,
1724     TfdLuminance12Alpha4us2,
1725     TfdLuminance16Alpha16us2,
1726
1727     TfdR3G3B2ub1,
1728     TfdRGBX4us1,
1729     TfdXRGB4us1,
1730     TfdR5G6B5us1,
1731     TfdRGB5X1us1,
1732     TfdX1RGB5us1,
1733     TfdRGB8ub3,
1734     TfdRGBX8ui1,
1735     TfdXRGB8ui1,
1736     TfdRGB10X2ui1,
1737     TfdX2RGB10ui1,
1738     TfdRGB16us3,
1739
1740     TfdRGBA4us1,
1741     TfdARGB4us1,
1742     TfdRGB5A1us1,
1743     TfdA1RGB5us1,
1744     TfdRGBA8ui1,
1745     TfdARGB8ui1,
1746     TfdRGBA8ub4,
1747     TfdRGB10A2ui1,
1748     TfdA2RGB10ui1,
1749     TfdRGBA16us4,
1750
1751     TfdBGRX4us1,
1752     TfdXBGR4us1,
1753     TfdB5G6R5us1,
1754     TfdBGR5X1us1,
1755     TfdX1BGR5us1,
1756     TfdBGR8ub3,
1757     TfdBGRX8ui1,
1758     TfdXBGR8ui1,
1759     TfdBGR10X2ui1,
1760     TfdX2BGR10ui1,
1761     TfdBGR16us3,
1762
1763     TfdBGRA4us1,
1764     TfdABGR4us1,
1765     TfdBGR5A1us1,
1766     TfdA1BGR5us1,
1767     TfdBGRA8ui1,
1768     TfdABGR8ui1,
1769     TfdBGRA8ub4,
1770     TfdBGR10A2ui1,
1771     TfdA2BGR10ui1,
1772     TfdBGRA16us4,
1773
1774     TfdDepth16us1,
1775     TfdDepth24ui1,
1776     TfdDepth32ui1,
1777
1778     TfdS3tcDtx1RGBA,
1779     TfdS3tcDtx3RGBA,
1780     TfdS3tcDtx5RGBA
1781   );
1782
1783 var
1784   FormatDescriptorCS: TCriticalSection;
1785   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1786
1787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1788 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1789 begin
1790   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1791 end;
1792
1793 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1794 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1795 begin
1796   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1797 end;
1798
1799 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1800 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1801 begin
1802   result.Fields := [];
1803   if (X >= 0) then
1804     result.Fields := result.Fields + [ffX];
1805   if (Y >= 0) then
1806     result.Fields := result.Fields + [ffY];
1807   result.X := Max(0, X);
1808   result.Y := Max(0, Y);
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1813 begin
1814   result := glBitmapSize(X, Y);
1815 end;
1816
1817 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1818 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1819 begin
1820   result.r := r;
1821   result.g := g;
1822   result.b := b;
1823   result.a := a;
1824 end;
1825
1826 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1827 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1828 begin
1829   result.r := r;
1830   result.g := g;
1831   result.b := b;
1832   result.a := a;
1833 end;
1834
1835 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1836 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1837 begin
1838   result.r := r;
1839   result.g := g;
1840   result.b := b;
1841   result.a := a;
1842 end;
1843
1844 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1846 var
1847   i: Integer;
1848 begin
1849   result := false;
1850   for i := 0 to high(r1.arr) do
1851     if (r1.arr[i] <> r2.arr[i]) then
1852       exit;
1853   result := true;
1854 end;
1855
1856 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1857 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1858 var
1859   i: Integer;
1860 begin
1861   result := false;
1862   for i := 0 to high(r1.arr) do
1863     if (r1.arr[i] <> r2.arr[i]) then
1864       exit;
1865   result := true;
1866 end;
1867
1868 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1869 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1870 var
1871   desc: TFormatDescriptor;
1872   p, tmp: PByte;
1873   x, y, i: Integer;
1874   md: Pointer;
1875   px: TglBitmapPixelData;
1876 begin
1877   result := nil;
1878   desc := TFormatDescriptor.Get(aFormat);
1879   if (desc.IsCompressed) or (desc.glFormat = 0) then
1880     exit;
1881
1882   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1883   md := desc.CreateMappingData;
1884   try
1885     tmp := p;
1886     desc.PreparePixel(px);
1887     for y := 0 to 4 do
1888       for x := 0 to 4 do begin
1889         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1890         for i := 0 to 3 do begin
1891           if ((y < 3) and (y = i)) or
1892              ((y = 3) and (i < 3)) or
1893              ((y = 4) and (i = 3))
1894           then
1895             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1896           else if ((y < 4) and (i = 3)) or
1897                   ((y = 4) and (i < 3))
1898           then
1899             px.Data.arr[i] := px.Range.arr[i]
1900           else
1901             px.Data.arr[i] := 0; //px.Range.arr[i];
1902         end;
1903         desc.Map(px, tmp, md);
1904       end;
1905   finally
1906     desc.FreeMappingData(md);
1907   end;
1908
1909   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1910 end;
1911
1912 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1913 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1914 begin
1915   result.r := r;
1916   result.g := g;
1917   result.b := b;
1918   result.a := a;
1919 end;
1920
1921 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1922 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1923 begin
1924   result := [];
1925
1926   if (aFormat in [
1927         //8bpp
1928         tfAlpha4ub1, tfAlpha8ub1,
1929         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1930
1931         //16bpp
1932         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1933         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1934         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1935
1936         //24bpp
1937         tfBGR8ub3, tfRGB8ub3,
1938
1939         //32bpp
1940         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1941         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1942   then
1943     result := result + [ ftBMP ];
1944
1945   if (aFormat in [
1946         //8bbp
1947         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1948
1949         //16bbp
1950         tfAlpha16us1, tfLuminance16us1,
1951         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1952         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1953
1954         //24bbp
1955         tfBGR8ub3,
1956
1957         //32bbp
1958         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1959         tfDepth24ui1, tfDepth32ui1])
1960   then
1961     result := result + [ftTGA];
1962
1963   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1964     result := result + [ftDDS];
1965
1966 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1967   if aFormat in [
1968       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1969       tfRGB8ub3, tfRGBA8ui1,
1970       tfBGR8ub3, tfBGRA8ui1] then
1971     result := result + [ftPNG];
1972 {$ENDIF}
1973
1974 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1975   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1976     result := result + [ftJPEG];
1977 {$ENDIF}
1978 end;
1979
1980 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1981 function IsPowerOfTwo(aNumber: Integer): Boolean;
1982 begin
1983   while (aNumber and 1) = 0 do
1984     aNumber := aNumber shr 1;
1985   result := aNumber = 1;
1986 end;
1987
1988 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1989 function GetTopMostBit(aBitSet: QWord): Integer;
1990 begin
1991   result := 0;
1992   while aBitSet > 0 do begin
1993     inc(result);
1994     aBitSet := aBitSet shr 1;
1995   end;
1996 end;
1997
1998 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1999 function CountSetBits(aBitSet: QWord): Integer;
2000 begin
2001   result := 0;
2002   while aBitSet > 0 do begin
2003     if (aBitSet and 1) = 1 then
2004       inc(result);
2005     aBitSet := aBitSet shr 1;
2006   end;
2007 end;
2008
2009 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2010 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2011 begin
2012   result := Trunc(
2013     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2014     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2015     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2016 end;
2017
2018 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2019 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2020 begin
2021   result := Trunc(
2022     DEPTH_WEIGHT_R * aPixel.Data.r +
2023     DEPTH_WEIGHT_G * aPixel.Data.g +
2024     DEPTH_WEIGHT_B * aPixel.Data.b);
2025 end;
2026
2027 {$IFDEF GLB_SDL_IMAGE}
2028 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2029 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2030 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2031 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2032 begin
2033   result := TStream(context^.unknown.data1).Seek(offset, whence);
2034 end;
2035
2036 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2037 begin
2038   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2039 end;
2040
2041 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2042 begin
2043   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2044 end;
2045
2046 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2047 begin
2048   result := 0;
2049 end;
2050
2051 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2052 begin
2053   result := SDL_AllocRW;
2054
2055   if result = nil then
2056     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2057
2058   result^.seek := glBitmapRWseek;
2059   result^.read := glBitmapRWread;
2060   result^.write := glBitmapRWwrite;
2061   result^.close := glBitmapRWclose;
2062   result^.unknown.data1 := Stream;
2063 end;
2064 {$ENDIF}
2065
2066 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2067 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2068 begin
2069   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2070 end;
2071
2072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2073 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2074 begin
2075   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2076 end;
2077
2078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2079 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2080 begin
2081   glBitmapDefaultMipmap := aValue;
2082 end;
2083
2084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2085 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2086 begin
2087   glBitmapDefaultFormat := aFormat;
2088 end;
2089
2090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2091 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2092 begin
2093   glBitmapDefaultFilterMin := aMin;
2094   glBitmapDefaultFilterMag := aMag;
2095 end;
2096
2097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2098 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2099 begin
2100   glBitmapDefaultWrapS := S;
2101   glBitmapDefaultWrapT := T;
2102   glBitmapDefaultWrapR := R;
2103 end;
2104
2105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2106 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2107 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2108 begin
2109   glDefaultSwizzle[0] := r;
2110   glDefaultSwizzle[1] := g;
2111   glDefaultSwizzle[2] := b;
2112   glDefaultSwizzle[3] := a;
2113 end;
2114 {$IFEND}
2115
2116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2117 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2118 begin
2119   result := glBitmapDefaultDeleteTextureOnFree;
2120 end;
2121
2122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2123 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2124 begin
2125   result := glBitmapDefaultFreeDataAfterGenTextures;
2126 end;
2127
2128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2129 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2130 begin
2131   result := glBitmapDefaultMipmap;
2132 end;
2133
2134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2135 function glBitmapGetDefaultFormat: TglBitmapFormat;
2136 begin
2137   result := glBitmapDefaultFormat;
2138 end;
2139
2140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2141 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2142 begin
2143   aMin := glBitmapDefaultFilterMin;
2144   aMag := glBitmapDefaultFilterMag;
2145 end;
2146
2147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2148 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2149 begin
2150   S := glBitmapDefaultWrapS;
2151   T := glBitmapDefaultWrapT;
2152   R := glBitmapDefaultWrapR;
2153 end;
2154
2155 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2156 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2157 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2158 begin
2159   r := glDefaultSwizzle[0];
2160   g := glDefaultSwizzle[1];
2161   b := glDefaultSwizzle[2];
2162   a := glDefaultSwizzle[3];
2163 end;
2164 {$IFEND}
2165
2166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2167 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2168 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2169 function TFormatDescriptor.CreateMappingData: Pointer;
2170 begin
2171   result := nil;
2172 end;
2173
2174 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2175 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2176 begin
2177   //DUMMY
2178 end;
2179
2180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2181 function TFormatDescriptor.IsEmpty: Boolean;
2182 begin
2183   result := (fFormat = tfEmpty);
2184 end;
2185
2186 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2188 var
2189   i: Integer;
2190   m: TglBitmapRec4ul;
2191 begin
2192   result := false;
2193   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2194     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2195   m := Mask;
2196   for i := 0 to 3 do
2197     if (aMask.arr[i] <> m.arr[i]) then
2198       exit;
2199   result := true;
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2204 begin
2205   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2206   aPixel.Data   := Range;
2207   aPixel.Format := fFormat;
2208   aPixel.Range  := Range;
2209 end;
2210
2211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 constructor TFormatDescriptor.Create;
2213 begin
2214   inherited Create;
2215 end;
2216
2217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2218 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2219 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2221 begin
2222   aData^ := aPixel.Data.a;
2223   inc(aData);
2224 end;
2225
2226 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2227 begin
2228   aPixel.Data.r := 0;
2229   aPixel.Data.g := 0;
2230   aPixel.Data.b := 0;
2231   aPixel.Data.a := aData^;
2232   inc(aData);
2233 end;
2234
2235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2236 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2238 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2239 begin
2240   aData^ := LuminanceWeight(aPixel);
2241   inc(aData);
2242 end;
2243
2244 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2245 begin
2246   aPixel.Data.r := aData^;
2247   aPixel.Data.g := aData^;
2248   aPixel.Data.b := aData^;
2249   aPixel.Data.a := 0;
2250   inc(aData);
2251 end;
2252
2253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2254 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2257 var
2258   i: Integer;
2259 begin
2260   aData^ := 0;
2261   for i := 0 to 3 do
2262     if (Range.arr[i] > 0) then
2263       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2264   inc(aData);
2265 end;
2266
2267 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2268 var
2269   i: Integer;
2270 begin
2271   for i := 0 to 3 do
2272     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2273   inc(aData);
2274 end;
2275
2276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2277 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2280 begin
2281   inherited Map(aPixel, aData, aMapData);
2282   aData^ := aPixel.Data.a;
2283   inc(aData);
2284 end;
2285
2286 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2287 begin
2288   inherited Unmap(aData, aPixel, aMapData);
2289   aPixel.Data.a := aData^;
2290   inc(aData);
2291 end;
2292
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2297 begin
2298   aData^ := aPixel.Data.r;
2299   inc(aData);
2300   aData^ := aPixel.Data.g;
2301   inc(aData);
2302   aData^ := aPixel.Data.b;
2303   inc(aData);
2304 end;
2305
2306 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2307 begin
2308   aPixel.Data.r := aData^;
2309   inc(aData);
2310   aPixel.Data.g := aData^;
2311   inc(aData);
2312   aPixel.Data.b := aData^;
2313   inc(aData);
2314   aPixel.Data.a := 0;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2321 begin
2322   aData^ := aPixel.Data.b;
2323   inc(aData);
2324   aData^ := aPixel.Data.g;
2325   inc(aData);
2326   aData^ := aPixel.Data.r;
2327   inc(aData);
2328 end;
2329
2330 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2331 begin
2332   aPixel.Data.b := aData^;
2333   inc(aData);
2334   aPixel.Data.g := aData^;
2335   inc(aData);
2336   aPixel.Data.r := aData^;
2337   inc(aData);
2338   aPixel.Data.a := 0;
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2344 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2345 begin
2346   inherited Map(aPixel, aData, aMapData);
2347   aData^ := aPixel.Data.a;
2348   inc(aData);
2349 end;
2350
2351 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2352 begin
2353   inherited Unmap(aData, aPixel, aMapData);
2354   aPixel.Data.a := aData^;
2355   inc(aData);
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2361 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2362 begin
2363   inherited Map(aPixel, aData, aMapData);
2364   aData^ := aPixel.Data.a;
2365   inc(aData);
2366 end;
2367
2368 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2369 begin
2370   inherited Unmap(aData, aPixel, aMapData);
2371   aPixel.Data.a := aData^;
2372   inc(aData);
2373 end;
2374
2375 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2376 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2379 begin
2380   PWord(aData)^ := aPixel.Data.a;
2381   inc(aData, 2);
2382 end;
2383
2384 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2385 begin
2386   aPixel.Data.r := 0;
2387   aPixel.Data.g := 0;
2388   aPixel.Data.b := 0;
2389   aPixel.Data.a := PWord(aData)^;
2390   inc(aData, 2);
2391 end;
2392
2393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2394 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2396 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2397 begin
2398   PWord(aData)^ := LuminanceWeight(aPixel);
2399   inc(aData, 2);
2400 end;
2401
2402 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2403 begin
2404   aPixel.Data.r := PWord(aData)^;
2405   aPixel.Data.g := PWord(aData)^;
2406   aPixel.Data.b := PWord(aData)^;
2407   aPixel.Data.a := 0;
2408   inc(aData, 2);
2409 end;
2410
2411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2412 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2414 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2415 var
2416   i: Integer;
2417 begin
2418   PWord(aData)^ := 0;
2419   for i := 0 to 3 do
2420     if (Range.arr[i] > 0) then
2421       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2422   inc(aData, 2);
2423 end;
2424
2425 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2426 var
2427   i: Integer;
2428 begin
2429   for i := 0 to 3 do
2430     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2431   inc(aData, 2);
2432 end;
2433
2434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2435 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2438 begin
2439   PWord(aData)^ := DepthWeight(aPixel);
2440   inc(aData, 2);
2441 end;
2442
2443 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2444 begin
2445   aPixel.Data.r := PWord(aData)^;
2446   aPixel.Data.g := PWord(aData)^;
2447   aPixel.Data.b := PWord(aData)^;
2448   aPixel.Data.a := PWord(aData)^;;
2449   inc(aData, 2);
2450 end;
2451
2452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2453 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2456 begin
2457   inherited Map(aPixel, aData, aMapData);
2458   PWord(aData)^ := aPixel.Data.a;
2459   inc(aData, 2);
2460 end;
2461
2462 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2463 begin
2464   inherited Unmap(aData, aPixel, aMapData);
2465   aPixel.Data.a := PWord(aData)^;
2466   inc(aData, 2);
2467 end;
2468
2469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2470 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2473 begin
2474   PWord(aData)^ := aPixel.Data.r;
2475   inc(aData, 2);
2476   PWord(aData)^ := aPixel.Data.g;
2477   inc(aData, 2);
2478   PWord(aData)^ := aPixel.Data.b;
2479   inc(aData, 2);
2480 end;
2481
2482 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2483 begin
2484   aPixel.Data.r := PWord(aData)^;
2485   inc(aData, 2);
2486   aPixel.Data.g := PWord(aData)^;
2487   inc(aData, 2);
2488   aPixel.Data.b := PWord(aData)^;
2489   inc(aData, 2);
2490   aPixel.Data.a := 0;
2491 end;
2492
2493 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2496 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2497 begin
2498   PWord(aData)^ := aPixel.Data.b;
2499   inc(aData, 2);
2500   PWord(aData)^ := aPixel.Data.g;
2501   inc(aData, 2);
2502   PWord(aData)^ := aPixel.Data.r;
2503   inc(aData, 2);
2504 end;
2505
2506 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2507 begin
2508   aPixel.Data.b := PWord(aData)^;
2509   inc(aData, 2);
2510   aPixel.Data.g := PWord(aData)^;
2511   inc(aData, 2);
2512   aPixel.Data.r := PWord(aData)^;
2513   inc(aData, 2);
2514   aPixel.Data.a := 0;
2515 end;
2516
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2521 begin
2522   inherited Map(aPixel, aData, aMapData);
2523   PWord(aData)^ := aPixel.Data.a;
2524   inc(aData, 2);
2525 end;
2526
2527 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2528 begin
2529   inherited Unmap(aData, aPixel, aMapData);
2530   aPixel.Data.a := PWord(aData)^;
2531   inc(aData, 2);
2532 end;
2533
2534 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2535 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2537 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2538 begin
2539   PWord(aData)^ := aPixel.Data.a;
2540   inc(aData, 2);
2541   inherited Map(aPixel, aData, aMapData);
2542 end;
2543
2544 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2545 begin
2546   aPixel.Data.a := PWord(aData)^;
2547   inc(aData, 2);
2548   inherited Unmap(aData, aPixel, aMapData);
2549 end;
2550
2551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2552 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2555 begin
2556   inherited Map(aPixel, aData, aMapData);
2557   PWord(aData)^ := aPixel.Data.a;
2558   inc(aData, 2);
2559 end;
2560
2561 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2562 begin
2563   inherited Unmap(aData, aPixel, aMapData);
2564   aPixel.Data.a := PWord(aData)^;
2565   inc(aData, 2);
2566 end;
2567
2568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2569 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2572 begin
2573   PWord(aData)^ := aPixel.Data.a;
2574   inc(aData, 2);
2575   inherited Map(aPixel, aData, aMapData);
2576 end;
2577
2578 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2579 begin
2580   aPixel.Data.a := PWord(aData)^;
2581   inc(aData, 2);
2582   inherited Unmap(aData, aPixel, aMapData);
2583 end;
2584
2585 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2586 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2588 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2589 var
2590   i: Integer;
2591 begin
2592   PCardinal(aData)^ := 0;
2593   for i := 0 to 3 do
2594     if (Range.arr[i] > 0) then
2595       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2596   inc(aData, 4);
2597 end;
2598
2599 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2600 var
2601   i: Integer;
2602 begin
2603   for i := 0 to 3 do
2604     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2605   inc(aData, 2);
2606 end;
2607
2608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2609 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2612 begin
2613   PCardinal(aData)^ := DepthWeight(aPixel);
2614   inc(aData, 4);
2615 end;
2616
2617 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2618 begin
2619   aPixel.Data.r := PCardinal(aData)^;
2620   aPixel.Data.g := PCardinal(aData)^;
2621   aPixel.Data.b := PCardinal(aData)^;
2622   aPixel.Data.a := PCardinal(aData)^;
2623   inc(aData, 4);
2624 end;
2625
2626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2629 procedure TfdAlpha4ub1.SetValues;
2630 begin
2631   inherited SetValues;
2632   fBitsPerPixel     := 8;
2633   fFormat           := tfAlpha4ub1;
2634   fWithAlpha        := tfAlpha4ub1;
2635   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2636   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2637 {$IFNDEF OPENGL_ES}
2638   fOpenGLFormat     := tfAlpha4ub1;
2639   fglFormat         := GL_ALPHA;
2640   fglInternalFormat := GL_ALPHA4;
2641   fglDataFormat     := GL_UNSIGNED_BYTE;
2642 {$ELSE}
2643   fOpenGLFormat     := tfAlpha8ub1;
2644 {$ENDIF}
2645 end;
2646
2647 procedure TfdAlpha8ub1.SetValues;
2648 begin
2649   inherited SetValues;
2650   fBitsPerPixel     := 8;
2651   fFormat           := tfAlpha8ub1;
2652   fWithAlpha        := tfAlpha8ub1;
2653   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2654   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2655   fOpenGLFormat     := tfAlpha8ub1;
2656   fglFormat         := GL_ALPHA;
2657   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2658   fglDataFormat     := GL_UNSIGNED_BYTE;
2659 end;
2660
2661 procedure TfdAlpha16us1.SetValues;
2662 begin
2663   inherited SetValues;
2664   fBitsPerPixel     := 16;
2665   fFormat           := tfAlpha16us1;
2666   fWithAlpha        := tfAlpha16us1;
2667   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2668   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2669 {$IFNDEF OPENGL_ES}
2670   fOpenGLFormat     := tfAlpha16us1;
2671   fglFormat         := GL_ALPHA;
2672   fglInternalFormat := GL_ALPHA16;
2673   fglDataFormat     := GL_UNSIGNED_SHORT;
2674 {$ELSE}
2675   fOpenGLFormat     := tfAlpha8ub1;
2676 {$ENDIF}
2677 end;
2678
2679 procedure TfdLuminance4ub1.SetValues;
2680 begin
2681   inherited SetValues;
2682   fBitsPerPixel     := 8;
2683   fFormat           := tfLuminance4ub1;
2684   fWithAlpha        := tfLuminance4Alpha4ub2;
2685   fWithoutAlpha     := tfLuminance4ub1;
2686   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2687   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2688 {$IFNDEF OPENGL_ES}
2689   fOpenGLFormat     := tfLuminance4ub1;
2690   fglFormat         := GL_LUMINANCE;
2691   fglInternalFormat := GL_LUMINANCE4;
2692   fglDataFormat     := GL_UNSIGNED_BYTE;
2693 {$ELSE}
2694   fOpenGLFormat     := tfLuminance8ub1;
2695 {$ENDIF}
2696 end;
2697
2698 procedure TfdLuminance8ub1.SetValues;
2699 begin
2700   inherited SetValues;
2701   fBitsPerPixel     := 8;
2702   fFormat           := tfLuminance8ub1;
2703   fWithAlpha        := tfLuminance8Alpha8ub2;
2704   fWithoutAlpha     := tfLuminance8ub1;
2705   fOpenGLFormat     := tfLuminance8ub1;
2706   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2707   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2708   fglFormat         := GL_LUMINANCE;
2709   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2710   fglDataFormat     := GL_UNSIGNED_BYTE;
2711 end;
2712
2713 procedure TfdLuminance16us1.SetValues;
2714 begin
2715   inherited SetValues;
2716   fBitsPerPixel     := 16;
2717   fFormat           := tfLuminance16us1;
2718   fWithAlpha        := tfLuminance16Alpha16us2;
2719   fWithoutAlpha     := tfLuminance16us1;
2720   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2721   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2722 {$IFNDEF OPENGL_ES}
2723   fOpenGLFormat     := tfLuminance16us1;
2724   fglFormat         := GL_LUMINANCE;
2725   fglInternalFormat := GL_LUMINANCE16;
2726   fglDataFormat     := GL_UNSIGNED_SHORT;
2727 {$ELSE}
2728   fOpenGLFormat     := tfLuminance8ub1;
2729 {$ENDIF}
2730 end;
2731
2732 procedure TfdLuminance4Alpha4ub2.SetValues;
2733 begin
2734   inherited SetValues;
2735   fBitsPerPixel     := 16;
2736   fFormat           := tfLuminance4Alpha4ub2;
2737   fWithAlpha        := tfLuminance4Alpha4ub2;
2738   fWithoutAlpha     := tfLuminance4ub1;
2739   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2740   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2741 {$IFNDEF OPENGL_ES}
2742   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2743   fglFormat         := GL_LUMINANCE_ALPHA;
2744   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2745   fglDataFormat     := GL_UNSIGNED_BYTE;
2746 {$ELSE}
2747   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2748 {$ENDIF}
2749 end;
2750
2751 procedure TfdLuminance6Alpha2ub2.SetValues;
2752 begin
2753   inherited SetValues;
2754   fBitsPerPixel     := 16;
2755   fFormat           := tfLuminance6Alpha2ub2;
2756   fWithAlpha        := tfLuminance6Alpha2ub2;
2757   fWithoutAlpha     := tfLuminance8ub1;
2758   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2759   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2760 {$IFNDEF OPENGL_ES}
2761   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2762   fglFormat         := GL_LUMINANCE_ALPHA;
2763   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2764   fglDataFormat     := GL_UNSIGNED_BYTE;
2765 {$ELSE}
2766   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2767 {$ENDIF}
2768 end;
2769
2770 procedure TfdLuminance8Alpha8ub2.SetValues;
2771 begin
2772   inherited SetValues;
2773   fBitsPerPixel     := 16;
2774   fFormat           := tfLuminance8Alpha8ub2;
2775   fWithAlpha        := tfLuminance8Alpha8ub2;
2776   fWithoutAlpha     := tfLuminance8ub1;
2777   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2778   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2779   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2780   fglFormat         := GL_LUMINANCE_ALPHA;
2781   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2782   fglDataFormat     := GL_UNSIGNED_BYTE;
2783 end;
2784
2785 procedure TfdLuminance12Alpha4us2.SetValues;
2786 begin
2787   inherited SetValues;
2788   fBitsPerPixel     := 32;
2789   fFormat           := tfLuminance12Alpha4us2;
2790   fWithAlpha        := tfLuminance12Alpha4us2;
2791   fWithoutAlpha     := tfLuminance16us1;
2792   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2793   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2794 {$IFNDEF OPENGL_ES}
2795   fOpenGLFormat     := tfLuminance12Alpha4us2;
2796   fglFormat         := GL_LUMINANCE_ALPHA;
2797   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2798   fglDataFormat     := GL_UNSIGNED_SHORT;
2799 {$ELSE}
2800   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2801 {$ENDIF}
2802 end;
2803
2804 procedure TfdLuminance16Alpha16us2.SetValues;
2805 begin
2806   inherited SetValues;
2807   fBitsPerPixel     := 32;
2808   fFormat           := tfLuminance16Alpha16us2;
2809   fWithAlpha        := tfLuminance16Alpha16us2;
2810   fWithoutAlpha     := tfLuminance16us1;
2811   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2812   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2813 {$IFNDEF OPENGL_ES}
2814   fOpenGLFormat     := tfLuminance16Alpha16us2;
2815   fglFormat         := GL_LUMINANCE_ALPHA;
2816   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2817   fglDataFormat     := GL_UNSIGNED_SHORT;
2818 {$ELSE}
2819   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2820 {$ENDIF}
2821 end;
2822
2823 procedure TfdR3G3B2ub1.SetValues;
2824 begin
2825   inherited SetValues;
2826   fBitsPerPixel     := 8;
2827   fFormat           := tfR3G3B2ub1;
2828   fWithAlpha        := tfRGBA4us1;
2829   fWithoutAlpha     := tfR3G3B2ub1;
2830   fRGBInverted      := tfEmpty;
2831   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2832   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2833 {$IFNDEF OPENGL_ES}
2834   fOpenGLFormat     := tfR3G3B2ub1;
2835   fglFormat         := GL_RGB;
2836   fglInternalFormat := GL_R3_G3_B2;
2837   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2838 {$ELSE}
2839   fOpenGLFormat     := tfR5G6B5us1;
2840 {$ENDIF}
2841 end;
2842
2843 procedure TfdRGBX4us1.SetValues;
2844 begin
2845   inherited SetValues;
2846   fBitsPerPixel     := 16;
2847   fFormat           := tfRGBX4us1;
2848   fWithAlpha        := tfRGBA4us1;
2849   fWithoutAlpha     := tfRGBX4us1;
2850   fRGBInverted      := tfBGRX4us1;
2851   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2852   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2853 {$IFNDEF OPENGL_ES}
2854   fOpenGLFormat     := tfRGBX4us1;
2855   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2856   fglInternalFormat := GL_RGB4;
2857   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2858 {$ELSE}
2859   fOpenGLFormat     := tfR5G6B5us1;
2860 {$ENDIF}
2861 end;
2862
2863 procedure TfdXRGB4us1.SetValues;
2864 begin
2865   inherited SetValues;
2866   fBitsPerPixel     := 16;
2867   fFormat           := tfXRGB4us1;
2868   fWithAlpha        := tfARGB4us1;
2869   fWithoutAlpha     := tfXRGB4us1;
2870   fRGBInverted      := tfXBGR4us1;
2871   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2872   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2873 {$IFNDEF OPENGL_ES}
2874   fOpenGLFormat     := tfXRGB4us1;
2875   fglFormat         := GL_BGRA;
2876   fglInternalFormat := GL_RGB4;
2877   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2878 {$ELSE}
2879   fOpenGLFormat     := tfR5G6B5us1;
2880 {$ENDIF}
2881 end;
2882
2883 procedure TfdR5G6B5us1.SetValues;
2884 begin
2885   inherited SetValues;
2886   fBitsPerPixel     := 16;
2887   fFormat           := tfR5G6B5us1;
2888   fWithAlpha        := tfRGB5A1us1;
2889   fWithoutAlpha     := tfR5G6B5us1;
2890   fRGBInverted      := tfB5G6R5us1;
2891   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2892   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2893 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2894   fOpenGLFormat     := tfR5G6B5us1;
2895   fglFormat         := GL_RGB;
2896   fglInternalFormat := GL_RGB565;
2897   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2898 {$ELSE}
2899   fOpenGLFormat     := tfRGB8ub3;
2900 {$IFEND}
2901 end;
2902
2903 procedure TfdRGB5X1us1.SetValues;
2904 begin
2905   inherited SetValues;
2906   fBitsPerPixel     := 16;
2907   fFormat           := tfRGB5X1us1;
2908   fWithAlpha        := tfRGB5A1us1;
2909   fWithoutAlpha     := tfRGB5X1us1;
2910   fRGBInverted      := tfBGR5X1us1;
2911   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2912   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2913 {$IFNDEF OPENGL_ES}
2914   fOpenGLFormat     := tfRGB5X1us1;
2915   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2916   fglInternalFormat := GL_RGB5;
2917   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2918 {$ELSE}
2919   fOpenGLFormat     := tfR5G6B5us1;
2920 {$ENDIF}
2921 end;
2922
2923 procedure TfdX1RGB5us1.SetValues;
2924 begin
2925   inherited SetValues;
2926   fBitsPerPixel     := 16;
2927   fFormat           := tfX1RGB5us1;
2928   fWithAlpha        := tfA1RGB5us1;
2929   fWithoutAlpha     := tfX1RGB5us1;
2930   fRGBInverted      := tfX1BGR5us1;
2931   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2932   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2933 {$IFNDEF OPENGL_ES}
2934   fOpenGLFormat     := tfX1RGB5us1;
2935   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2936   fglInternalFormat := GL_RGB5;
2937   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2938 {$ELSE}
2939   fOpenGLFormat     := tfR5G6B5us1;
2940 {$ENDIF}
2941 end;
2942
2943 procedure TfdRGB8ub3.SetValues;
2944 begin
2945   inherited SetValues;
2946   fBitsPerPixel     := 24;
2947   fFormat           := tfRGB8ub3;
2948   fWithAlpha        := tfRGBA8ub4;
2949   fWithoutAlpha     := tfRGB8ub3;
2950   fRGBInverted      := tfBGR8ub3;
2951   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2952   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2953   fOpenGLFormat     := tfRGB8ub3;
2954   fglFormat         := GL_RGB;
2955   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2956   fglDataFormat     := GL_UNSIGNED_BYTE;
2957 end;
2958
2959 procedure TfdRGBX8ui1.SetValues;
2960 begin
2961   inherited SetValues;
2962   fBitsPerPixel     := 32;
2963   fFormat           := tfRGBX8ui1;
2964   fWithAlpha        := tfRGBA8ui1;
2965   fWithoutAlpha     := tfRGBX8ui1;
2966   fRGBInverted      := tfBGRX8ui1;
2967   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2968   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2969 {$IFNDEF OPENGL_ES}
2970   fOpenGLFormat     := tfRGBX8ui1;
2971   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2972   fglInternalFormat := GL_RGB8;
2973   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2974 {$ELSE}
2975   fOpenGLFormat     := tfRGB8ub3;
2976 {$ENDIF}
2977 end;
2978
2979 procedure TfdXRGB8ui1.SetValues;
2980 begin
2981   inherited SetValues;
2982   fBitsPerPixel     := 32;
2983   fFormat           := tfXRGB8ui1;
2984   fWithAlpha        := tfXRGB8ui1;
2985   fWithoutAlpha     := tfXRGB8ui1;
2986   fOpenGLFormat     := tfXRGB8ui1;
2987   fRGBInverted      := tfXBGR8ui1;
2988   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2989   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2990 {$IFNDEF OPENGL_ES}
2991   fOpenGLFormat     := tfXRGB8ui1;
2992   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2993   fglInternalFormat := GL_RGB8;
2994   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2995 {$ELSE}
2996   fOpenGLFormat     := tfRGB8ub3;
2997 {$ENDIF}
2998 end;
2999
3000 procedure TfdRGB10X2ui1.SetValues;
3001 begin
3002   inherited SetValues;
3003   fBitsPerPixel     := 32;
3004   fFormat           := tfRGB10X2ui1;
3005   fWithAlpha        := tfRGB10A2ui1;
3006   fWithoutAlpha     := tfRGB10X2ui1;
3007   fRGBInverted      := tfBGR10X2ui1;
3008   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3009   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3010 {$IFNDEF OPENGL_ES}
3011   fOpenGLFormat     := tfRGB10X2ui1;
3012   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3013   fglInternalFormat := GL_RGB10;
3014   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3015 {$ELSE}
3016   fOpenGLFormat     := tfRGB16us3;
3017 {$ENDIF}
3018 end;
3019
3020 procedure TfdX2RGB10ui1.SetValues;
3021 begin
3022   inherited SetValues;
3023   fBitsPerPixel     := 32;
3024   fFormat           := tfX2RGB10ui1;
3025   fWithAlpha        := tfA2RGB10ui1;
3026   fWithoutAlpha     := tfX2RGB10ui1;
3027   fRGBInverted      := tfX2BGR10ui1;
3028   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3029   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3030 {$IFNDEF OPENGL_ES}
3031   fOpenGLFormat     := tfX2RGB10ui1;
3032   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3033   fglInternalFormat := GL_RGB10;
3034   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3035 {$ELSE}
3036   fOpenGLFormat     := tfRGB16us3;
3037 {$ENDIF}
3038 end;
3039
3040 procedure TfdRGB16us3.SetValues;
3041 begin
3042   inherited SetValues;
3043   fBitsPerPixel     := 48;
3044   fFormat           := tfRGB16us3;
3045   fWithAlpha        := tfRGBA16us4;
3046   fWithoutAlpha     := tfRGB16us3;
3047   fRGBInverted      := tfBGR16us3;
3048   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3049   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3050 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3051   fOpenGLFormat     := tfRGB16us3;
3052   fglFormat         := GL_RGB;
3053   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3054   fglDataFormat     := GL_UNSIGNED_SHORT;
3055 {$ELSE}
3056   fOpenGLFormat     := tfRGB8ub3;
3057 {$IFEND}
3058 end;
3059
3060 procedure TfdRGBA4us1.SetValues;
3061 begin
3062   inherited SetValues;
3063   fBitsPerPixel     := 16;
3064   fFormat           := tfRGBA4us1;
3065   fWithAlpha        := tfRGBA4us1;
3066   fWithoutAlpha     := tfRGBX4us1;
3067   fOpenGLFormat     := tfRGBA4us1;
3068   fRGBInverted      := tfBGRA4us1;
3069   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3070   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3071   fglFormat         := GL_RGBA;
3072   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3073   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3074 end;
3075
3076 procedure TfdARGB4us1.SetValues;
3077 begin
3078   inherited SetValues;
3079   fBitsPerPixel     := 16;
3080   fFormat           := tfARGB4us1;
3081   fWithAlpha        := tfARGB4us1;
3082   fWithoutAlpha     := tfXRGB4us1;
3083   fRGBInverted      := tfABGR4us1;
3084   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3085   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3086 {$IFNDEF OPENGL_ES}
3087   fOpenGLFormat     := tfARGB4us1;
3088   fglFormat         := GL_BGRA;
3089   fglInternalFormat := GL_RGBA4;
3090   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3091 {$ELSE}
3092   fOpenGLFormat     := tfRGBA4us1;
3093 {$ENDIF}
3094 end;
3095
3096 procedure TfdRGB5A1us1.SetValues;
3097 begin
3098   inherited SetValues;
3099   fBitsPerPixel     := 16;
3100   fFormat           := tfRGB5A1us1;
3101   fWithAlpha        := tfRGB5A1us1;
3102   fWithoutAlpha     := tfRGB5X1us1;
3103   fOpenGLFormat     := tfRGB5A1us1;
3104   fRGBInverted      := tfBGR5A1us1;
3105   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3106   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3107   fglFormat         := GL_RGBA;
3108   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3109   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3110 end;
3111
3112 procedure TfdA1RGB5us1.SetValues;
3113 begin
3114   inherited SetValues;
3115   fBitsPerPixel     := 16;
3116   fFormat           := tfA1RGB5us1;
3117   fWithAlpha        := tfA1RGB5us1;
3118   fWithoutAlpha     := tfX1RGB5us1;
3119   fRGBInverted      := tfA1BGR5us1;
3120   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3121   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3122 {$IFNDEF OPENGL_ES}
3123   fOpenGLFormat     := tfA1RGB5us1;
3124   fglFormat         := GL_BGRA;
3125   fglInternalFormat := GL_RGB5_A1;
3126   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3127 {$ELSE}
3128   fOpenGLFormat     := tfRGB5A1us1;
3129 {$ENDIF}
3130 end;
3131
3132 procedure TfdRGBA8ui1.SetValues;
3133 begin
3134   inherited SetValues;
3135   fBitsPerPixel     := 32;
3136   fFormat           := tfRGBA8ui1;
3137   fWithAlpha        := tfRGBA8ui1;
3138   fWithoutAlpha     := tfRGBX8ui1;
3139   fRGBInverted      := tfBGRA8ui1;
3140   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3141   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3142 {$IFNDEF OPENGL_ES}
3143   fOpenGLFormat     := tfRGBA8ui1;
3144   fglFormat         := GL_RGBA;
3145   fglInternalFormat := GL_RGBA8;
3146   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3147 {$ELSE}
3148   fOpenGLFormat     := tfRGBA8ub4;
3149 {$ENDIF}
3150 end;
3151
3152 procedure TfdARGB8ui1.SetValues;
3153 begin
3154   inherited SetValues;
3155   fBitsPerPixel     := 32;
3156   fFormat           := tfARGB8ui1;
3157   fWithAlpha        := tfARGB8ui1;
3158   fWithoutAlpha     := tfXRGB8ui1;
3159   fRGBInverted      := tfABGR8ui1;
3160   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3161   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3162 {$IFNDEF OPENGL_ES}
3163   fOpenGLFormat     := tfARGB8ui1;
3164   fglFormat         := GL_BGRA;
3165   fglInternalFormat := GL_RGBA8;
3166   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3167 {$ELSE}
3168   fOpenGLFormat     := tfRGBA8ub4;
3169 {$ENDIF}
3170 end;
3171
3172 procedure TfdRGBA8ub4.SetValues;
3173 begin
3174   inherited SetValues;
3175   fBitsPerPixel     := 32;
3176   fFormat           := tfRGBA8ub4;
3177   fWithAlpha        := tfRGBA8ub4;
3178   fWithoutAlpha     := tfRGB8ub3;
3179   fOpenGLFormat     := tfRGBA8ub4;
3180   fRGBInverted      := tfBGRA8ub4;
3181   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3182   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3183   fglFormat         := GL_RGBA;
3184   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3185   fglDataFormat     := GL_UNSIGNED_BYTE;
3186 end;
3187
3188 procedure TfdRGB10A2ui1.SetValues;
3189 begin
3190   inherited SetValues;
3191   fBitsPerPixel     := 32;
3192   fFormat           := tfRGB10A2ui1;
3193   fWithAlpha        := tfRGB10A2ui1;
3194   fWithoutAlpha     := tfRGB10X2ui1;
3195   fRGBInverted      := tfBGR10A2ui1;
3196   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3197   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3198 {$IFNDEF OPENGL_ES}
3199   fOpenGLFormat     := tfRGB10A2ui1;
3200   fglFormat         := GL_RGBA;
3201   fglInternalFormat := GL_RGB10_A2;
3202   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3203 {$ELSE}
3204   fOpenGLFormat     := tfA2RGB10ui1;
3205 {$ENDIF}
3206 end;
3207
3208 procedure TfdA2RGB10ui1.SetValues;
3209 begin
3210   inherited SetValues;
3211   fBitsPerPixel     := 32;
3212   fFormat           := tfA2RGB10ui1;
3213   fWithAlpha        := tfA2RGB10ui1;
3214   fWithoutAlpha     := tfX2RGB10ui1;
3215   fRGBInverted      := tfA2BGR10ui1;
3216   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3217   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3218 {$IF NOT DEFINED(OPENGL_ES)}
3219   fOpenGLFormat     := tfA2RGB10ui1;
3220   fglFormat         := GL_BGRA;
3221   fglInternalFormat := GL_RGB10_A2;
3222   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3223 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3224   fOpenGLFormat     := tfA2RGB10ui1;
3225   fglFormat         := GL_RGBA;
3226   fglInternalFormat := GL_RGB10_A2;
3227   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3228 {$ELSE}
3229   fOpenGLFormat     := tfRGBA8ui1;
3230 {$IFEND}
3231 end;
3232
3233 procedure TfdRGBA16us4.SetValues;
3234 begin
3235   inherited SetValues;
3236   fBitsPerPixel     := 64;
3237   fFormat           := tfRGBA16us4;
3238   fWithAlpha        := tfRGBA16us4;
3239   fWithoutAlpha     := tfRGB16us3;
3240   fRGBInverted      := tfBGRA16us4;
3241   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3242   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3243 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3244   fOpenGLFormat     := tfRGBA16us4;
3245   fglFormat         := GL_RGBA;
3246   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3247   fglDataFormat     := GL_UNSIGNED_SHORT;
3248 {$ELSE}
3249   fOpenGLFormat     := tfRGBA8ub4;
3250 {$IFEND}
3251 end;
3252
3253 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3256 procedure TfdBGRX4us1.SetValues;
3257 begin
3258   inherited SetValues;
3259   fBitsPerPixel     := 16;
3260   fFormat           := tfBGRX4us1;
3261   fWithAlpha        := tfBGRA4us1;
3262   fWithoutAlpha     := tfBGRX4us1;
3263   fRGBInverted      := tfRGBX4us1;
3264   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3265   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3266 {$IFNDEF OPENGL_ES}
3267   fOpenGLFormat     := tfBGRX4us1;
3268   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3269   fglInternalFormat := GL_RGB4;
3270   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3271 {$ELSE}
3272   fOpenGLFormat     := tfR5G6B5us1;
3273 {$ENDIF}
3274 end;
3275
3276 procedure TfdXBGR4us1.SetValues;
3277 begin
3278   inherited SetValues;
3279   fBitsPerPixel     := 16;
3280   fFormat           := tfXBGR4us1;
3281   fWithAlpha        := tfABGR4us1;
3282   fWithoutAlpha     := tfXBGR4us1;
3283   fRGBInverted      := tfXRGB4us1;
3284   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3285   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3286 {$IFNDEF OPENGL_ES}
3287   fOpenGLFormat     := tfXBGR4us1;
3288   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3289   fglInternalFormat := GL_RGB4;
3290   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3291 {$ELSE}
3292   fOpenGLFormat     := tfR5G6B5us1;
3293 {$ENDIF}
3294 end;
3295
3296 procedure TfdB5G6R5us1.SetValues;
3297 begin
3298   inherited SetValues;
3299   fBitsPerPixel     := 16;
3300   fFormat           := tfB5G6R5us1;
3301   fWithAlpha        := tfBGR5A1us1;
3302   fWithoutAlpha     := tfB5G6R5us1;
3303   fRGBInverted      := tfR5G6B5us1;
3304   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3305   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3306 {$IFNDEF OPENGL_ES}
3307   fOpenGLFormat     := tfB5G6R5us1;
3308   fglFormat         := GL_RGB;
3309   fglInternalFormat := GL_RGB565;
3310   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3311 {$ELSE}
3312   fOpenGLFormat     := tfR5G6B5us1;
3313 {$ENDIF}
3314 end;
3315
3316 procedure TfdBGR5X1us1.SetValues;
3317 begin
3318   inherited SetValues;
3319   fBitsPerPixel     := 16;
3320   fFormat           := tfBGR5X1us1;
3321   fWithAlpha        := tfBGR5A1us1;
3322   fWithoutAlpha     := tfBGR5X1us1;
3323   fRGBInverted      := tfRGB5X1us1;
3324   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3325   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3326 {$IFNDEF OPENGL_ES}
3327   fOpenGLFormat     := tfBGR5X1us1;
3328   fglFormat         := GL_BGRA;
3329   fglInternalFormat := GL_RGB5;
3330   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3331 {$ELSE}
3332   fOpenGLFormat     := tfR5G6B5us1;
3333 {$ENDIF}
3334 end;
3335
3336 procedure TfdX1BGR5us1.SetValues;
3337 begin
3338   inherited SetValues;
3339   fBitsPerPixel     := 16;
3340   fFormat           := tfX1BGR5us1;
3341   fWithAlpha        := tfA1BGR5us1;
3342   fWithoutAlpha     := tfX1BGR5us1;
3343   fRGBInverted      := tfX1RGB5us1;
3344   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3345   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3346 {$IFNDEF OPENGL_ES}
3347   fOpenGLFormat     := tfX1BGR5us1;
3348   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3349   fglInternalFormat := GL_RGB5;
3350   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3351 {$ELSE}
3352   fOpenGLFormat     := tfR5G6B5us1;
3353 {$ENDIF}
3354 end;
3355
3356 procedure TfdBGR8ub3.SetValues;
3357 begin
3358   inherited SetValues;
3359   fBitsPerPixel     := 24;
3360   fFormat           := tfBGR8ub3;
3361   fWithAlpha        := tfBGRA8ub4;
3362   fWithoutAlpha     := tfBGR8ub3;
3363   fRGBInverted      := tfRGB8ub3;
3364   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3365   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3366 {$IFNDEF OPENGL_ES}
3367   fOpenGLFormat     := tfBGR8ub3;
3368   fglFormat         := GL_BGR;
3369   fglInternalFormat := GL_RGB8;
3370   fglDataFormat     := GL_UNSIGNED_BYTE;
3371 {$ELSE}
3372   fOpenGLFormat     := tfRGB8ub3;
3373 {$ENDIF}
3374 end;
3375
3376 procedure TfdBGRX8ui1.SetValues;
3377 begin
3378   inherited SetValues;
3379   fBitsPerPixel     := 32;
3380   fFormat           := tfBGRX8ui1;
3381   fWithAlpha        := tfBGRA8ui1;
3382   fWithoutAlpha     := tfBGRX8ui1;
3383   fRGBInverted      := tfRGBX8ui1;
3384   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3385   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3386 {$IFNDEF OPENGL_ES}
3387   fOpenGLFormat     := tfBGRX8ui1;
3388   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3389   fglInternalFormat := GL_RGB8;
3390   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3391 {$ELSE}
3392   fOpenGLFormat     := tfRGB8ub3;
3393 {$ENDIF}
3394 end;
3395
3396 procedure TfdXBGR8ui1.SetValues;
3397 begin
3398   inherited SetValues;
3399   fBitsPerPixel     := 32;
3400   fFormat           := tfXBGR8ui1;
3401   fWithAlpha        := tfABGR8ui1;
3402   fWithoutAlpha     := tfXBGR8ui1;
3403   fRGBInverted      := tfXRGB8ui1;
3404   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3405   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3406 {$IFNDEF OPENGL_ES}
3407   fOpenGLFormat     := tfXBGR8ui1;
3408   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3409   fglInternalFormat := GL_RGB8;
3410   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3411 {$ELSE}
3412   fOpenGLFormat     := tfRGB8ub3;
3413 {$ENDIF}
3414 end;
3415
3416 procedure TfdBGR10X2ui1.SetValues;
3417 begin
3418   inherited SetValues;
3419   fBitsPerPixel     := 32;
3420   fFormat           := tfBGR10X2ui1;
3421   fWithAlpha        := tfBGR10A2ui1;
3422   fWithoutAlpha     := tfBGR10X2ui1;
3423   fRGBInverted      := tfRGB10X2ui1;
3424   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3425   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3426 {$IFNDEF OPENGL_ES}
3427   fOpenGLFormat     := tfBGR10X2ui1;
3428   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3429   fglInternalFormat := GL_RGB10;
3430   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3431 {$ELSE}
3432   fOpenGLFormat     := tfRGB16us3;
3433 {$ENDIF}
3434 end;
3435
3436 procedure TfdX2BGR10ui1.SetValues;
3437 begin
3438   inherited SetValues;
3439   fBitsPerPixel     := 32;
3440   fFormat           := tfX2BGR10ui1;
3441   fWithAlpha        := tfA2BGR10ui1;
3442   fWithoutAlpha     := tfX2BGR10ui1;
3443   fRGBInverted      := tfX2RGB10ui1;
3444   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3445   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3446 {$IFNDEF OPENGL_ES}
3447   fOpenGLFormat     := tfX2BGR10ui1;
3448   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3449   fglInternalFormat := GL_RGB10;
3450   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3451 {$ELSE}
3452   fOpenGLFormat     := tfRGB16us3;
3453 {$ENDIF}
3454 end;
3455
3456 procedure TfdBGR16us3.SetValues;
3457 begin
3458   inherited SetValues;
3459   fBitsPerPixel     := 48;
3460   fFormat           := tfBGR16us3;
3461   fWithAlpha        := tfBGRA16us4;
3462   fWithoutAlpha     := tfBGR16us3;
3463   fRGBInverted      := tfRGB16us3;
3464   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3465   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3466 {$IFNDEF OPENGL_ES}
3467   fOpenGLFormat     := tfBGR16us3;
3468   fglFormat         := GL_BGR;
3469   fglInternalFormat := GL_RGB16;
3470   fglDataFormat     := GL_UNSIGNED_SHORT;
3471 {$ELSE}
3472   fOpenGLFormat     := tfRGB16us3;
3473 {$ENDIF}
3474 end;
3475
3476 procedure TfdBGRA4us1.SetValues;
3477 begin
3478   inherited SetValues;
3479   fBitsPerPixel     := 16;
3480   fFormat           := tfBGRA4us1;
3481   fWithAlpha        := tfBGRA4us1;
3482   fWithoutAlpha     := tfBGRX4us1;
3483   fRGBInverted      := tfRGBA4us1;
3484   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3485   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3486 {$IFNDEF OPENGL_ES}
3487   fOpenGLFormat     := tfBGRA4us1;
3488   fglFormat         := GL_BGRA;
3489   fglInternalFormat := GL_RGBA4;
3490   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3491 {$ELSE}
3492   fOpenGLFormat     := tfRGBA4us1;
3493 {$ENDIF}
3494 end;
3495
3496 procedure TfdABGR4us1.SetValues;
3497 begin
3498   inherited SetValues;
3499   fBitsPerPixel     := 16;
3500   fFormat           := tfABGR4us1;
3501   fWithAlpha        := tfABGR4us1;
3502   fWithoutAlpha     := tfXBGR4us1;
3503   fRGBInverted      := tfARGB4us1;
3504   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3505   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3506 {$IFNDEF OPENGL_ES}
3507   fOpenGLFormat     := tfABGR4us1;
3508   fglFormat         := GL_RGBA;
3509   fglInternalFormat := GL_RGBA4;
3510   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3511 {$ELSE}
3512   fOpenGLFormat     := tfRGBA4us1;
3513 {$ENDIF}
3514 end;
3515
3516 procedure TfdBGR5A1us1.SetValues;
3517 begin
3518   inherited SetValues;
3519   fBitsPerPixel     := 16;
3520   fFormat           := tfBGR5A1us1;
3521   fWithAlpha        := tfBGR5A1us1;
3522   fWithoutAlpha     := tfBGR5X1us1;
3523   fRGBInverted      := tfRGB5A1us1;
3524   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3525   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3526 {$IFNDEF OPENGL_ES}
3527   fOpenGLFormat     := tfBGR5A1us1;
3528   fglFormat         := GL_BGRA;
3529   fglInternalFormat := GL_RGB5_A1;
3530   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3531 {$ELSE}
3532   fOpenGLFormat     := tfRGB5A1us1;
3533 {$ENDIF}
3534 end;
3535
3536 procedure TfdA1BGR5us1.SetValues;
3537 begin
3538   inherited SetValues;
3539   fBitsPerPixel     := 16;
3540   fFormat           := tfA1BGR5us1;
3541   fWithAlpha        := tfA1BGR5us1;
3542   fWithoutAlpha     := tfX1BGR5us1;
3543   fRGBInverted      := tfA1RGB5us1;
3544   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3545   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3546 {$IFNDEF OPENGL_ES}
3547   fOpenGLFormat     := tfA1BGR5us1;
3548   fglFormat         := GL_RGBA;
3549   fglInternalFormat := GL_RGB5_A1;
3550   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3551 {$ELSE}
3552   fOpenGLFormat     := tfRGB5A1us1;
3553 {$ENDIF}
3554 end;
3555
3556 procedure TfdBGRA8ui1.SetValues;
3557 begin
3558   inherited SetValues;
3559   fBitsPerPixel     := 32;
3560   fFormat           := tfBGRA8ui1;
3561   fWithAlpha        := tfBGRA8ui1;
3562   fWithoutAlpha     := tfBGRX8ui1;
3563   fRGBInverted      := tfRGBA8ui1;
3564   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3565   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3566 {$IFNDEF OPENGL_ES}
3567   fOpenGLFormat     := tfBGRA8ui1;
3568   fglFormat         := GL_BGRA;
3569   fglInternalFormat := GL_RGBA8;
3570   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3571 {$ELSE}
3572   fOpenGLFormat     := tfRGBA8ub4;
3573 {$ENDIF}
3574 end;
3575
3576 procedure TfdABGR8ui1.SetValues;
3577 begin
3578   inherited SetValues;
3579   fBitsPerPixel     := 32;
3580   fFormat           := tfABGR8ui1;
3581   fWithAlpha        := tfABGR8ui1;
3582   fWithoutAlpha     := tfXBGR8ui1;
3583   fRGBInverted      := tfARGB8ui1;
3584   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3585   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3586 {$IFNDEF OPENGL_ES}
3587   fOpenGLFormat     := tfABGR8ui1;
3588   fglFormat         := GL_RGBA;
3589   fglInternalFormat := GL_RGBA8;
3590   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3591 {$ELSE}
3592   fOpenGLFormat     := tfRGBA8ub4
3593 {$ENDIF}
3594 end;
3595
3596 procedure TfdBGRA8ub4.SetValues;
3597 begin
3598   inherited SetValues;
3599   fBitsPerPixel     := 32;
3600   fFormat           := tfBGRA8ub4;
3601   fWithAlpha        := tfBGRA8ub4;
3602   fWithoutAlpha     := tfBGR8ub3;
3603   fRGBInverted      := tfRGBA8ub4;
3604   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3605   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3606 {$IFNDEF OPENGL_ES}
3607   fOpenGLFormat     := tfBGRA8ub4;
3608   fglFormat         := GL_BGRA;
3609   fglInternalFormat := GL_RGBA8;
3610   fglDataFormat     := GL_UNSIGNED_BYTE;
3611 {$ELSE}
3612   fOpenGLFormat     := tfRGBA8ub4;
3613 {$ENDIF}
3614 end;
3615
3616 procedure TfdBGR10A2ui1.SetValues;
3617 begin
3618   inherited SetValues;
3619   fBitsPerPixel     := 32;
3620   fFormat           := tfBGR10A2ui1;
3621   fWithAlpha        := tfBGR10A2ui1;
3622   fWithoutAlpha     := tfBGR10X2ui1;
3623   fRGBInverted      := tfRGB10A2ui1;
3624   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3625   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3626 {$IFNDEF OPENGL_ES}
3627   fOpenGLFormat     := tfBGR10A2ui1;
3628   fglFormat         := GL_BGRA;
3629   fglInternalFormat := GL_RGB10_A2;
3630   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3631 {$ELSE}
3632   fOpenGLFormat     := tfA2RGB10ui1;
3633 {$ENDIF}
3634 end;
3635
3636 procedure TfdA2BGR10ui1.SetValues;
3637 begin
3638   inherited SetValues;
3639   fBitsPerPixel     := 32;
3640   fFormat           := tfA2BGR10ui1;
3641   fWithAlpha        := tfA2BGR10ui1;
3642   fWithoutAlpha     := tfX2BGR10ui1;
3643   fRGBInverted      := tfA2RGB10ui1;
3644   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3645   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3646 {$IFNDEF OPENGL_ES}
3647   fOpenGLFormat     := tfA2BGR10ui1;
3648   fglFormat         := GL_RGBA;
3649   fglInternalFormat := GL_RGB10_A2;
3650   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3651 {$ELSE}
3652   fOpenGLFormat     := tfA2RGB10ui1;
3653 {$ENDIF}
3654 end;
3655
3656 procedure TfdBGRA16us4.SetValues;
3657 begin
3658   inherited SetValues;
3659   fBitsPerPixel     := 64;
3660   fFormat           := tfBGRA16us4;
3661   fWithAlpha        := tfBGRA16us4;
3662   fWithoutAlpha     := tfBGR16us3;
3663   fRGBInverted      := tfRGBA16us4;
3664   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3665   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3666 {$IFNDEF OPENGL_ES}
3667   fOpenGLFormat     := tfBGRA16us4;
3668   fglFormat         := GL_BGRA;
3669   fglInternalFormat := GL_RGBA16;
3670   fglDataFormat     := GL_UNSIGNED_SHORT;
3671 {$ELSE}
3672   fOpenGLFormat     := tfRGBA16us4;
3673 {$ENDIF}
3674 end;
3675
3676 procedure TfdDepth16us1.SetValues;
3677 begin
3678   inherited SetValues;
3679   fBitsPerPixel     := 16;
3680   fFormat           := tfDepth16us1;
3681   fWithoutAlpha     := tfDepth16us1;
3682   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3683   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3684 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3685   fOpenGLFormat     := tfDepth16us1;
3686   fglFormat         := GL_DEPTH_COMPONENT;
3687   fglInternalFormat := GL_DEPTH_COMPONENT16;
3688   fglDataFormat     := GL_UNSIGNED_SHORT;
3689 {$IFEND}
3690 end;
3691
3692 procedure TfdDepth24ui1.SetValues;
3693 begin
3694   inherited SetValues;
3695   fBitsPerPixel     := 32;
3696   fFormat           := tfDepth24ui1;
3697   fWithoutAlpha     := tfDepth24ui1;
3698   fOpenGLFormat     := tfDepth24ui1;
3699   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3700   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3701 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3702   fOpenGLFormat     := tfDepth24ui1;
3703   fglFormat         := GL_DEPTH_COMPONENT;
3704   fglInternalFormat := GL_DEPTH_COMPONENT24;
3705   fglDataFormat     := GL_UNSIGNED_INT;
3706 {$IFEND}
3707 end;
3708
3709 procedure TfdDepth32ui1.SetValues;
3710 begin
3711   inherited SetValues;
3712   fBitsPerPixel     := 32;
3713   fFormat           := tfDepth32ui1;
3714   fWithoutAlpha     := tfDepth32ui1;
3715   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3716   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3717 {$IF NOT DEFINED(OPENGL_ES)}
3718   fOpenGLFormat     := tfDepth32ui1;
3719   fglFormat         := GL_DEPTH_COMPONENT;
3720   fglInternalFormat := GL_DEPTH_COMPONENT32;
3721   fglDataFormat     := GL_UNSIGNED_INT;
3722 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3723   fOpenGLFormat     := tfDepth24ui1;
3724 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3725   fOpenGLFormat     := tfDepth16us1;
3726 {$IFEND}
3727 end;
3728
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3733 begin
3734   raise EglBitmap.Create('mapping for compressed formats is not supported');
3735 end;
3736
3737 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3738 begin
3739   raise EglBitmap.Create('mapping for compressed formats is not supported');
3740 end;
3741
3742 procedure TfdS3tcDtx1RGBA.SetValues;
3743 begin
3744   inherited SetValues;
3745   fFormat           := tfS3tcDtx1RGBA;
3746   fWithAlpha        := tfS3tcDtx1RGBA;
3747   fUncompressed     := tfRGB5A1us1;
3748   fBitsPerPixel     := 4;
3749   fIsCompressed     := true;
3750 {$IFNDEF OPENGL_ES}
3751   fOpenGLFormat     := tfS3tcDtx1RGBA;
3752   fglFormat         := GL_COMPRESSED_RGBA;
3753   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3754   fglDataFormat     := GL_UNSIGNED_BYTE;
3755 {$ELSE}
3756   fOpenGLFormat     := fUncompressed;
3757 {$ENDIF}
3758 end;
3759
3760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3761 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3763 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3764 begin
3765   raise EglBitmap.Create('mapping for compressed formats is not supported');
3766 end;
3767
3768 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3769 begin
3770   raise EglBitmap.Create('mapping for compressed formats is not supported');
3771 end;
3772
3773 procedure TfdS3tcDtx3RGBA.SetValues;
3774 begin
3775   inherited SetValues;
3776   fFormat           := tfS3tcDtx3RGBA;
3777   fWithAlpha        := tfS3tcDtx3RGBA;
3778   fUncompressed     := tfRGBA8ub4;
3779   fBitsPerPixel     := 8;
3780   fIsCompressed     := true;
3781 {$IFNDEF OPENGL_ES}
3782   fOpenGLFormat     := tfS3tcDtx3RGBA;
3783   fglFormat         := GL_COMPRESSED_RGBA;
3784   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3785   fglDataFormat     := GL_UNSIGNED_BYTE;
3786 {$ELSE}
3787   fOpenGLFormat     := fUncompressed;
3788 {$ENDIF}
3789 end;
3790
3791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3794 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3795 begin
3796   raise EglBitmap.Create('mapping for compressed formats is not supported');
3797 end;
3798
3799 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3800 begin
3801   raise EglBitmap.Create('mapping for compressed formats is not supported');
3802 end;
3803
3804 procedure TfdS3tcDtx5RGBA.SetValues;
3805 begin
3806   inherited SetValues;
3807   fFormat           := tfS3tcDtx3RGBA;
3808   fWithAlpha        := tfS3tcDtx3RGBA;
3809   fUncompressed     := tfRGBA8ub4;
3810   fBitsPerPixel     := 8;
3811   fIsCompressed     := true;
3812 {$IFNDEF OPENGL_ES}
3813   fOpenGLFormat     := tfS3tcDtx3RGBA;
3814   fglFormat         := GL_COMPRESSED_RGBA;
3815   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3816   fglDataFormat     := GL_UNSIGNED_BYTE;
3817 {$ELSE}
3818   fOpenGLFormat     := fUncompressed;
3819 {$ENDIF}
3820 end;
3821
3822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3823 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3825 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3826 begin
3827   result := (fPrecision.r > 0);
3828 end;
3829
3830 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3831 begin
3832   result := (fPrecision.g > 0);
3833 end;
3834
3835 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3836 begin
3837   result := (fPrecision.b > 0);
3838 end;
3839
3840 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3841 begin
3842   result := (fPrecision.a > 0);
3843 end;
3844
3845 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3846 begin
3847   result := HasRed or HasGreen or HasBlue;
3848 end;
3849
3850 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3851 begin
3852   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3853 end;
3854
3855 function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
3856 begin
3857   result := (OpenGLFormat = Format);
3858 end;
3859
3860 procedure TglBitmapFormatDescriptor.SetValues;
3861 begin
3862   fFormat       := tfEmpty;
3863   fWithAlpha    := tfEmpty;
3864   fWithoutAlpha := tfEmpty;
3865   fOpenGLFormat := tfEmpty;
3866   fRGBInverted  := tfEmpty;
3867   fUncompressed := tfEmpty;
3868
3869   fBitsPerPixel := 0;
3870   fIsCompressed := false;
3871
3872   fglFormat         := 0;
3873   fglInternalFormat := 0;
3874   fglDataFormat     := 0;
3875
3876   FillChar(fPrecision, 0, SizeOf(fPrecision));
3877   FillChar(fShift,     0, SizeOf(fShift));
3878 end;
3879
3880 procedure TglBitmapFormatDescriptor.CalcValues;
3881 var
3882   i: Integer;
3883 begin
3884   fBytesPerPixel := fBitsPerPixel / 8;
3885   fChannelCount  := 0;
3886   for i := 0 to 3 do begin
3887     if (fPrecision.arr[i] > 0) then
3888       inc(fChannelCount);
3889     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3890     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3891   end;
3892 end;
3893
3894 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3895 var
3896   w, h: Integer;
3897 begin
3898   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3899     w := Max(1, aSize.X);
3900     h := Max(1, aSize.Y);
3901     result := GetSize(w, h);
3902   end else
3903     result := 0;
3904 end;
3905
3906 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3907 begin
3908   result := 0;
3909   if (aWidth <= 0) or (aHeight <= 0) then
3910     exit;
3911   result := Ceil(aWidth * aHeight * BytesPerPixel);
3912 end;
3913
3914 constructor TglBitmapFormatDescriptor.Create;
3915 begin
3916   inherited Create;
3917   SetValues;
3918   CalcValues;
3919 end;
3920
3921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3922 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3923 var
3924   f: TglBitmapFormat;
3925 begin
3926   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3927     result := TFormatDescriptor.Get(f);
3928     if (result.glInternalFormat = aInternalFormat) then
3929       exit;
3930   end;
3931   result := TFormatDescriptor.Get(tfEmpty);
3932 end;
3933
3934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3935 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3936 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3937 class procedure TFormatDescriptor.Init;
3938 begin
3939   if not Assigned(FormatDescriptorCS) then
3940     FormatDescriptorCS := TCriticalSection.Create;
3941 end;
3942
3943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3944 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3945 begin
3946   FormatDescriptorCS.Enter;
3947   try
3948     result := FormatDescriptors[aFormat];
3949     if not Assigned(result) then begin
3950       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3951       FormatDescriptors[aFormat] := result;
3952     end;
3953   finally
3954     FormatDescriptorCS.Leave;
3955   end;
3956 end;
3957
3958 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3959 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3960 begin
3961   result := Get(Get(aFormat).WithAlpha);
3962 end;
3963
3964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3965 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3966 var
3967   ft: TglBitmapFormat;
3968 begin
3969   // find matching format with OpenGL support
3970   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3971     result := Get(ft);
3972     if (result.MaskMatch(aMask))      and
3973        (result.glFormat <> 0)         and
3974        (result.glInternalFormat <> 0) and
3975        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3976     then
3977       exit;
3978   end;
3979
3980   // find matching format without OpenGL Support
3981   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3982     result := Get(ft);
3983     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3984       exit;
3985   end;
3986
3987   result := TFormatDescriptor.Get(tfEmpty);
3988 end;
3989
3990 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3991 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3992 var
3993   ft: TglBitmapFormat;
3994 begin
3995   // find matching format with OpenGL support
3996   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3997     result := Get(ft);
3998     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3999        glBitmapRec4ubCompare(result.Precision, aPrec) and
4000        (result.glFormat <> 0)         and
4001        (result.glInternalFormat <> 0) and
4002        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4003     then
4004       exit;
4005   end;
4006
4007   // find matching format without OpenGL Support
4008   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4009     result := Get(ft);
4010     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4011        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4012        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4013       exit;
4014   end;
4015
4016   result := TFormatDescriptor.Get(tfEmpty);
4017 end;
4018
4019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4020 class procedure TFormatDescriptor.Clear;
4021 var
4022   f: TglBitmapFormat;
4023 begin
4024   FormatDescriptorCS.Enter;
4025   try
4026     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4027       FreeAndNil(FormatDescriptors[f]);
4028   finally
4029     FormatDescriptorCS.Leave;
4030   end;
4031 end;
4032
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 class procedure TFormatDescriptor.Finalize;
4035 begin
4036   Clear;
4037   FreeAndNil(FormatDescriptorCS);
4038 end;
4039
4040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4041 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4042 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4043 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4044 var
4045   i: Integer;
4046 begin
4047   for i := 0 to 3 do begin
4048     fShift.arr[i] := 0;
4049     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4050       aMask.arr[i] := aMask.arr[i] shr 1;
4051       inc(fShift.arr[i]);
4052     end;
4053     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4054   end;
4055   fBitsPerPixel := aBPP;
4056   CalcValues;
4057 end;
4058
4059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4060 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4061 begin
4062   fBitsPerPixel := aBBP;
4063   fPrecision    := aPrec;
4064   fShift        := aShift;
4065   CalcValues;
4066 end;
4067
4068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4069 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4070 var
4071   data: QWord;
4072 begin
4073   data :=
4074     ((aPixel.Data.r and Range.r) shl Shift.r) or
4075     ((aPixel.Data.g and Range.g) shl Shift.g) or
4076     ((aPixel.Data.b and Range.b) shl Shift.b) or
4077     ((aPixel.Data.a and Range.a) shl Shift.a);
4078   case BitsPerPixel of
4079     8:           aData^  := data;
4080    16:     PWord(aData)^ := data;
4081    32: PCardinal(aData)^ := data;
4082    64:    PQWord(aData)^ := data;
4083   else
4084     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4085   end;
4086   inc(aData, Round(BytesPerPixel));
4087 end;
4088
4089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4090 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4091 var
4092   data: QWord;
4093   i: Integer;
4094 begin
4095   case BitsPerPixel of
4096      8: data :=           aData^;
4097     16: data :=     PWord(aData)^;
4098     32: data := PCardinal(aData)^;
4099     64: data :=    PQWord(aData)^;
4100   else
4101     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4102   end;
4103   for i := 0 to 3 do
4104     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4105   inc(aData, Round(BytesPerPixel));
4106 end;
4107
4108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4111 procedure TbmpColorTableFormat.SetValues;
4112 begin
4113   inherited SetValues;
4114   fShift := glBitmapRec4ub(8, 8, 8, 0);
4115 end;
4116
4117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4118 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4119 begin
4120   fFormat       := aFormat;
4121   fBitsPerPixel := aBPP;
4122   fPrecision    := aPrec;
4123   fShift        := aShift;
4124   CalcValues;
4125 end;
4126
4127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4128 procedure TbmpColorTableFormat.CalcValues;
4129 begin
4130   inherited CalcValues;
4131 end;
4132
4133 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4134 procedure TbmpColorTableFormat.CreateColorTable;
4135 var
4136   i: Integer;
4137 begin
4138   SetLength(fColorTable, 256);
4139   if not HasColor then begin
4140     // alpha
4141     for i := 0 to High(fColorTable) do begin
4142       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4143       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4144       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4145       fColorTable[i].a := 0;
4146     end;
4147   end else begin
4148     // normal
4149     for i := 0 to High(fColorTable) do begin
4150       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4151       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4152       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4153       fColorTable[i].a := 0;
4154     end;
4155   end;
4156 end;
4157
4158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4159 function TbmpColorTableFormat.CreateMappingData: Pointer;
4160 begin
4161   result := Pointer(0);
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4166 begin
4167   if (BitsPerPixel <> 8) then
4168     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4169   if not HasColor then
4170     // alpha
4171     aData^ := aPixel.Data.a
4172   else
4173     // normal
4174     aData^ := Round(
4175       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4176       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4177       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4178   inc(aData);
4179 end;
4180
4181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4182 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4183
4184   function ReadValue: Byte;
4185   var
4186     i: PtrUInt;
4187   begin
4188     if (BitsPerPixel = 8) then begin
4189       result := aData^;
4190       inc(aData);
4191     end else begin
4192       i := {%H-}PtrUInt(aMapData);
4193       if (BitsPerPixel > 1) then
4194         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4195       else
4196         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4197       inc(i, BitsPerPixel);
4198       while (i >= 8) do begin
4199         inc(aData);
4200         dec(i, 8);
4201       end;
4202       aMapData := {%H-}Pointer(i);
4203     end;
4204   end;
4205
4206 begin
4207   if (BitsPerPixel > 8) then
4208     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4209   with fColorTable[ReadValue] do begin
4210     aPixel.Data.r := r;
4211     aPixel.Data.g := g;
4212     aPixel.Data.b := b;
4213     aPixel.Data.a := a;
4214   end;
4215 end;
4216
4217 destructor TbmpColorTableFormat.Destroy;
4218 begin
4219   SetLength(fColorTable, 0);
4220   inherited Destroy;
4221 end;
4222
4223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4224 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4227 var
4228   i: Integer;
4229 begin
4230   for i := 0 to 3 do begin
4231     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4232       if (aSourceFD.Range.arr[i] > 0) then
4233         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4234       else
4235         aPixel.Data.arr[i] := 0;
4236     end;
4237   end;
4238 end;
4239
4240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4241 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4242 begin
4243   with aFuncRec do begin
4244     if (Source.Range.r   > 0) then
4245       Dest.Data.r := Source.Data.r;
4246     if (Source.Range.g > 0) then
4247       Dest.Data.g := Source.Data.g;
4248     if (Source.Range.b  > 0) then
4249       Dest.Data.b := Source.Data.b;
4250     if (Source.Range.a > 0) then
4251       Dest.Data.a := Source.Data.a;
4252   end;
4253 end;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4257 var
4258   i: Integer;
4259 begin
4260   with aFuncRec do begin
4261     for i := 0 to 3 do
4262       if (Source.Range.arr[i] > 0) then
4263         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4264   end;
4265 end;
4266
4267 type
4268   TShiftData = packed record
4269     case Integer of
4270       0: (r, g, b, a: SmallInt);
4271       1: (arr: array[0..3] of SmallInt);
4272   end;
4273   PShiftData = ^TShiftData;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4277 var
4278   i: Integer;
4279 begin
4280   with aFuncRec do
4281     for i := 0 to 3 do
4282       if (Source.Range.arr[i] > 0) then
4283         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4284 end;
4285
4286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4287 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4288 var
4289   i: Integer;
4290 begin
4291   with aFuncRec do begin
4292     Dest.Data := Source.Data;
4293     for i := 0 to 3 do
4294       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4295         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4296   end;
4297 end;
4298
4299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4300 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4301 var
4302   i: Integer;
4303 begin
4304   with aFuncRec do begin
4305     for i := 0 to 3 do
4306       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4307   end;
4308 end;
4309
4310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4311 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4312 var
4313   Temp: Single;
4314 begin
4315   with FuncRec do begin
4316     if (FuncRec.Args = nil) then begin //source has no alpha
4317       Temp :=
4318         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4319         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4320         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4321       Dest.Data.a := Round(Dest.Range.a * Temp);
4322     end else
4323       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4324   end;
4325 end;
4326
4327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4329 type
4330   PglBitmapPixelData = ^TglBitmapPixelData;
4331 begin
4332   with FuncRec do begin
4333     Dest.Data.r := Source.Data.r;
4334     Dest.Data.g := Source.Data.g;
4335     Dest.Data.b := Source.Data.b;
4336
4337     with PglBitmapPixelData(Args)^ do
4338       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4339           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4340           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4341         Dest.Data.a := 0
4342       else
4343         Dest.Data.a := Dest.Range.a;
4344   end;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4349 begin
4350   with FuncRec do begin
4351     Dest.Data.r := Source.Data.r;
4352     Dest.Data.g := Source.Data.g;
4353     Dest.Data.b := Source.Data.b;
4354     Dest.Data.a := PCardinal(Args)^;
4355   end;
4356 end;
4357
4358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4359 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4360 type
4361   PRGBPix = ^TRGBPix;
4362   TRGBPix = array [0..2] of byte;
4363 var
4364   Temp: Byte;
4365 begin
4366   while aWidth > 0 do begin
4367     Temp := PRGBPix(aData)^[0];
4368     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4369     PRGBPix(aData)^[2] := Temp;
4370
4371     if aHasAlpha then
4372       Inc(aData, 4)
4373     else
4374       Inc(aData, 3);
4375     dec(aWidth);
4376   end;
4377 end;
4378
4379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4380 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4381 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4382 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4383 begin
4384   result := TFormatDescriptor.Get(fFormat);
4385 end;
4386
4387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4388 function TglBitmapData.GetWidth: Integer;
4389 begin
4390   if (ffX in fDimension.Fields) then
4391     result := fDimension.X
4392   else
4393     result := -1;
4394 end;
4395
4396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4397 function TglBitmapData.GetHeight: Integer;
4398 begin
4399   if (ffY in fDimension.Fields) then
4400     result := fDimension.Y
4401   else
4402     result := -1;
4403 end;
4404
4405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4406 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4407 begin
4408   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4409     result := fScanlines[aIndex]
4410   else
4411     result := nil;
4412 end;
4413
4414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4415 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4416 begin
4417   if fFormat = aValue then
4418     exit;
4419   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4420     raise EglBitmapUnsupportedFormat.Create(Format);
4421   SetData(fData, aValue, Width, Height);
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4426 var
4427   TempPos: Integer;
4428 begin
4429   if not Assigned(aResType) then begin
4430     TempPos   := Pos('.', aResource);
4431     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4432     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4433   end;
4434 end;
4435
4436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4437 procedure TglBitmapData.UpdateScanlines;
4438 var
4439   w, h, i, LineWidth: Integer;
4440 begin
4441   w := Width;
4442   h := Height;
4443   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4444   if fHasScanlines then begin
4445     SetLength(fScanlines, h);
4446     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4447     for i := 0 to h-1 do begin
4448       fScanlines[i] := fData;
4449       Inc(fScanlines[i], i * LineWidth);
4450     end;
4451   end else
4452     SetLength(fScanlines, 0);
4453 end;
4454
4455 {$IFDEF GLB_SUPPORT_PNG_READ}
4456 {$IF DEFINED(GLB_LAZ_PNG)}
4457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4458 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4460 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4461 const
4462   MAGIC_LEN = 8;
4463   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4464 var
4465   reader: TLazReaderPNG;
4466   intf: TLazIntfImage;
4467   StreamPos: Int64;
4468   magic: String[MAGIC_LEN];
4469 begin
4470   result := true;
4471   StreamPos := aStream.Position;
4472
4473   SetLength(magic, MAGIC_LEN);
4474   aStream.Read(magic[1], MAGIC_LEN);
4475   aStream.Position := StreamPos;
4476   if (magic <> PNG_MAGIC) then begin
4477     result := false;
4478     exit;
4479   end;
4480
4481   intf   := TLazIntfImage.Create(0, 0);
4482   reader := TLazReaderPNG.Create;
4483   try try
4484     reader.UpdateDescription := true;
4485     reader.ImageRead(aStream, intf);
4486     AssignFromLazIntfImage(intf);
4487   except
4488     result := false;
4489     aStream.Position := StreamPos;
4490     exit;
4491   end;
4492   finally
4493     reader.Free;
4494     intf.Free;
4495   end;
4496 end;
4497
4498 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4500 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4501 var
4502   Surface: PSDL_Surface;
4503   RWops: PSDL_RWops;
4504 begin
4505   result := false;
4506   RWops := glBitmapCreateRWops(aStream);
4507   try
4508     if IMG_isPNG(RWops) > 0 then begin
4509       Surface := IMG_LoadPNG_RW(RWops);
4510       try
4511         AssignFromSurface(Surface);
4512         result := true;
4513       finally
4514         SDL_FreeSurface(Surface);
4515       end;
4516     end;
4517   finally
4518     SDL_FreeRW(RWops);
4519   end;
4520 end;
4521
4522 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4524 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4525 begin
4526   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4527 end;
4528
4529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4530 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4531 var
4532   StreamPos: Int64;
4533   signature: array [0..7] of byte;
4534   png: png_structp;
4535   png_info: png_infop;
4536
4537   TempHeight, TempWidth: Integer;
4538   Format: TglBitmapFormat;
4539
4540   png_data: pByte;
4541   png_rows: array of pByte;
4542   Row, LineSize: Integer;
4543 begin
4544   result := false;
4545
4546   if not init_libPNG then
4547     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4548
4549   try
4550     // signature
4551     StreamPos := aStream.Position;
4552     aStream.Read(signature{%H-}, 8);
4553     aStream.Position := StreamPos;
4554
4555     if png_check_sig(@signature, 8) <> 0 then begin
4556       // png read struct
4557       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4558       if png = nil then
4559         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4560
4561       // png info
4562       png_info := png_create_info_struct(png);
4563       if png_info = nil then begin
4564         png_destroy_read_struct(@png, nil, nil);
4565         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4566       end;
4567
4568       // set read callback
4569       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4570
4571       // read informations
4572       png_read_info(png, png_info);
4573
4574       // size
4575       TempHeight := png_get_image_height(png, png_info);
4576       TempWidth := png_get_image_width(png, png_info);
4577
4578       // format
4579       case png_get_color_type(png, png_info) of
4580         PNG_COLOR_TYPE_GRAY:
4581           Format := tfLuminance8ub1;
4582         PNG_COLOR_TYPE_GRAY_ALPHA:
4583           Format := tfLuminance8Alpha8us1;
4584         PNG_COLOR_TYPE_RGB:
4585           Format := tfRGB8ub3;
4586         PNG_COLOR_TYPE_RGB_ALPHA:
4587           Format := tfRGBA8ub4;
4588         else
4589           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4590       end;
4591
4592       // cut upper 8 bit from 16 bit formats
4593       if png_get_bit_depth(png, png_info) > 8 then
4594         png_set_strip_16(png);
4595
4596       // expand bitdepth smaller than 8
4597       if png_get_bit_depth(png, png_info) < 8 then
4598         png_set_expand(png);
4599
4600       // allocating mem for scanlines
4601       LineSize := png_get_rowbytes(png, png_info);
4602       GetMem(png_data, TempHeight * LineSize);
4603       try
4604         SetLength(png_rows, TempHeight);
4605         for Row := Low(png_rows) to High(png_rows) do begin
4606           png_rows[Row] := png_data;
4607           Inc(png_rows[Row], Row * LineSize);
4608         end;
4609
4610         // read complete image into scanlines
4611         png_read_image(png, @png_rows[0]);
4612
4613         // read end
4614         png_read_end(png, png_info);
4615
4616         // destroy read struct
4617         png_destroy_read_struct(@png, @png_info, nil);
4618
4619         SetLength(png_rows, 0);
4620
4621         // set new data
4622         SetData(png_data, Format, TempWidth, TempHeight);
4623
4624         result := true;
4625       except
4626         if Assigned(png_data) then
4627           FreeMem(png_data);
4628         raise;
4629       end;
4630     end;
4631   finally
4632     quit_libPNG;
4633   end;
4634 end;
4635
4636 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4639 var
4640   StreamPos: Int64;
4641   Png: TPNGObject;
4642   Header: String[8];
4643   Row, Col, PixSize, LineSize: Integer;
4644   NewImage, pSource, pDest, pAlpha: pByte;
4645   PngFormat: TglBitmapFormat;
4646   FormatDesc: TFormatDescriptor;
4647
4648 const
4649   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4650
4651 begin
4652   result := false;
4653
4654   StreamPos := aStream.Position;
4655   aStream.Read(Header[0], SizeOf(Header));
4656   aStream.Position := StreamPos;
4657
4658   {Test if the header matches}
4659   if Header = PngHeader then begin
4660     Png := TPNGObject.Create;
4661     try
4662       Png.LoadFromStream(aStream);
4663
4664       case Png.Header.ColorType of
4665         COLOR_GRAYSCALE:
4666           PngFormat := tfLuminance8ub1;
4667         COLOR_GRAYSCALEALPHA:
4668           PngFormat := tfLuminance8Alpha8us1;
4669         COLOR_RGB:
4670           PngFormat := tfBGR8ub3;
4671         COLOR_RGBALPHA:
4672           PngFormat := tfBGRA8ub4;
4673         else
4674           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4675       end;
4676
4677       FormatDesc := TFormatDescriptor.Get(PngFormat);
4678       PixSize    := Round(FormatDesc.PixelSize);
4679       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4680
4681       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4682       try
4683         pDest := NewImage;
4684
4685         case Png.Header.ColorType of
4686           COLOR_RGB, COLOR_GRAYSCALE:
4687             begin
4688               for Row := 0 to Png.Height -1 do begin
4689                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4690                 Inc(pDest, LineSize);
4691               end;
4692             end;
4693           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4694             begin
4695               PixSize := PixSize -1;
4696
4697               for Row := 0 to Png.Height -1 do begin
4698                 pSource := Png.Scanline[Row];
4699                 pAlpha := pByte(Png.AlphaScanline[Row]);
4700
4701                 for Col := 0 to Png.Width -1 do begin
4702                   Move (pSource^, pDest^, PixSize);
4703                   Inc(pSource, PixSize);
4704                   Inc(pDest, PixSize);
4705
4706                   pDest^ := pAlpha^;
4707                   inc(pAlpha);
4708                   Inc(pDest);
4709                 end;
4710               end;
4711             end;
4712           else
4713             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4714         end;
4715
4716         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4717
4718         result := true;
4719       except
4720         if Assigned(NewImage) then
4721           FreeMem(NewImage);
4722         raise;
4723       end;
4724     finally
4725       Png.Free;
4726     end;
4727   end;
4728 end;
4729 {$IFEND}
4730 {$ENDIF}
4731
4732 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4733 {$IFDEF GLB_LIB_PNG}
4734 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4735 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4736 begin
4737   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4738 end;
4739 {$ENDIF}
4740
4741 {$IF DEFINED(GLB_LAZ_PNG)}
4742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4743 procedure TglBitmapData.SavePNG(const aStream: TStream);
4744 var
4745   png: TPortableNetworkGraphic;
4746   intf: TLazIntfImage;
4747   raw: TRawImage;
4748 begin
4749   png  := TPortableNetworkGraphic.Create;
4750   intf := TLazIntfImage.Create(0, 0);
4751   try
4752     if not AssignToLazIntfImage(intf) then
4753       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4754     intf.GetRawImage(raw);
4755     png.LoadFromRawImage(raw, false);
4756     png.SaveToStream(aStream);
4757   finally
4758     png.Free;
4759     intf.Free;
4760   end;
4761 end;
4762
4763 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4765 procedure TglBitmapData.SavePNG(const aStream: TStream);
4766 var
4767   png: png_structp;
4768   png_info: png_infop;
4769   png_rows: array of pByte;
4770   LineSize: Integer;
4771   ColorType: Integer;
4772   Row: Integer;
4773   FormatDesc: TFormatDescriptor;
4774 begin
4775   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4776     raise EglBitmapUnsupportedFormat.Create(Format);
4777
4778   if not init_libPNG then
4779     raise Exception.Create('unable to initialize libPNG.');
4780
4781   try
4782     case Format of
4783       tfAlpha8ub1, tfLuminance8ub1:
4784         ColorType := PNG_COLOR_TYPE_GRAY;
4785       tfLuminance8Alpha8us1:
4786         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4787       tfBGR8ub3, tfRGB8ub3:
4788         ColorType := PNG_COLOR_TYPE_RGB;
4789       tfBGRA8ub4, tfRGBA8ub4:
4790         ColorType := PNG_COLOR_TYPE_RGBA;
4791       else
4792         raise EglBitmapUnsupportedFormat.Create(Format);
4793     end;
4794
4795     FormatDesc := TFormatDescriptor.Get(Format);
4796     LineSize := FormatDesc.GetSize(Width, 1);
4797
4798     // creating array for scanline
4799     SetLength(png_rows, Height);
4800     try
4801       for Row := 0 to Height - 1 do begin
4802         png_rows[Row] := Data;
4803         Inc(png_rows[Row], Row * LineSize)
4804       end;
4805
4806       // write struct
4807       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4808       if png = nil then
4809         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4810
4811       // create png info
4812       png_info := png_create_info_struct(png);
4813       if png_info = nil then begin
4814         png_destroy_write_struct(@png, nil);
4815         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4816       end;
4817
4818       // set read callback
4819       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4820
4821       // set compression
4822       png_set_compression_level(png, 6);
4823
4824       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4825         png_set_bgr(png);
4826
4827       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4828       png_write_info(png, png_info);
4829       png_write_image(png, @png_rows[0]);
4830       png_write_end(png, png_info);
4831       png_destroy_write_struct(@png, @png_info);
4832     finally
4833       SetLength(png_rows, 0);
4834     end;
4835   finally
4836     quit_libPNG;
4837   end;
4838 end;
4839
4840 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4841 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4842 procedure TglBitmapData.SavePNG(const aStream: TStream);
4843 var
4844   Png: TPNGObject;
4845
4846   pSource, pDest: pByte;
4847   X, Y, PixSize: Integer;
4848   ColorType: Cardinal;
4849   Alpha: Boolean;
4850
4851   pTemp: pByte;
4852   Temp: Byte;
4853 begin
4854   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4855     raise EglBitmapUnsupportedFormat.Create(Format);
4856
4857   case Format of
4858     tfAlpha8ub1, tfLuminance8ub1: begin
4859       ColorType := COLOR_GRAYSCALE;
4860       PixSize   := 1;
4861       Alpha     := false;
4862     end;
4863     tfLuminance8Alpha8us1: begin
4864       ColorType := COLOR_GRAYSCALEALPHA;
4865       PixSize   := 1;
4866       Alpha     := true;
4867     end;
4868     tfBGR8ub3, tfRGB8ub3: begin
4869       ColorType := COLOR_RGB;
4870       PixSize   := 3;
4871       Alpha     := false;
4872     end;
4873     tfBGRA8ub4, tfRGBA8ub4: begin
4874       ColorType := COLOR_RGBALPHA;
4875       PixSize   := 3;
4876       Alpha     := true
4877     end;
4878   else
4879     raise EglBitmapUnsupportedFormat.Create(Format);
4880   end;
4881
4882   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4883   try
4884     // Copy ImageData
4885     pSource := Data;
4886     for Y := 0 to Height -1 do begin
4887       pDest := png.ScanLine[Y];
4888       for X := 0 to Width -1 do begin
4889         Move(pSource^, pDest^, PixSize);
4890         Inc(pDest, PixSize);
4891         Inc(pSource, PixSize);
4892         if Alpha then begin
4893           png.AlphaScanline[Y]^[X] := pSource^;
4894           Inc(pSource);
4895         end;
4896       end;
4897
4898       // convert RGB line to BGR
4899       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4900         pTemp := png.ScanLine[Y];
4901         for X := 0 to Width -1 do begin
4902           Temp := pByteArray(pTemp)^[0];
4903           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4904           pByteArray(pTemp)^[2] := Temp;
4905           Inc(pTemp, 3);
4906         end;
4907       end;
4908     end;
4909
4910     // Save to Stream
4911     Png.CompressionLevel := 6;
4912     Png.SaveToStream(aStream);
4913   finally
4914     FreeAndNil(Png);
4915   end;
4916 end;
4917 {$IFEND}
4918 {$ENDIF}
4919
4920 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4921 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4923 {$IFDEF GLB_LIB_JPEG}
4924 type
4925   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4926   glBitmap_libJPEG_source_mgr = record
4927     pub: jpeg_source_mgr;
4928
4929     SrcStream: TStream;
4930     SrcBuffer: array [1..4096] of byte;
4931   end;
4932
4933   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4934   glBitmap_libJPEG_dest_mgr = record
4935     pub: jpeg_destination_mgr;
4936
4937     DestStream: TStream;
4938     DestBuffer: array [1..4096] of byte;
4939   end;
4940
4941 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4942 begin
4943   //DUMMY
4944 end;
4945
4946
4947 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4948 begin
4949   //DUMMY
4950 end;
4951
4952
4953 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4954 begin
4955   //DUMMY
4956 end;
4957
4958 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4959 begin
4960   //DUMMY
4961 end;
4962
4963
4964 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4965 begin
4966   //DUMMY
4967 end;
4968
4969
4970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4971 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4972 var
4973   src: glBitmap_libJPEG_source_mgr_ptr;
4974   bytes: integer;
4975 begin
4976   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4977
4978   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4979         if (bytes <= 0) then begin
4980                 src^.SrcBuffer[1] := $FF;
4981                 src^.SrcBuffer[2] := JPEG_EOI;
4982                 bytes := 2;
4983         end;
4984
4985         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4986         src^.pub.bytes_in_buffer := bytes;
4987
4988   result := true;
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4993 var
4994   src: glBitmap_libJPEG_source_mgr_ptr;
4995 begin
4996   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4997
4998   if num_bytes > 0 then begin
4999     // wanted byte isn't in buffer so set stream position and read buffer
5000     if num_bytes > src^.pub.bytes_in_buffer then begin
5001       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5002       src^.pub.fill_input_buffer(cinfo);
5003     end else begin
5004       // wanted byte is in buffer so only skip
5005                 inc(src^.pub.next_input_byte, num_bytes);
5006                 dec(src^.pub.bytes_in_buffer, num_bytes);
5007     end;
5008   end;
5009 end;
5010
5011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5012 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5013 var
5014   dest: glBitmap_libJPEG_dest_mgr_ptr;
5015 begin
5016   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5017
5018   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5019     // write complete buffer
5020     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5021
5022     // reset buffer
5023     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5024     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5025   end;
5026
5027   result := true;
5028 end;
5029
5030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5031 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5032 var
5033   Idx: Integer;
5034   dest: glBitmap_libJPEG_dest_mgr_ptr;
5035 begin
5036   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5037
5038   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5039     // check for endblock
5040     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5041       // write endblock
5042       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5043
5044       // leave
5045       break;
5046     end else
5047       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5048   end;
5049 end;
5050 {$ENDIF}
5051
5052 {$IFDEF GLB_SUPPORT_JPEG_READ}
5053 {$IF DEFINED(GLB_LAZ_JPEG)}
5054 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5055 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5056 const
5057   MAGIC_LEN = 2;
5058   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5059 var
5060   intf: TLazIntfImage;
5061   reader: TFPReaderJPEG;
5062   StreamPos: Int64;
5063   magic: String[MAGIC_LEN];
5064 begin
5065   result := true;
5066   StreamPos := aStream.Position;
5067
5068   SetLength(magic, MAGIC_LEN);
5069   aStream.Read(magic[1], MAGIC_LEN);
5070   aStream.Position := StreamPos;
5071   if (magic <> JPEG_MAGIC) then begin
5072     result := false;
5073     exit;
5074   end;
5075
5076   reader := TFPReaderJPEG.Create;
5077   intf := TLazIntfImage.Create(0, 0);
5078   try try
5079     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5080     reader.ImageRead(aStream, intf);
5081     AssignFromLazIntfImage(intf);
5082   except
5083     result := false;
5084     aStream.Position := StreamPos;
5085     exit;
5086   end;
5087   finally
5088     reader.Free;
5089     intf.Free;
5090   end;
5091 end;
5092
5093 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5095 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5096 var
5097   Surface: PSDL_Surface;
5098   RWops: PSDL_RWops;
5099 begin
5100   result := false;
5101
5102   RWops := glBitmapCreateRWops(aStream);
5103   try
5104     if IMG_isJPG(RWops) > 0 then begin
5105       Surface := IMG_LoadJPG_RW(RWops);
5106       try
5107         AssignFromSurface(Surface);
5108         result := true;
5109       finally
5110         SDL_FreeSurface(Surface);
5111       end;
5112     end;
5113   finally
5114     SDL_FreeRW(RWops);
5115   end;
5116 end;
5117
5118 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5120 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5121 var
5122   StreamPos: Int64;
5123   Temp: array[0..1]of Byte;
5124
5125   jpeg: jpeg_decompress_struct;
5126   jpeg_err: jpeg_error_mgr;
5127
5128   IntFormat: TglBitmapFormat;
5129   pImage: pByte;
5130   TempHeight, TempWidth: Integer;
5131
5132   pTemp: pByte;
5133   Row: Integer;
5134
5135   FormatDesc: TFormatDescriptor;
5136 begin
5137   result := false;
5138
5139   if not init_libJPEG then
5140     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5141
5142   try
5143     // reading first two bytes to test file and set cursor back to begin
5144     StreamPos := aStream.Position;
5145     aStream.Read({%H-}Temp[0], 2);
5146     aStream.Position := StreamPos;
5147
5148     // if Bitmap then read file.
5149     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5150       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5151       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5152
5153       // error managment
5154       jpeg.err := jpeg_std_error(@jpeg_err);
5155       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5156       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5157
5158       // decompression struct
5159       jpeg_create_decompress(@jpeg);
5160
5161       // allocation space for streaming methods
5162       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5163
5164       // seeting up custom functions
5165       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5166         pub.init_source       := glBitmap_libJPEG_init_source;
5167         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5168         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5169         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5170         pub.term_source       := glBitmap_libJPEG_term_source;
5171
5172         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5173         pub.next_input_byte := nil;   // until buffer loaded
5174
5175         SrcStream := aStream;
5176       end;
5177
5178       // set global decoding state
5179       jpeg.global_state := DSTATE_START;
5180
5181       // read header of jpeg
5182       jpeg_read_header(@jpeg, false);
5183
5184       // setting output parameter
5185       case jpeg.jpeg_color_space of
5186         JCS_GRAYSCALE:
5187           begin
5188             jpeg.out_color_space := JCS_GRAYSCALE;
5189             IntFormat := tfLuminance8ub1;
5190           end;
5191         else
5192           jpeg.out_color_space := JCS_RGB;
5193           IntFormat := tfRGB8ub3;
5194       end;
5195
5196       // reading image
5197       jpeg_start_decompress(@jpeg);
5198
5199       TempHeight := jpeg.output_height;
5200       TempWidth := jpeg.output_width;
5201
5202       FormatDesc := TFormatDescriptor.Get(IntFormat);
5203
5204       // creating new image
5205       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5206       try
5207         pTemp := pImage;
5208
5209         for Row := 0 to TempHeight -1 do begin
5210           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5211           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5212         end;
5213
5214         // finish decompression
5215         jpeg_finish_decompress(@jpeg);
5216
5217         // destroy decompression
5218         jpeg_destroy_decompress(@jpeg);
5219
5220         SetData(pImage, IntFormat, TempWidth, TempHeight);
5221
5222         result := true;
5223       except
5224         if Assigned(pImage) then
5225           FreeMem(pImage);
5226         raise;
5227       end;
5228     end;
5229   finally
5230     quit_libJPEG;
5231   end;
5232 end;
5233
5234 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5237 var
5238   bmp: TBitmap;
5239   jpg: TJPEGImage;
5240   StreamPos: Int64;
5241   Temp: array[0..1]of Byte;
5242 begin
5243   result := false;
5244
5245   // reading first two bytes to test file and set cursor back to begin
5246   StreamPos := aStream.Position;
5247   aStream.Read(Temp[0], 2);
5248   aStream.Position := StreamPos;
5249
5250   // if Bitmap then read file.
5251   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5252     bmp := TBitmap.Create;
5253     try
5254       jpg := TJPEGImage.Create;
5255       try
5256         jpg.LoadFromStream(aStream);
5257         bmp.Assign(jpg);
5258         result := AssignFromBitmap(bmp);
5259       finally
5260         jpg.Free;
5261       end;
5262     finally
5263       bmp.Free;
5264     end;
5265   end;
5266 end;
5267 {$IFEND}
5268 {$ENDIF}
5269
5270 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5271 {$IF DEFINED(GLB_LAZ_JPEG)}
5272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5273 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5274 var
5275   jpeg: TJPEGImage;
5276   intf: TLazIntfImage;
5277   raw: TRawImage;
5278 begin
5279   jpeg := TJPEGImage.Create;
5280   intf := TLazIntfImage.Create(0, 0);
5281   try
5282     if not AssignToLazIntfImage(intf) then
5283       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5284     intf.GetRawImage(raw);
5285     jpeg.LoadFromRawImage(raw, false);
5286     jpeg.SaveToStream(aStream);
5287   finally
5288     intf.Free;
5289     jpeg.Free;
5290   end;
5291 end;
5292
5293 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5295 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5296 var
5297   jpeg: jpeg_compress_struct;
5298   jpeg_err: jpeg_error_mgr;
5299   Row: Integer;
5300   pTemp, pTemp2: pByte;
5301
5302   procedure CopyRow(pDest, pSource: pByte);
5303   var
5304     X: Integer;
5305   begin
5306     for X := 0 to Width - 1 do begin
5307       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5308       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5309       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5310       Inc(pDest, 3);
5311       Inc(pSource, 3);
5312     end;
5313   end;
5314
5315 begin
5316   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5317     raise EglBitmapUnsupportedFormat.Create(Format);
5318
5319   if not init_libJPEG then
5320     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5321
5322   try
5323     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5324     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5325
5326     // error managment
5327     jpeg.err := jpeg_std_error(@jpeg_err);
5328     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5329     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5330
5331     // compression struct
5332     jpeg_create_compress(@jpeg);
5333
5334     // allocation space for streaming methods
5335     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5336
5337     // seeting up custom functions
5338     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5339       pub.init_destination    := glBitmap_libJPEG_init_destination;
5340       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5341       pub.term_destination    := glBitmap_libJPEG_term_destination;
5342
5343       pub.next_output_byte  := @DestBuffer[1];
5344       pub.free_in_buffer    := Length(DestBuffer);
5345
5346       DestStream := aStream;
5347     end;
5348
5349     // very important state
5350     jpeg.global_state := CSTATE_START;
5351     jpeg.image_width  := Width;
5352     jpeg.image_height := Height;
5353     case Format of
5354       tfAlpha8ub1, tfLuminance8ub1: begin
5355         jpeg.input_components := 1;
5356         jpeg.in_color_space   := JCS_GRAYSCALE;
5357       end;
5358       tfRGB8ub3, tfBGR8ub3: begin
5359         jpeg.input_components := 3;
5360         jpeg.in_color_space   := JCS_RGB;
5361       end;
5362     end;
5363
5364     jpeg_set_defaults(@jpeg);
5365     jpeg_set_quality(@jpeg, 95, true);
5366     jpeg_start_compress(@jpeg, true);
5367     pTemp := Data;
5368
5369     if Format = tfBGR8ub3 then
5370       GetMem(pTemp2, fRowSize)
5371     else
5372       pTemp2 := pTemp;
5373
5374     try
5375       for Row := 0 to jpeg.image_height -1 do begin
5376         // prepare row
5377         if Format = tfBGR8ub3 then
5378           CopyRow(pTemp2, pTemp)
5379         else
5380           pTemp2 := pTemp;
5381
5382         // write row
5383         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5384         inc(pTemp, fRowSize);
5385       end;
5386     finally
5387       // free memory
5388       if Format = tfBGR8ub3 then
5389         FreeMem(pTemp2);
5390     end;
5391     jpeg_finish_compress(@jpeg);
5392     jpeg_destroy_compress(@jpeg);
5393   finally
5394     quit_libJPEG;
5395   end;
5396 end;
5397
5398 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5400 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5401 var
5402   Bmp: TBitmap;
5403   Jpg: TJPEGImage;
5404 begin
5405   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5406     raise EglBitmapUnsupportedFormat.Create(Format);
5407
5408   Bmp := TBitmap.Create;
5409   try
5410     Jpg := TJPEGImage.Create;
5411     try
5412       AssignToBitmap(Bmp);
5413       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5414         Jpg.Grayscale   := true;
5415         Jpg.PixelFormat := jf8Bit;
5416       end;
5417       Jpg.Assign(Bmp);
5418       Jpg.SaveToStream(aStream);
5419     finally
5420       FreeAndNil(Jpg);
5421     end;
5422   finally
5423     FreeAndNil(Bmp);
5424   end;
5425 end;
5426 {$IFEND}
5427 {$ENDIF}
5428
5429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5430 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5432 type
5433   RawHeader = packed record
5434     Magic:        String[5];
5435     Version:      Byte;
5436     Width:        Integer;
5437     Height:       Integer;
5438     DataSize:     Integer;
5439     BitsPerPixel: Integer;
5440     Precision:    TglBitmapRec4ub;
5441     Shift:        TglBitmapRec4ub;
5442   end;
5443
5444 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5445 var
5446   header: RawHeader;
5447   StartPos: Int64;
5448   fd: TFormatDescriptor;
5449   buf: PByte;
5450 begin
5451   result := false;
5452   StartPos := aStream.Position;
5453   aStream.Read(header{%H-}, SizeOf(header));
5454   if (header.Magic <> 'glBMP') then begin
5455     aStream.Position := StartPos;
5456     exit;
5457   end;
5458
5459   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5460   if (fd.Format = tfEmpty) then
5461     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5462
5463   buf := GetMemory(header.DataSize);
5464   aStream.Read(buf^, header.DataSize);
5465   SetData(buf, fd.Format, header.Width, header.Height);
5466
5467   result := true;
5468 end;
5469
5470 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5471 var
5472   header: RawHeader;
5473   fd: TFormatDescriptor;
5474 begin
5475   fd := TFormatDescriptor.Get(Format);
5476   header.Magic        := 'glBMP';
5477   header.Version      := 1;
5478   header.Width        := Width;
5479   header.Height       := Height;
5480   header.DataSize     := fd.GetSize(fDimension);
5481   header.BitsPerPixel := fd.BitsPerPixel;
5482   header.Precision    := fd.Precision;
5483   header.Shift        := fd.Shift;
5484   aStream.Write(header, SizeOf(header));
5485   aStream.Write(Data^,  header.DataSize);
5486 end;
5487
5488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5489 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5491 const
5492   BMP_MAGIC          = $4D42;
5493
5494   BMP_COMP_RGB       = 0;
5495   BMP_COMP_RLE8      = 1;
5496   BMP_COMP_RLE4      = 2;
5497   BMP_COMP_BITFIELDS = 3;
5498
5499 type
5500   TBMPHeader = packed record
5501     bfType: Word;
5502     bfSize: Cardinal;
5503     bfReserved1: Word;
5504     bfReserved2: Word;
5505     bfOffBits: Cardinal;
5506   end;
5507
5508   TBMPInfo = packed record
5509     biSize: Cardinal;
5510     biWidth: Longint;
5511     biHeight: Longint;
5512     biPlanes: Word;
5513     biBitCount: Word;
5514     biCompression: Cardinal;
5515     biSizeImage: Cardinal;
5516     biXPelsPerMeter: Longint;
5517     biYPelsPerMeter: Longint;
5518     biClrUsed: Cardinal;
5519     biClrImportant: Cardinal;
5520   end;
5521
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5524
5525   //////////////////////////////////////////////////////////////////////////////////////////////////
5526   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5527   var
5528     tmp, i: Cardinal;
5529   begin
5530     result := tfEmpty;
5531     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5532     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5533
5534     //Read Compression
5535     case aInfo.biCompression of
5536       BMP_COMP_RLE4,
5537       BMP_COMP_RLE8: begin
5538         raise EglBitmap.Create('RLE compression is not supported');
5539       end;
5540       BMP_COMP_BITFIELDS: begin
5541         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5542           for i := 0 to 2 do begin
5543             aStream.Read(tmp{%H-}, SizeOf(tmp));
5544             aMask.arr[i] := tmp;
5545           end;
5546         end else
5547           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5548       end;
5549     end;
5550
5551     //get suitable format
5552     case aInfo.biBitCount of
5553        8: result := tfLuminance8ub1;
5554       16: result := tfX1RGB5us1;
5555       24: result := tfBGR8ub3;
5556       32: result := tfXRGB8ui1;
5557     end;
5558   end;
5559
5560   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5561   var
5562     i, c: Integer;
5563     fd: TFormatDescriptor;
5564     ColorTable: TbmpColorTable;
5565   begin
5566     result := nil;
5567     if (aInfo.biBitCount >= 16) then
5568       exit;
5569     aFormat := tfLuminance8ub1;
5570     c := aInfo.biClrUsed;
5571     if (c = 0) then
5572       c := 1 shl aInfo.biBitCount;
5573     SetLength(ColorTable, c);
5574     for i := 0 to c-1 do begin
5575       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5576       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5577         aFormat := tfRGB8ub3;
5578     end;
5579
5580     fd := TFormatDescriptor.Get(aFormat);
5581     result := TbmpColorTableFormat.Create;
5582     result.ColorTable   := ColorTable;
5583     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5584   end;
5585
5586   //////////////////////////////////////////////////////////////////////////////////////////////////
5587   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5588   var
5589     fd: TFormatDescriptor;
5590   begin
5591     result := nil;
5592     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5593
5594       // find suitable format ...
5595       fd := TFormatDescriptor.GetFromMask(aMask);
5596       if (fd.Format <> tfEmpty) then begin
5597         aFormat := fd.Format;
5598         exit;
5599       end;
5600
5601       // or create custom bitfield format
5602       result := TbmpBitfieldFormat.Create;
5603       result.SetCustomValues(aInfo.biBitCount, aMask);
5604     end;
5605   end;
5606
5607 var
5608   //simple types
5609   StartPos: Int64;
5610   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5611   PaddingBuff: Cardinal;
5612   LineBuf, ImageData, TmpData: PByte;
5613   SourceMD, DestMD: Pointer;
5614   BmpFormat: TglBitmapFormat;
5615
5616   //records
5617   Mask: TglBitmapRec4ul;
5618   Header: TBMPHeader;
5619   Info: TBMPInfo;
5620
5621   //classes
5622   SpecialFormat: TFormatDescriptor;
5623   FormatDesc: TFormatDescriptor;
5624
5625   //////////////////////////////////////////////////////////////////////////////////////////////////
5626   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5627   var
5628     i: Integer;
5629     Pixel: TglBitmapPixelData;
5630   begin
5631     aStream.Read(aLineBuf^, rbLineSize);
5632     SpecialFormat.PreparePixel(Pixel);
5633     for i := 0 to Info.biWidth-1 do begin
5634       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5635       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5636       FormatDesc.Map(Pixel, aData, DestMD);
5637     end;
5638   end;
5639
5640 begin
5641   result        := false;
5642   BmpFormat     := tfEmpty;
5643   SpecialFormat := nil;
5644   LineBuf       := nil;
5645   SourceMD      := nil;
5646   DestMD        := nil;
5647
5648   // Header
5649   StartPos := aStream.Position;
5650   aStream.Read(Header{%H-}, SizeOf(Header));
5651
5652   if Header.bfType = BMP_MAGIC then begin
5653     try try
5654       BmpFormat        := ReadInfo(Info, Mask);
5655       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5656       if not Assigned(SpecialFormat) then
5657         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5658       aStream.Position := StartPos + Header.bfOffBits;
5659
5660       if (BmpFormat <> tfEmpty) then begin
5661         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5662         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5663         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5664         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5665
5666         //get Memory
5667         DestMD    := FormatDesc.CreateMappingData;
5668         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5669         GetMem(ImageData, ImageSize);
5670         if Assigned(SpecialFormat) then begin
5671           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5672           SourceMD := SpecialFormat.CreateMappingData;
5673         end;
5674
5675         //read Data
5676         try try
5677           FillChar(ImageData^, ImageSize, $FF);
5678           TmpData := ImageData;
5679           if (Info.biHeight > 0) then
5680             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5681           for i := 0 to Abs(Info.biHeight)-1 do begin
5682             if Assigned(SpecialFormat) then
5683               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5684             else
5685               aStream.Read(TmpData^, wbLineSize);   //else only read data
5686             if (Info.biHeight > 0) then
5687               dec(TmpData, wbLineSize)
5688             else
5689               inc(TmpData, wbLineSize);
5690             aStream.Read(PaddingBuff{%H-}, Padding);
5691           end;
5692           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5693           result := true;
5694         finally
5695           if Assigned(LineBuf) then
5696             FreeMem(LineBuf);
5697           if Assigned(SourceMD) then
5698             SpecialFormat.FreeMappingData(SourceMD);
5699           FormatDesc.FreeMappingData(DestMD);
5700         end;
5701         except
5702           if Assigned(ImageData) then
5703             FreeMem(ImageData);
5704           raise;
5705         end;
5706       end else
5707         raise EglBitmap.Create('LoadBMP - No suitable format found');
5708     except
5709       aStream.Position := StartPos;
5710       raise;
5711     end;
5712     finally
5713       FreeAndNil(SpecialFormat);
5714     end;
5715   end
5716     else aStream.Position := StartPos;
5717 end;
5718
5719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5720 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5721 var
5722   Header: TBMPHeader;
5723   Info: TBMPInfo;
5724   Converter: TFormatDescriptor;
5725   FormatDesc: TFormatDescriptor;
5726   SourceFD, DestFD: Pointer;
5727   pData, srcData, dstData, ConvertBuffer: pByte;
5728
5729   Pixel: TglBitmapPixelData;
5730   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5731   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5732
5733   PaddingBuff: Cardinal;
5734
5735   function GetLineWidth : Integer;
5736   begin
5737     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5738   end;
5739
5740 begin
5741   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5742     raise EglBitmapUnsupportedFormat.Create(Format);
5743
5744   Converter  := nil;
5745   FormatDesc := TFormatDescriptor.Get(Format);
5746   ImageSize  := FormatDesc.GetSize(Dimension);
5747
5748   FillChar(Header{%H-}, SizeOf(Header), 0);
5749   Header.bfType      := BMP_MAGIC;
5750   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5751   Header.bfReserved1 := 0;
5752   Header.bfReserved2 := 0;
5753   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5754
5755   FillChar(Info{%H-}, SizeOf(Info), 0);
5756   Info.biSize        := SizeOf(Info);
5757   Info.biWidth       := Width;
5758   Info.biHeight      := Height;
5759   Info.biPlanes      := 1;
5760   Info.biCompression := BMP_COMP_RGB;
5761   Info.biSizeImage   := ImageSize;
5762
5763   try
5764     case Format of
5765       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5766       begin
5767         Info.biBitCount  :=  8;
5768         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5769         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5770         Converter := TbmpColorTableFormat.Create;
5771         with (Converter as TbmpColorTableFormat) do begin
5772           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5773           CreateColorTable;
5774         end;
5775       end;
5776
5777       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5778       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5779       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5780       begin
5781         Info.biBitCount    := 16;
5782         Info.biCompression := BMP_COMP_BITFIELDS;
5783       end;
5784
5785       tfBGR8ub3, tfRGB8ub3:
5786       begin
5787         Info.biBitCount := 24;
5788         if (Format = tfRGB8ub3) then
5789           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5790       end;
5791
5792       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5793       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5794       begin
5795         Info.biBitCount    := 32;
5796         Info.biCompression := BMP_COMP_BITFIELDS;
5797       end;
5798     else
5799       raise EglBitmapUnsupportedFormat.Create(Format);
5800     end;
5801     Info.biXPelsPerMeter := 2835;
5802     Info.biYPelsPerMeter := 2835;
5803
5804     // prepare bitmasks
5805     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5806       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5807       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5808
5809       RedMask    := FormatDesc.Mask.r;
5810       GreenMask  := FormatDesc.Mask.g;
5811       BlueMask   := FormatDesc.Mask.b;
5812       AlphaMask  := FormatDesc.Mask.a;
5813     end;
5814
5815     // headers
5816     aStream.Write(Header, SizeOf(Header));
5817     aStream.Write(Info, SizeOf(Info));
5818
5819     // colortable
5820     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5821       with (Converter as TbmpColorTableFormat) do
5822         aStream.Write(ColorTable[0].b,
5823           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5824
5825     // bitmasks
5826     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5827       aStream.Write(RedMask,   SizeOf(Cardinal));
5828       aStream.Write(GreenMask, SizeOf(Cardinal));
5829       aStream.Write(BlueMask,  SizeOf(Cardinal));
5830       aStream.Write(AlphaMask, SizeOf(Cardinal));
5831     end;
5832
5833     // image data
5834     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5835     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5836     Padding     := GetLineWidth - wbLineSize;
5837     PaddingBuff := 0;
5838
5839     pData := Data;
5840     inc(pData, (Height-1) * rbLineSize);
5841
5842     // prepare row buffer. But only for RGB because RGBA supports color masks
5843     // so it's possible to change color within the image.
5844     if Assigned(Converter) then begin
5845       FormatDesc.PreparePixel(Pixel);
5846       GetMem(ConvertBuffer, wbLineSize);
5847       SourceFD := FormatDesc.CreateMappingData;
5848       DestFD   := Converter.CreateMappingData;
5849     end else
5850       ConvertBuffer := nil;
5851
5852     try
5853       for LineIdx := 0 to Height - 1 do begin
5854         // preparing row
5855         if Assigned(Converter) then begin
5856           srcData := pData;
5857           dstData := ConvertBuffer;
5858           for PixelIdx := 0 to Info.biWidth-1 do begin
5859             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5860             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5861             Converter.Map(Pixel, dstData, DestFD);
5862           end;
5863           aStream.Write(ConvertBuffer^, wbLineSize);
5864         end else begin
5865           aStream.Write(pData^, rbLineSize);
5866         end;
5867         dec(pData, rbLineSize);
5868         if (Padding > 0) then
5869           aStream.Write(PaddingBuff, Padding);
5870       end;
5871     finally
5872       // destroy row buffer
5873       if Assigned(ConvertBuffer) then begin
5874         FormatDesc.FreeMappingData(SourceFD);
5875         Converter.FreeMappingData(DestFD);
5876         FreeMem(ConvertBuffer);
5877       end;
5878     end;
5879   finally
5880     if Assigned(Converter) then
5881       Converter.Free;
5882   end;
5883 end;
5884
5885 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5886 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5888 type
5889   TTGAHeader = packed record
5890     ImageID: Byte;
5891     ColorMapType: Byte;
5892     ImageType: Byte;
5893     //ColorMapSpec: Array[0..4] of Byte;
5894     ColorMapStart: Word;
5895     ColorMapLength: Word;
5896     ColorMapEntrySize: Byte;
5897     OrigX: Word;
5898     OrigY: Word;
5899     Width: Word;
5900     Height: Word;
5901     Bpp: Byte;
5902     ImageDesc: Byte;
5903   end;
5904
5905 const
5906   TGA_UNCOMPRESSED_RGB  =  2;
5907   TGA_UNCOMPRESSED_GRAY =  3;
5908   TGA_COMPRESSED_RGB    = 10;
5909   TGA_COMPRESSED_GRAY   = 11;
5910
5911   TGA_NONE_COLOR_TABLE  = 0;
5912
5913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5914 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5915 var
5916   Header: TTGAHeader;
5917   ImageData: System.PByte;
5918   StartPosition: Int64;
5919   PixelSize, LineSize: Integer;
5920   tgaFormat: TglBitmapFormat;
5921   FormatDesc: TFormatDescriptor;
5922   Counter: packed record
5923     X, Y: packed record
5924       low, high, dir: Integer;
5925     end;
5926   end;
5927
5928 const
5929   CACHE_SIZE = $4000;
5930
5931   ////////////////////////////////////////////////////////////////////////////////////////
5932   procedure ReadUncompressed;
5933   var
5934     i, j: Integer;
5935     buf, tmp1, tmp2: System.PByte;
5936   begin
5937     buf := nil;
5938     if (Counter.X.dir < 0) then
5939       GetMem(buf, LineSize);
5940     try
5941       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5942         tmp1 := ImageData;
5943         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5944         if (Counter.X.dir < 0) then begin               //flip X
5945           aStream.Read(buf^, LineSize);
5946           tmp2 := buf;
5947           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5948           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5949             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5950               tmp1^ := tmp2^;
5951               inc(tmp1);
5952               inc(tmp2);
5953             end;
5954             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5955           end;
5956         end else
5957           aStream.Read(tmp1^, LineSize);
5958         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5959       end;
5960     finally
5961       if Assigned(buf) then
5962         FreeMem(buf);
5963     end;
5964   end;
5965
5966   ////////////////////////////////////////////////////////////////////////////////////////
5967   procedure ReadCompressed;
5968
5969     /////////////////////////////////////////////////////////////////
5970     var
5971       TmpData: System.PByte;
5972       LinePixelsRead: Integer;
5973     procedure CheckLine;
5974     begin
5975       if (LinePixelsRead >= Header.Width) then begin
5976         LinePixelsRead := 0;
5977         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5978         TmpData := ImageData;
5979         inc(TmpData, Counter.Y.low * LineSize);           //set line
5980         if (Counter.X.dir < 0) then                       //if x flipped then
5981           inc(TmpData, LineSize - PixelSize);             //set last pixel
5982       end;
5983     end;
5984
5985     /////////////////////////////////////////////////////////////////
5986     var
5987       Cache: PByte;
5988       CacheSize, CachePos: Integer;
5989     procedure CachedRead(out Buffer; Count: Integer);
5990     var
5991       BytesRead: Integer;
5992     begin
5993       if (CachePos + Count > CacheSize) then begin
5994         //if buffer overflow save non read bytes
5995         BytesRead := 0;
5996         if (CacheSize - CachePos > 0) then begin
5997           BytesRead := CacheSize - CachePos;
5998           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
5999           inc(CachePos, BytesRead);
6000         end;
6001
6002         //load cache from file
6003         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6004         aStream.Read(Cache^, CacheSize);
6005         CachePos := 0;
6006
6007         //read rest of requested bytes
6008         if (Count - BytesRead > 0) then begin
6009           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6010           inc(CachePos, Count - BytesRead);
6011         end;
6012       end else begin
6013         //if no buffer overflow just read the data
6014         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6015         inc(CachePos, Count);
6016       end;
6017     end;
6018
6019     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6020     begin
6021       case PixelSize of
6022         1: begin
6023           aBuffer^ := aData^;
6024           inc(aBuffer, Counter.X.dir);
6025         end;
6026         2: begin
6027           PWord(aBuffer)^ := PWord(aData)^;
6028           inc(aBuffer, 2 * Counter.X.dir);
6029         end;
6030         3: begin
6031           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6032           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6033           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6034           inc(aBuffer, 3 * Counter.X.dir);
6035         end;
6036         4: begin
6037           PCardinal(aBuffer)^ := PCardinal(aData)^;
6038           inc(aBuffer, 4 * Counter.X.dir);
6039         end;
6040       end;
6041     end;
6042
6043   var
6044     TotalPixelsToRead, TotalPixelsRead: Integer;
6045     Temp: Byte;
6046     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6047     PixelRepeat: Boolean;
6048     PixelsToRead, PixelCount: Integer;
6049   begin
6050     CacheSize := 0;
6051     CachePos  := 0;
6052
6053     TotalPixelsToRead := Header.Width * Header.Height;
6054     TotalPixelsRead   := 0;
6055     LinePixelsRead    := 0;
6056
6057     GetMem(Cache, CACHE_SIZE);
6058     try
6059       TmpData := ImageData;
6060       inc(TmpData, Counter.Y.low * LineSize);           //set line
6061       if (Counter.X.dir < 0) then                       //if x flipped then
6062         inc(TmpData, LineSize - PixelSize);             //set last pixel
6063
6064       repeat
6065         //read CommandByte
6066         CachedRead(Temp, 1);
6067         PixelRepeat  := (Temp and $80) > 0;
6068         PixelsToRead := (Temp and $7F) + 1;
6069         inc(TotalPixelsRead, PixelsToRead);
6070
6071         if PixelRepeat then
6072           CachedRead(buf[0], PixelSize);
6073         while (PixelsToRead > 0) do begin
6074           CheckLine;
6075           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6076           while (PixelCount > 0) do begin
6077             if not PixelRepeat then
6078               CachedRead(buf[0], PixelSize);
6079             PixelToBuffer(@buf[0], TmpData);
6080             inc(LinePixelsRead);
6081             dec(PixelsToRead);
6082             dec(PixelCount);
6083           end;
6084         end;
6085       until (TotalPixelsRead >= TotalPixelsToRead);
6086     finally
6087       FreeMem(Cache);
6088     end;
6089   end;
6090
6091   function IsGrayFormat: Boolean;
6092   begin
6093     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6094   end;
6095
6096 begin
6097   result := false;
6098
6099   // reading header to test file and set cursor back to begin
6100   StartPosition := aStream.Position;
6101   aStream.Read(Header{%H-}, SizeOf(Header));
6102
6103   // no colormapped files
6104   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6105     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6106   begin
6107     try
6108       if Header.ImageID <> 0 then       // skip image ID
6109         aStream.Position := aStream.Position + Header.ImageID;
6110
6111       tgaFormat := tfEmpty;
6112       case Header.Bpp of
6113          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6114                0: tgaFormat := tfLuminance8ub1;
6115                8: tgaFormat := tfAlpha8ub1;
6116             end;
6117
6118         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6119                0: tgaFormat := tfLuminance16us1;
6120                8: tgaFormat := tfLuminance8Alpha8ub2;
6121             end else case (Header.ImageDesc and $F) of
6122                0: tgaFormat := tfX1RGB5us1;
6123                1: tgaFormat := tfA1RGB5us1;
6124                4: tgaFormat := tfARGB4us1;
6125             end;
6126
6127         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6128                0: tgaFormat := tfBGR8ub3;
6129             end;
6130
6131         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6132                0: tgaFormat := tfDepth32ui1;
6133             end else case (Header.ImageDesc and $F) of
6134                0: tgaFormat := tfX2RGB10ui1;
6135                2: tgaFormat := tfA2RGB10ui1;
6136                8: tgaFormat := tfARGB8ui1;
6137             end;
6138       end;
6139
6140       if (tgaFormat = tfEmpty) then
6141         raise EglBitmap.Create('LoadTga - unsupported format');
6142
6143       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6144       PixelSize  := FormatDesc.GetSize(1, 1);
6145       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6146
6147       GetMem(ImageData, LineSize * Header.Height);
6148       try
6149         //column direction
6150         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6151           Counter.X.low  := Header.Height-1;;
6152           Counter.X.high := 0;
6153           Counter.X.dir  := -1;
6154         end else begin
6155           Counter.X.low  := 0;
6156           Counter.X.high := Header.Height-1;
6157           Counter.X.dir  := 1;
6158         end;
6159
6160         // Row direction
6161         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6162           Counter.Y.low  := 0;
6163           Counter.Y.high := Header.Height-1;
6164           Counter.Y.dir  := 1;
6165         end else begin
6166           Counter.Y.low  := Header.Height-1;;
6167           Counter.Y.high := 0;
6168           Counter.Y.dir  := -1;
6169         end;
6170
6171         // Read Image
6172         case Header.ImageType of
6173           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6174             ReadUncompressed;
6175           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6176             ReadCompressed;
6177         end;
6178
6179         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6180         result := true;
6181       except
6182         if Assigned(ImageData) then
6183           FreeMem(ImageData);
6184         raise;
6185       end;
6186     finally
6187       aStream.Position := StartPosition;
6188     end;
6189   end
6190     else aStream.Position := StartPosition;
6191 end;
6192
6193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6194 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6195 var
6196   Header: TTGAHeader;
6197   Size: Integer;
6198   FormatDesc: TFormatDescriptor;
6199 begin
6200   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6201     raise EglBitmapUnsupportedFormat.Create(Format);
6202
6203   //prepare header
6204   FormatDesc := TFormatDescriptor.Get(Format);
6205   FillChar(Header{%H-}, SizeOf(Header), 0);
6206   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6207   Header.Bpp       := FormatDesc.BitsPerPixel;
6208   Header.Width     := Width;
6209   Header.Height    := Height;
6210   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6211   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6212     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6213   else
6214     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6215   aStream.Write(Header, SizeOf(Header));
6216
6217   // write Data
6218   Size := FormatDesc.GetSize(Dimension);
6219   aStream.Write(Data^, Size);
6220 end;
6221
6222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6223 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6225 const
6226   DDS_MAGIC: Cardinal         = $20534444;
6227
6228   // DDS_header.dwFlags
6229   DDSD_CAPS                   = $00000001;
6230   DDSD_HEIGHT                 = $00000002;
6231   DDSD_WIDTH                  = $00000004;
6232   DDSD_PIXELFORMAT            = $00001000;
6233
6234   // DDS_header.sPixelFormat.dwFlags
6235   DDPF_ALPHAPIXELS            = $00000001;
6236   DDPF_ALPHA                  = $00000002;
6237   DDPF_FOURCC                 = $00000004;
6238   DDPF_RGB                    = $00000040;
6239   DDPF_LUMINANCE              = $00020000;
6240
6241   // DDS_header.sCaps.dwCaps1
6242   DDSCAPS_TEXTURE             = $00001000;
6243
6244   // DDS_header.sCaps.dwCaps2
6245   DDSCAPS2_CUBEMAP            = $00000200;
6246
6247   D3DFMT_DXT1                 = $31545844;
6248   D3DFMT_DXT3                 = $33545844;
6249   D3DFMT_DXT5                 = $35545844;
6250
6251 type
6252   TDDSPixelFormat = packed record
6253     dwSize: Cardinal;
6254     dwFlags: Cardinal;
6255     dwFourCC: Cardinal;
6256     dwRGBBitCount: Cardinal;
6257     dwRBitMask: Cardinal;
6258     dwGBitMask: Cardinal;
6259     dwBBitMask: Cardinal;
6260     dwABitMask: Cardinal;
6261   end;
6262
6263   TDDSCaps = packed record
6264     dwCaps1: Cardinal;
6265     dwCaps2: Cardinal;
6266     dwDDSX: Cardinal;
6267     dwReserved: Cardinal;
6268   end;
6269
6270   TDDSHeader = packed record
6271     dwSize: Cardinal;
6272     dwFlags: Cardinal;
6273     dwHeight: Cardinal;
6274     dwWidth: Cardinal;
6275     dwPitchOrLinearSize: Cardinal;
6276     dwDepth: Cardinal;
6277     dwMipMapCount: Cardinal;
6278     dwReserved: array[0..10] of Cardinal;
6279     PixelFormat: TDDSPixelFormat;
6280     Caps: TDDSCaps;
6281     dwReserved2: Cardinal;
6282   end;
6283
6284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6285 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6286 var
6287   Header: TDDSHeader;
6288   Converter: TbmpBitfieldFormat;
6289
6290   function GetDDSFormat: TglBitmapFormat;
6291   var
6292     fd: TFormatDescriptor;
6293     i: Integer;
6294     Mask: TglBitmapRec4ul;
6295     Range: TglBitmapRec4ui;
6296     match: Boolean;
6297   begin
6298     result := tfEmpty;
6299     with Header.PixelFormat do begin
6300       // Compresses
6301       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6302         case Header.PixelFormat.dwFourCC of
6303           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6304           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6305           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6306         end;
6307       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6308         // prepare masks
6309         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6310           Mask.r := dwRBitMask;
6311           Mask.g := dwGBitMask;
6312           Mask.b := dwBBitMask;
6313         end else begin
6314           Mask.r := dwRBitMask;
6315           Mask.g := dwRBitMask;
6316           Mask.b := dwRBitMask;
6317         end;
6318         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6319           Mask.a := dwABitMask
6320         else
6321           Mask.a := 0;;
6322
6323         //find matching format
6324         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6325         result := fd.Format;
6326         if (result <> tfEmpty) then
6327           exit;
6328
6329         //find format with same Range
6330         for i := 0 to 3 do
6331           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6332         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6333           fd := TFormatDescriptor.Get(result);
6334           match := true;
6335           for i := 0 to 3 do
6336             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6337               match := false;
6338               break;
6339             end;
6340           if match then
6341             break;
6342         end;
6343
6344         //no format with same range found -> use default
6345         if (result = tfEmpty) then begin
6346           if (dwABitMask > 0) then
6347             result := tfRGBA8ui1
6348           else
6349             result := tfRGB8ub3;
6350         end;
6351
6352         Converter := TbmpBitfieldFormat.Create;
6353         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6354       end;
6355     end;
6356   end;
6357
6358 var
6359   StreamPos: Int64;
6360   x, y, LineSize, RowSize, Magic: Cardinal;
6361   NewImage, TmpData, RowData, SrcData: System.PByte;
6362   SourceMD, DestMD: Pointer;
6363   Pixel: TglBitmapPixelData;
6364   ddsFormat: TglBitmapFormat;
6365   FormatDesc: TFormatDescriptor;
6366
6367 begin
6368   result    := false;
6369   Converter := nil;
6370   StreamPos := aStream.Position;
6371
6372   // Magic
6373   aStream.Read(Magic{%H-}, sizeof(Magic));
6374   if (Magic <> DDS_MAGIC) then begin
6375     aStream.Position := StreamPos;
6376     exit;
6377   end;
6378
6379   //Header
6380   aStream.Read(Header{%H-}, sizeof(Header));
6381   if (Header.dwSize <> SizeOf(Header)) or
6382      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6383         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6384   begin
6385     aStream.Position := StreamPos;
6386     exit;
6387   end;
6388
6389   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6390     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6391
6392   ddsFormat := GetDDSFormat;
6393   try
6394     if (ddsFormat = tfEmpty) then
6395       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6396
6397     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6398     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6399     GetMem(NewImage, Header.dwHeight * LineSize);
6400     try
6401       TmpData := NewImage;
6402
6403       //Converter needed
6404       if Assigned(Converter) then begin
6405         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6406         GetMem(RowData, RowSize);
6407         SourceMD := Converter.CreateMappingData;
6408         DestMD   := FormatDesc.CreateMappingData;
6409         try
6410           for y := 0 to Header.dwHeight-1 do begin
6411             TmpData := NewImage;
6412             inc(TmpData, y * LineSize);
6413             SrcData := RowData;
6414             aStream.Read(SrcData^, RowSize);
6415             for x := 0 to Header.dwWidth-1 do begin
6416               Converter.Unmap(SrcData, Pixel, SourceMD);
6417               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6418               FormatDesc.Map(Pixel, TmpData, DestMD);
6419             end;
6420           end;
6421         finally
6422           Converter.FreeMappingData(SourceMD);
6423           FormatDesc.FreeMappingData(DestMD);
6424           FreeMem(RowData);
6425         end;
6426       end else
6427
6428       // Compressed
6429       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6430         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6431         for Y := 0 to Header.dwHeight-1 do begin
6432           aStream.Read(TmpData^, RowSize);
6433           Inc(TmpData, LineSize);
6434         end;
6435       end else
6436
6437       // Uncompressed
6438       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6439         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6440         for Y := 0 to Header.dwHeight-1 do begin
6441           aStream.Read(TmpData^, RowSize);
6442           Inc(TmpData, LineSize);
6443         end;
6444       end else
6445         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6446
6447       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6448       result := true;
6449     except
6450       if Assigned(NewImage) then
6451         FreeMem(NewImage);
6452       raise;
6453     end;
6454   finally
6455     FreeAndNil(Converter);
6456   end;
6457 end;
6458
6459 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6460 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6461 var
6462   Header: TDDSHeader;
6463   FormatDesc: TFormatDescriptor;
6464 begin
6465   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6466     raise EglBitmapUnsupportedFormat.Create(Format);
6467
6468   FormatDesc := TFormatDescriptor.Get(Format);
6469
6470   // Generell
6471   FillChar(Header{%H-}, SizeOf(Header), 0);
6472   Header.dwSize  := SizeOf(Header);
6473   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6474
6475   Header.dwWidth  := Max(1, Width);
6476   Header.dwHeight := Max(1, Height);
6477
6478   // Caps
6479   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6480
6481   // Pixelformat
6482   Header.PixelFormat.dwSize := sizeof(Header);
6483   if (FormatDesc.IsCompressed) then begin
6484     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6485     case Format of
6486       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6487       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6488       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6489     end;
6490   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6491     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6492     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6493     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6494   end else if FormatDesc.IsGrayscale then begin
6495     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6496     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6497     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6498     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6499   end else begin
6500     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6501     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6502     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6503     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6504     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6505     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6506   end;
6507
6508   if (FormatDesc.HasAlpha) then
6509     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6510
6511   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6512   aStream.Write(Header, SizeOf(Header));
6513   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6514 end;
6515
6516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6517 function TglBitmapData.FlipHorz: Boolean;
6518 var
6519   fd: TglBitmapFormatDescriptor;
6520   Col, RowSize, PixelSize: Integer;
6521   pTempDest, pDest, pSource: PByte;
6522 begin
6523   result    := false;
6524   fd        := FormatDescriptor;
6525   PixelSize := Ceil(fd.BytesPerPixel);
6526   RowSize   := fd.GetSize(Width, 1);
6527   if Assigned(Data) and not fd.IsCompressed then begin
6528     pSource := Data;
6529     GetMem(pDest, RowSize);
6530     try
6531       pTempDest := pDest;
6532       Inc(pTempDest, RowSize);
6533       for Col := 0 to Width-1 do begin
6534         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6535         Move(pSource^, pTempDest^, PixelSize);
6536         Inc(pSource, PixelSize);
6537       end;
6538       SetData(pDest, Format, Width);
6539       result := true;
6540     except
6541       if Assigned(pDest) then
6542         FreeMem(pDest);
6543       raise;
6544     end;
6545   end;
6546 end;
6547
6548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6549 function TglBitmapData.FlipVert: Boolean;
6550 var
6551   fd: TglBitmapFormatDescriptor;
6552   Row, RowSize, PixelSize: Integer;
6553   TempDestData, DestData, SourceData: PByte;
6554 begin
6555   result    := false;
6556   fd        := FormatDescriptor;
6557   PixelSize := Ceil(fd.BytesPerPixel);
6558   RowSize   := fd.GetSize(Width, 1);
6559   if Assigned(Data) then begin
6560     SourceData := Data;
6561     GetMem(DestData, Height * RowSize);
6562     try
6563       TempDestData := DestData;
6564       Inc(TempDestData, Width * (Height -1) * PixelSize);
6565       for Row := 0 to Height -1 do begin
6566         Move(SourceData^, TempDestData^, RowSize);
6567         Dec(TempDestData, RowSize);
6568         Inc(SourceData, RowSize);
6569       end;
6570       SetData(DestData, Format, Width, Height);
6571       result := true;
6572     except
6573       if Assigned(DestData) then
6574         FreeMem(DestData);
6575       raise;
6576     end;
6577   end;
6578 end;
6579
6580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6581 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6582 var
6583   fs: TFileStream;
6584 begin
6585   if not FileExists(aFilename) then
6586     raise EglBitmap.Create('file does not exist: ' + aFilename);
6587   fs := TFileStream.Create(aFilename, fmOpenRead);
6588   try
6589     fs.Position := 0;
6590     LoadFromStream(fs);
6591     fFilename := aFilename;
6592   finally
6593     fs.Free;
6594   end;
6595 end;
6596
6597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6598 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6599 begin
6600   {$IFDEF GLB_SUPPORT_PNG_READ}
6601   if not LoadPNG(aStream) then
6602   {$ENDIF}
6603   {$IFDEF GLB_SUPPORT_JPEG_READ}
6604   if not LoadJPEG(aStream) then
6605   {$ENDIF}
6606   if not LoadDDS(aStream) then
6607   if not LoadTGA(aStream) then
6608   if not LoadBMP(aStream) then
6609   if not LoadRAW(aStream) then
6610     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6611 end;
6612
6613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6614 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6615   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6616 var
6617   tmpData: PByte;
6618   size: Integer;
6619 begin
6620   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6621   GetMem(tmpData, size);
6622   try
6623     FillChar(tmpData^, size, #$FF);
6624     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6625   except
6626     if Assigned(tmpData) then
6627       FreeMem(tmpData);
6628     raise;
6629   end;
6630   Convert(Self, aFunc, false, aFormat, aArgs);
6631 end;
6632
6633 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6634 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6635 var
6636   rs: TResourceStream;
6637 begin
6638   PrepareResType(aResource, aResType);
6639   rs := TResourceStream.Create(aInstance, aResource, aResType);
6640   try
6641     LoadFromStream(rs);
6642   finally
6643     rs.Free;
6644   end;
6645 end;
6646
6647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6648 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6649 var
6650   rs: TResourceStream;
6651 begin
6652   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6653   try
6654     LoadFromStream(rs);
6655   finally
6656     rs.Free;
6657   end;
6658 end;
6659
6660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6661 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6662 var
6663   fs: TFileStream;
6664 begin
6665   fs := TFileStream.Create(aFileName, fmCreate);
6666   try
6667     fs.Position := 0;
6668     SaveToStream(fs, aFileType);
6669   finally
6670     fs.Free;
6671   end;
6672 end;
6673
6674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6675 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6676 begin
6677   case aFileType of
6678     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6679     ftPNG:  SavePNG(aStream);
6680     {$ENDIF}
6681     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6682     ftJPEG: SaveJPEG(aStream);
6683     {$ENDIF}
6684     ftDDS:  SaveDDS(aStream);
6685     ftTGA:  SaveTGA(aStream);
6686     ftBMP:  SaveBMP(aStream);
6687     ftRAW:  SaveRAW(aStream);
6688   end;
6689 end;
6690
6691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6692 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6693 begin
6694   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6695 end;
6696
6697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6698 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6699   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6700 var
6701   DestData, TmpData, SourceData: pByte;
6702   TempHeight, TempWidth: Integer;
6703   SourceFD, DestFD: TFormatDescriptor;
6704   SourceMD, DestMD: Pointer;
6705
6706   FuncRec: TglBitmapFunctionRec;
6707 begin
6708   Assert(Assigned(Data));
6709   Assert(Assigned(aSource));
6710   Assert(Assigned(aSource.Data));
6711
6712   result := false;
6713   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6714     SourceFD := TFormatDescriptor.Get(aSource.Format);
6715     DestFD   := TFormatDescriptor.Get(aFormat);
6716
6717     if (SourceFD.IsCompressed) then
6718       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6719     if (DestFD.IsCompressed) then
6720       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6721
6722     // inkompatible Formats so CreateTemp
6723     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6724       aCreateTemp := true;
6725
6726     // Values
6727     TempHeight := Max(1, aSource.Height);
6728     TempWidth  := Max(1, aSource.Width);
6729
6730     FuncRec.Sender := Self;
6731     FuncRec.Args   := aArgs;
6732
6733     TmpData := nil;
6734     if aCreateTemp then begin
6735       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6736       DestData := TmpData;
6737     end else
6738       DestData := Data;
6739
6740     try
6741       SourceFD.PreparePixel(FuncRec.Source);
6742       DestFD.PreparePixel  (FuncRec.Dest);
6743
6744       SourceMD := SourceFD.CreateMappingData;
6745       DestMD   := DestFD.CreateMappingData;
6746
6747       FuncRec.Size            := aSource.Dimension;
6748       FuncRec.Position.Fields := FuncRec.Size.Fields;
6749
6750       try
6751         SourceData := aSource.Data;
6752         FuncRec.Position.Y := 0;
6753         while FuncRec.Position.Y < TempHeight do begin
6754           FuncRec.Position.X := 0;
6755           while FuncRec.Position.X < TempWidth do begin
6756             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6757             aFunc(FuncRec);
6758             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6759             inc(FuncRec.Position.X);
6760           end;
6761           inc(FuncRec.Position.Y);
6762         end;
6763
6764         // Updating Image or InternalFormat
6765         if aCreateTemp then
6766           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6767         else if (aFormat <> fFormat) then
6768           Format := aFormat;
6769
6770         result := true;
6771       finally
6772         SourceFD.FreeMappingData(SourceMD);
6773         DestFD.FreeMappingData(DestMD);
6774       end;
6775     except
6776       if aCreateTemp and Assigned(TmpData) then
6777         FreeMem(TmpData);
6778       raise;
6779     end;
6780   end;
6781 end;
6782
6783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6784 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6785 var
6786   SourceFD, DestFD: TFormatDescriptor;
6787   SourcePD, DestPD: TglBitmapPixelData;
6788   ShiftData: TShiftData;
6789
6790   function DataIsIdentical: Boolean;
6791   begin
6792     result := SourceFD.MaskMatch(DestFD.Mask);
6793   end;
6794
6795   function CanCopyDirect: Boolean;
6796   begin
6797     result :=
6798       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6799       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6800       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6801       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6802   end;
6803
6804   function CanShift: Boolean;
6805   begin
6806     result :=
6807       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6808       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6809       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6810       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6811   end;
6812
6813   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6814   begin
6815     result := 0;
6816     while (aSource > aDest) and (aSource > 0) do begin
6817       inc(result);
6818       aSource := aSource shr 1;
6819     end;
6820   end;
6821
6822 begin
6823   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6824     SourceFD := TFormatDescriptor.Get(Format);
6825     DestFD   := TFormatDescriptor.Get(aFormat);
6826
6827     if DataIsIdentical then begin
6828       result := true;
6829       Format := aFormat;
6830       exit;
6831     end;
6832
6833     SourceFD.PreparePixel(SourcePD);
6834     DestFD.PreparePixel  (DestPD);
6835
6836     if CanCopyDirect then
6837       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6838     else if CanShift then begin
6839       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6840       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6841       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6842       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6843       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6844     end else
6845       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6846   end else
6847     result := true;
6848 end;
6849
6850 {$IFDEF GLB_SDL}
6851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6852 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6853 var
6854   Row, RowSize: Integer;
6855   SourceData, TmpData: PByte;
6856   TempDepth: Integer;
6857   FormatDesc: TFormatDescriptor;
6858
6859   function GetRowPointer(Row: Integer): pByte;
6860   begin
6861     result := aSurface.pixels;
6862     Inc(result, Row * RowSize);
6863   end;
6864
6865 begin
6866   result := false;
6867
6868   FormatDesc := TFormatDescriptor.Get(Format);
6869   if FormatDesc.IsCompressed then
6870     raise EglBitmapUnsupportedFormat.Create(Format);
6871
6872   if Assigned(Data) then begin
6873     case Trunc(FormatDesc.PixelSize) of
6874       1: TempDepth :=  8;
6875       2: TempDepth := 16;
6876       3: TempDepth := 24;
6877       4: TempDepth := 32;
6878     else
6879       raise EglBitmapUnsupportedFormat.Create(Format);
6880     end;
6881
6882     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6883       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6884     SourceData := Data;
6885     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6886
6887     for Row := 0 to FileHeight-1 do begin
6888       TmpData := GetRowPointer(Row);
6889       if Assigned(TmpData) then begin
6890         Move(SourceData^, TmpData^, RowSize);
6891         inc(SourceData, RowSize);
6892       end;
6893     end;
6894     result := true;
6895   end;
6896 end;
6897
6898 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6899 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6900 var
6901   pSource, pData, pTempData: PByte;
6902   Row, RowSize, TempWidth, TempHeight: Integer;
6903   IntFormat: TglBitmapFormat;
6904   fd: TFormatDescriptor;
6905   Mask: TglBitmapMask;
6906
6907   function GetRowPointer(Row: Integer): pByte;
6908   begin
6909     result := aSurface^.pixels;
6910     Inc(result, Row * RowSize);
6911   end;
6912
6913 begin
6914   result := false;
6915   if (Assigned(aSurface)) then begin
6916     with aSurface^.format^ do begin
6917       Mask.r := RMask;
6918       Mask.g := GMask;
6919       Mask.b := BMask;
6920       Mask.a := AMask;
6921       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6922       if (IntFormat = tfEmpty) then
6923         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6924     end;
6925
6926     fd := TFormatDescriptor.Get(IntFormat);
6927     TempWidth  := aSurface^.w;
6928     TempHeight := aSurface^.h;
6929     RowSize := fd.GetSize(TempWidth, 1);
6930     GetMem(pData, TempHeight * RowSize);
6931     try
6932       pTempData := pData;
6933       for Row := 0 to TempHeight -1 do begin
6934         pSource := GetRowPointer(Row);
6935         if (Assigned(pSource)) then begin
6936           Move(pSource^, pTempData^, RowSize);
6937           Inc(pTempData, RowSize);
6938         end;
6939       end;
6940       SetData(pData, IntFormat, TempWidth, TempHeight);
6941       result := true;
6942     except
6943       if Assigned(pData) then
6944         FreeMem(pData);
6945       raise;
6946     end;
6947   end;
6948 end;
6949
6950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6951 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6952 var
6953   Row, Col, AlphaInterleave: Integer;
6954   pSource, pDest: PByte;
6955
6956   function GetRowPointer(Row: Integer): pByte;
6957   begin
6958     result := aSurface.pixels;
6959     Inc(result, Row * Width);
6960   end;
6961
6962 begin
6963   result := false;
6964   if Assigned(Data) then begin
6965     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6966       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6967
6968       AlphaInterleave := 0;
6969       case Format of
6970         tfLuminance8Alpha8ub2:
6971           AlphaInterleave := 1;
6972         tfBGRA8ub4, tfRGBA8ub4:
6973           AlphaInterleave := 3;
6974       end;
6975
6976       pSource := Data;
6977       for Row := 0 to Height -1 do begin
6978         pDest := GetRowPointer(Row);
6979         if Assigned(pDest) then begin
6980           for Col := 0 to Width -1 do begin
6981             Inc(pSource, AlphaInterleave);
6982             pDest^ := pSource^;
6983             Inc(pDest);
6984             Inc(pSource);
6985           end;
6986         end;
6987       end;
6988       result := true;
6989     end;
6990   end;
6991 end;
6992
6993 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6994 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6995 var
6996   bmp: TglBitmap2D;
6997 begin
6998   bmp := TglBitmap2D.Create;
6999   try
7000     bmp.AssignFromSurface(aSurface);
7001     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
7002   finally
7003     bmp.Free;
7004   end;
7005 end;
7006 {$ENDIF}
7007
7008 {$IFDEF GLB_DELPHI}
7009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7010 function CreateGrayPalette: HPALETTE;
7011 var
7012   Idx: Integer;
7013   Pal: PLogPalette;
7014 begin
7015   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
7016
7017   Pal.palVersion := $300;
7018   Pal.palNumEntries := 256;
7019
7020   for Idx := 0 to Pal.palNumEntries - 1 do begin
7021     Pal.palPalEntry[Idx].peRed   := Idx;
7022     Pal.palPalEntry[Idx].peGreen := Idx;
7023     Pal.palPalEntry[Idx].peBlue  := Idx;
7024     Pal.palPalEntry[Idx].peFlags := 0;
7025   end;
7026   Result := CreatePalette(Pal^);
7027   FreeMem(Pal);
7028 end;
7029
7030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7031 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7032 var
7033   Row, RowSize: Integer;
7034   pSource, pData: PByte;
7035 begin
7036   result := false;
7037   if Assigned(Data) then begin
7038     if Assigned(aBitmap) then begin
7039       aBitmap.Width  := Width;
7040       aBitmap.Height := Height;
7041
7042       case Format of
7043         tfAlpha8ub1, tfLuminance8ub1: begin
7044           aBitmap.PixelFormat := pf8bit;
7045           aBitmap.Palette     := CreateGrayPalette;
7046         end;
7047         tfRGB5A1us1:
7048           aBitmap.PixelFormat := pf15bit;
7049         tfR5G6B5us1:
7050           aBitmap.PixelFormat := pf16bit;
7051         tfRGB8ub3, tfBGR8ub3:
7052           aBitmap.PixelFormat := pf24bit;
7053         tfRGBA8ub4, tfBGRA8ub4:
7054           aBitmap.PixelFormat := pf32bit;
7055       else
7056         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7057       end;
7058
7059       RowSize := FormatDescriptor.GetSize(Width, 1);
7060       pSource := Data;
7061       for Row := 0 to Height-1 do begin
7062         pData := aBitmap.Scanline[Row];
7063         Move(pSource^, pData^, RowSize);
7064         Inc(pSource, RowSize);
7065         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7066           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7067       end;
7068       result := true;
7069     end;
7070   end;
7071 end;
7072
7073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7074 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7075 var
7076   pSource, pData, pTempData: PByte;
7077   Row, RowSize, TempWidth, TempHeight: Integer;
7078   IntFormat: TglBitmapFormat;
7079 begin
7080   result := false;
7081
7082   if (Assigned(aBitmap)) then begin
7083     case aBitmap.PixelFormat of
7084       pf8bit:
7085         IntFormat := tfLuminance8ub1;
7086       pf15bit:
7087         IntFormat := tfRGB5A1us1;
7088       pf16bit:
7089         IntFormat := tfR5G6B5us1;
7090       pf24bit:
7091         IntFormat := tfBGR8ub3;
7092       pf32bit:
7093         IntFormat := tfBGRA8ub4;
7094     else
7095       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7096     end;
7097
7098     TempWidth  := aBitmap.Width;
7099     TempHeight := aBitmap.Height;
7100     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7101     GetMem(pData, TempHeight * RowSize);
7102     try
7103       pTempData := pData;
7104       for Row := 0 to TempHeight -1 do begin
7105         pSource := aBitmap.Scanline[Row];
7106         if (Assigned(pSource)) then begin
7107           Move(pSource^, pTempData^, RowSize);
7108           Inc(pTempData, RowSize);
7109         end;
7110       end;
7111       SetData(pData, IntFormat, TempWidth, TempHeight);
7112       result := true;
7113     except
7114       if Assigned(pData) then
7115         FreeMem(pData);
7116       raise;
7117     end;
7118   end;
7119 end;
7120
7121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7122 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7123 var
7124   Row, Col, AlphaInterleave: Integer;
7125   pSource, pDest: PByte;
7126 begin
7127   result := false;
7128
7129   if Assigned(Data) then begin
7130     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7131       if Assigned(aBitmap) then begin
7132         aBitmap.PixelFormat := pf8bit;
7133         aBitmap.Palette     := CreateGrayPalette;
7134         aBitmap.Width       := Width;
7135         aBitmap.Height      := Height;
7136
7137         case Format of
7138           tfLuminance8Alpha8ub2:
7139             AlphaInterleave := 1;
7140           tfRGBA8ub4, tfBGRA8ub4:
7141             AlphaInterleave := 3;
7142           else
7143             AlphaInterleave := 0;
7144         end;
7145
7146         // Copy Data
7147         pSource := Data;
7148
7149         for Row := 0 to Height -1 do begin
7150           pDest := aBitmap.Scanline[Row];
7151           if Assigned(pDest) then begin
7152             for Col := 0 to Width -1 do begin
7153               Inc(pSource, AlphaInterleave);
7154               pDest^ := pSource^;
7155               Inc(pDest);
7156               Inc(pSource);
7157             end;
7158           end;
7159         end;
7160         result := true;
7161       end;
7162     end;
7163   end;
7164 end;
7165
7166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7167 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7168 var
7169   data: TglBitmapData;
7170 begin
7171   data := TglBitmapData.Create;
7172   try
7173     data.AssignFromBitmap(aBitmap);
7174     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7175   finally
7176     data.Free;
7177   end;
7178 end;
7179 {$ENDIF}
7180
7181 {$IFDEF GLB_LAZARUS}
7182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7183 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7184 var
7185   rid: TRawImageDescription;
7186   FormatDesc: TFormatDescriptor;
7187 begin
7188   if not Assigned(Data) then
7189     raise EglBitmap.Create('no pixel data assigned. load data before save');
7190
7191   result := false;
7192   if not Assigned(aImage) or (Format = tfEmpty) then
7193     exit;
7194   FormatDesc := TFormatDescriptor.Get(Format);
7195   if FormatDesc.IsCompressed then
7196     exit;
7197
7198   FillChar(rid{%H-}, SizeOf(rid), 0);
7199   if FormatDesc.IsGrayscale then
7200     rid.Format := ricfGray
7201   else
7202     rid.Format := ricfRGBA;
7203
7204   rid.Width        := Width;
7205   rid.Height       := Height;
7206   rid.Depth        := FormatDesc.BitsPerPixel;
7207   rid.BitOrder     := riboBitsInOrder;
7208   rid.ByteOrder    := riboLSBFirst;
7209   rid.LineOrder    := riloTopToBottom;
7210   rid.LineEnd      := rileTight;
7211   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7212   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7213   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7214   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7215   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7216   rid.RedShift     := FormatDesc.Shift.r;
7217   rid.GreenShift   := FormatDesc.Shift.g;
7218   rid.BlueShift    := FormatDesc.Shift.b;
7219   rid.AlphaShift   := FormatDesc.Shift.a;
7220
7221   rid.MaskBitsPerPixel  := 0;
7222   rid.PaletteColorCount := 0;
7223
7224   aImage.DataDescription := rid;
7225   aImage.CreateData;
7226
7227   if not Assigned(aImage.PixelData) then
7228     raise EglBitmap.Create('error while creating LazIntfImage');
7229   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7230
7231   result := true;
7232 end;
7233
7234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7235 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7236 var
7237   f: TglBitmapFormat;
7238   FormatDesc: TFormatDescriptor;
7239   ImageData: PByte;
7240   ImageSize: Integer;
7241   CanCopy: Boolean;
7242   Mask: TglBitmapRec4ul;
7243
7244   procedure CopyConvert;
7245   var
7246     bfFormat: TbmpBitfieldFormat;
7247     pSourceLine, pDestLine: PByte;
7248     pSourceMD, pDestMD: Pointer;
7249     Shift, Prec: TglBitmapRec4ub;
7250     x, y: Integer;
7251     pixel: TglBitmapPixelData;
7252   begin
7253     bfFormat  := TbmpBitfieldFormat.Create;
7254     with aImage.DataDescription do begin
7255       Prec.r := RedPrec;
7256       Prec.g := GreenPrec;
7257       Prec.b := BluePrec;
7258       Prec.a := AlphaPrec;
7259       Shift.r := RedShift;
7260       Shift.g := GreenShift;
7261       Shift.b := BlueShift;
7262       Shift.a := AlphaShift;
7263       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7264     end;
7265     pSourceMD := bfFormat.CreateMappingData;
7266     pDestMD   := FormatDesc.CreateMappingData;
7267     try
7268       for y := 0 to aImage.Height-1 do begin
7269         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7270         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7271         for x := 0 to aImage.Width-1 do begin
7272           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7273           FormatDesc.Map(pixel, pDestLine, pDestMD);
7274         end;
7275       end;
7276     finally
7277       FormatDesc.FreeMappingData(pDestMD);
7278       bfFormat.FreeMappingData(pSourceMD);
7279       bfFormat.Free;
7280     end;
7281   end;
7282
7283 begin
7284   result := false;
7285   if not Assigned(aImage) then
7286     exit;
7287
7288   with aImage.DataDescription do begin
7289     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7290     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7291     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7292     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7293   end;
7294   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7295   f          := FormatDesc.Format;
7296   if (f = tfEmpty) then
7297     exit;
7298
7299   CanCopy :=
7300     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7301     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7302
7303   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7304   ImageData := GetMem(ImageSize);
7305   try
7306     if CanCopy then
7307       Move(aImage.PixelData^, ImageData^, ImageSize)
7308     else
7309       CopyConvert;
7310     SetData(ImageData, f, aImage.Width, aImage.Height);
7311   except
7312     if Assigned(ImageData) then
7313       FreeMem(ImageData);
7314     raise;
7315   end;
7316
7317   result := true;
7318 end;
7319
7320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7321 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7322 var
7323   rid: TRawImageDescription;
7324   FormatDesc: TFormatDescriptor;
7325   Pixel: TglBitmapPixelData;
7326   x, y: Integer;
7327   srcMD: Pointer;
7328   src, dst: PByte;
7329 begin
7330   result := false;
7331   if not Assigned(aImage) or (Format = tfEmpty) then
7332     exit;
7333   FormatDesc := TFormatDescriptor.Get(Format);
7334   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7335     exit;
7336
7337   FillChar(rid{%H-}, SizeOf(rid), 0);
7338   rid.Format       := ricfGray;
7339   rid.Width        := Width;
7340   rid.Height       := Height;
7341   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7342   rid.BitOrder     := riboBitsInOrder;
7343   rid.ByteOrder    := riboLSBFirst;
7344   rid.LineOrder    := riloTopToBottom;
7345   rid.LineEnd      := rileTight;
7346   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7347   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7348   rid.GreenPrec    := 0;
7349   rid.BluePrec     := 0;
7350   rid.AlphaPrec    := 0;
7351   rid.RedShift     := 0;
7352   rid.GreenShift   := 0;
7353   rid.BlueShift    := 0;
7354   rid.AlphaShift   := 0;
7355
7356   rid.MaskBitsPerPixel  := 0;
7357   rid.PaletteColorCount := 0;
7358
7359   aImage.DataDescription := rid;
7360   aImage.CreateData;
7361
7362   srcMD := FormatDesc.CreateMappingData;
7363   try
7364     FormatDesc.PreparePixel(Pixel);
7365     src := Data;
7366     dst := aImage.PixelData;
7367     for y := 0 to Height-1 do
7368       for x := 0 to Width-1 do begin
7369         FormatDesc.Unmap(src, Pixel, srcMD);
7370         case rid.BitsPerPixel of
7371            8: begin
7372             dst^ := Pixel.Data.a;
7373             inc(dst);
7374           end;
7375           16: begin
7376             PWord(dst)^ := Pixel.Data.a;
7377             inc(dst, 2);
7378           end;
7379           24: begin
7380             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7381             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7382             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7383             inc(dst, 3);
7384           end;
7385           32: begin
7386             PCardinal(dst)^ := Pixel.Data.a;
7387             inc(dst, 4);
7388           end;
7389         else
7390           raise EglBitmapUnsupportedFormat.Create(Format);
7391         end;
7392       end;
7393   finally
7394     FormatDesc.FreeMappingData(srcMD);
7395   end;
7396   result := true;
7397 end;
7398
7399 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7400 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7401 var
7402   data: TglBitmapData;
7403 begin
7404   data := TglBitmapData.Create;
7405   try
7406     data.AssignFromLazIntfImage(aImage);
7407     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7408   finally
7409     data.Free;
7410   end;
7411 end;
7412 {$ENDIF}
7413
7414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7415 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7416   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7417 var
7418   rs: TResourceStream;
7419 begin
7420   PrepareResType(aResource, aResType);
7421   rs := TResourceStream.Create(aInstance, aResource, aResType);
7422   try
7423     result := AddAlphaFromStream(rs, aFunc, aArgs);
7424   finally
7425     rs.Free;
7426   end;
7427 end;
7428
7429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7430 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7431   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7432 var
7433   rs: TResourceStream;
7434 begin
7435   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7436   try
7437     result := AddAlphaFromStream(rs, aFunc, aArgs);
7438   finally
7439     rs.Free;
7440   end;
7441 end;
7442
7443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7444 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7445 begin
7446   if TFormatDescriptor.Get(Format).IsCompressed then
7447     raise EglBitmapUnsupportedFormat.Create(Format);
7448   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7449 end;
7450
7451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7452 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7453 var
7454   FS: TFileStream;
7455 begin
7456   FS := TFileStream.Create(aFileName, fmOpenRead);
7457   try
7458     result := AddAlphaFromStream(FS, aFunc, aArgs);
7459   finally
7460     FS.Free;
7461   end;
7462 end;
7463
7464 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7465 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7466 var
7467   data: TglBitmapData;
7468 begin
7469   data := TglBitmapData.Create(aStream);
7470   try
7471     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7472   finally
7473     data.Free;
7474   end;
7475 end;
7476
7477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7478 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7479 var
7480   DestData, DestData2, SourceData: pByte;
7481   TempHeight, TempWidth: Integer;
7482   SourceFD, DestFD: TFormatDescriptor;
7483   SourceMD, DestMD, DestMD2: Pointer;
7484
7485   FuncRec: TglBitmapFunctionRec;
7486 begin
7487   result := false;
7488
7489   Assert(Assigned(Data));
7490   Assert(Assigned(aDataObj));
7491   Assert(Assigned(aDataObj.Data));
7492
7493   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7494     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7495
7496     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7497     DestFD   := TFormatDescriptor.Get(Format);
7498
7499     if not Assigned(aFunc) then begin
7500       aFunc        := glBitmapAlphaFunc;
7501       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7502     end else
7503       FuncRec.Args := aArgs;
7504
7505     // Values
7506     TempWidth  := aDataObj.Width;
7507     TempHeight := aDataObj.Height;
7508     if (TempWidth <= 0) or (TempHeight <= 0) then
7509       exit;
7510
7511     FuncRec.Sender          := Self;
7512     FuncRec.Size            := Dimension;
7513     FuncRec.Position.Fields := FuncRec.Size.Fields;
7514
7515     DestData   := Data;
7516     DestData2  := Data;
7517     SourceData := aDataObj.Data;
7518
7519     // Mapping
7520     SourceFD.PreparePixel(FuncRec.Source);
7521     DestFD.PreparePixel  (FuncRec.Dest);
7522
7523     SourceMD := SourceFD.CreateMappingData;
7524     DestMD   := DestFD.CreateMappingData;
7525     DestMD2  := DestFD.CreateMappingData;
7526     try
7527       FuncRec.Position.Y := 0;
7528       while FuncRec.Position.Y < TempHeight do begin
7529         FuncRec.Position.X := 0;
7530         while FuncRec.Position.X < TempWidth do begin
7531           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7532           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7533           aFunc(FuncRec);
7534           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7535           inc(FuncRec.Position.X);
7536         end;
7537         inc(FuncRec.Position.Y);
7538       end;
7539     finally
7540       SourceFD.FreeMappingData(SourceMD);
7541       DestFD.FreeMappingData(DestMD);
7542       DestFD.FreeMappingData(DestMD2);
7543     end;
7544   end;
7545 end;
7546
7547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7548 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7549 begin
7550   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7551 end;
7552
7553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7554 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7555 var
7556   PixelData: TglBitmapPixelData;
7557 begin
7558   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7559   result := AddAlphaFromColorKeyFloat(
7560     aRed   / PixelData.Range.r,
7561     aGreen / PixelData.Range.g,
7562     aBlue  / PixelData.Range.b,
7563     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7564 end;
7565
7566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7567 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7568 var
7569   values: array[0..2] of Single;
7570   tmp: Cardinal;
7571   i: Integer;
7572   PixelData: TglBitmapPixelData;
7573 begin
7574   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7575   with PixelData do begin
7576     values[0] := aRed;
7577     values[1] := aGreen;
7578     values[2] := aBlue;
7579
7580     for i := 0 to 2 do begin
7581       tmp          := Trunc(Range.arr[i] * aDeviation);
7582       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7583       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7584     end;
7585     Data.a  := 0;
7586     Range.a := 0;
7587   end;
7588   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7589 end;
7590
7591 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7592 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7593 begin
7594   result := AddAlphaFromValueFloat(aAlpha / $FF);
7595 end;
7596
7597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7598 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7599 var
7600   PixelData: TglBitmapPixelData;
7601 begin
7602   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7603   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7604 end;
7605
7606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7607 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7608 var
7609   PixelData: TglBitmapPixelData;
7610 begin
7611   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7612   with PixelData do
7613     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7614   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7615 end;
7616
7617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7618 function TglBitmapData.RemoveAlpha: Boolean;
7619 var
7620   FormatDesc: TFormatDescriptor;
7621 begin
7622   result := false;
7623   FormatDesc := TFormatDescriptor.Get(Format);
7624   if Assigned(Data) then begin
7625     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7626       raise EglBitmapUnsupportedFormat.Create(Format);
7627     result := ConvertTo(FormatDesc.WithoutAlpha);
7628   end;
7629 end;
7630
7631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7632 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7633   const aAlpha: Byte);
7634 begin
7635   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7636 end;
7637
7638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7639 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7640 var
7641   PixelData: TglBitmapPixelData;
7642 begin
7643   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7644   FillWithColorFloat(
7645     aRed   / PixelData.Range.r,
7646     aGreen / PixelData.Range.g,
7647     aBlue  / PixelData.Range.b,
7648     aAlpha / PixelData.Range.a);
7649 end;
7650
7651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7652 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7653 var
7654   PixelData: TglBitmapPixelData;
7655 begin
7656   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7657   with PixelData do begin
7658     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7659     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7660     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7661     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7662   end;
7663   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7664 end;
7665
7666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7667 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7668 begin
7669   if (Data <> aData) then begin
7670     if (Assigned(Data)) then
7671       FreeMem(Data);
7672     fData := aData;
7673   end;
7674
7675   if Assigned(fData) then begin
7676     FillChar(fDimension, SizeOf(fDimension), 0);
7677     if aWidth <> -1 then begin
7678       fDimension.Fields := fDimension.Fields + [ffX];
7679       fDimension.X := aWidth;
7680     end;
7681
7682     if aHeight <> -1 then begin
7683       fDimension.Fields := fDimension.Fields + [ffY];
7684       fDimension.Y := aHeight;
7685     end;
7686
7687     fFormat := aFormat;
7688   end else
7689     fFormat := tfEmpty;
7690
7691   UpdateScanlines;
7692 end;
7693
7694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7695 function TglBitmapData.Clone: TglBitmapData;
7696 var
7697   Temp: TglBitmapData;
7698   TempPtr: PByte;
7699   Size: Integer;
7700 begin
7701   result := nil;
7702   Temp := (ClassType.Create as TglBitmapData);
7703   try
7704     // copy texture data if assigned
7705     if Assigned(Data) then begin
7706       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7707       GetMem(TempPtr, Size);
7708       try
7709         Move(Data^, TempPtr^, Size);
7710         Temp.SetData(TempPtr, Format, Width, Height);
7711       except
7712         if Assigned(TempPtr) then
7713           FreeMem(TempPtr);
7714         raise;
7715       end;
7716     end else begin
7717       TempPtr := nil;
7718       Temp.SetData(TempPtr, Format, Width, Height);
7719     end;
7720
7721           // copy properties
7722     Temp.fFormat := Format;
7723     result := Temp;
7724   except
7725     FreeAndNil(Temp);
7726     raise;
7727   end;
7728 end;
7729
7730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7731 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7732 var
7733   mask: PtrInt;
7734 begin
7735   mask :=
7736      (Byte(aRed)   and 1)        or
7737     ((Byte(aGreen) and 1) shl 1) or
7738     ((Byte(aBlue)  and 1) shl 2) or
7739     ((Byte(aAlpha) and 1) shl 3);
7740   if (mask > 0) then
7741     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7742 end;
7743
7744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7745 type
7746   TMatrixItem = record
7747     X, Y: Integer;
7748     W: Single;
7749   end;
7750
7751   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7752   TglBitmapToNormalMapRec = Record
7753     Scale: Single;
7754     Heights: array of Single;
7755     MatrixU : array of TMatrixItem;
7756     MatrixV : array of TMatrixItem;
7757   end;
7758
7759 const
7760   ONE_OVER_255 = 1 / 255;
7761
7762   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7763 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7764 var
7765   Val: Single;
7766 begin
7767   with FuncRec do begin
7768     Val :=
7769       Source.Data.r * LUMINANCE_WEIGHT_R +
7770       Source.Data.g * LUMINANCE_WEIGHT_G +
7771       Source.Data.b * LUMINANCE_WEIGHT_B;
7772     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7773   end;
7774 end;
7775
7776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7777 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7778 begin
7779   with FuncRec do
7780     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7781 end;
7782
7783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7784 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7785 type
7786   TVec = Array[0..2] of Single;
7787 var
7788   Idx: Integer;
7789   du, dv: Double;
7790   Len: Single;
7791   Vec: TVec;
7792
7793   function GetHeight(X, Y: Integer): Single;
7794   begin
7795     with FuncRec do begin
7796       X := Max(0, Min(Size.X -1, X));
7797       Y := Max(0, Min(Size.Y -1, Y));
7798       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7799     end;
7800   end;
7801
7802 begin
7803   with FuncRec do begin
7804     with PglBitmapToNormalMapRec(Args)^ do begin
7805       du := 0;
7806       for Idx := Low(MatrixU) to High(MatrixU) do
7807         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7808
7809       dv := 0;
7810       for Idx := Low(MatrixU) to High(MatrixU) do
7811         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7812
7813       Vec[0] := -du * Scale;
7814       Vec[1] := -dv * Scale;
7815       Vec[2] := 1;
7816     end;
7817
7818     // Normalize
7819     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7820     if Len <> 0 then begin
7821       Vec[0] := Vec[0] * Len;
7822       Vec[1] := Vec[1] * Len;
7823       Vec[2] := Vec[2] * Len;
7824     end;
7825
7826     // Farbe zuweisem
7827     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7828     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7829     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7830   end;
7831 end;
7832
7833 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7834 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7835 var
7836   Rec: TglBitmapToNormalMapRec;
7837
7838   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7839   begin
7840     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7841       Matrix[Index].X := X;
7842       Matrix[Index].Y := Y;
7843       Matrix[Index].W := W;
7844     end;
7845   end;
7846
7847 begin
7848   if TFormatDescriptor.Get(Format).IsCompressed then
7849     raise EglBitmapUnsupportedFormat.Create(Format);
7850
7851   if aScale > 100 then
7852     Rec.Scale := 100
7853   else if aScale < -100 then
7854     Rec.Scale := -100
7855   else
7856     Rec.Scale := aScale;
7857
7858   SetLength(Rec.Heights, Width * Height);
7859   try
7860     case aFunc of
7861       nm4Samples: begin
7862         SetLength(Rec.MatrixU, 2);
7863         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7864         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7865
7866         SetLength(Rec.MatrixV, 2);
7867         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7868         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7869       end;
7870
7871       nmSobel: begin
7872         SetLength(Rec.MatrixU, 6);
7873         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7874         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7875         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7876         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7877         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7878         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7879
7880         SetLength(Rec.MatrixV, 6);
7881         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7882         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7883         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7884         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7885         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7886         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7887       end;
7888
7889       nm3x3: begin
7890         SetLength(Rec.MatrixU, 6);
7891         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7892         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7893         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7894         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7895         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7896         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7897
7898         SetLength(Rec.MatrixV, 6);
7899         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7900         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7901         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7902         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7903         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7904         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7905       end;
7906
7907       nm5x5: begin
7908         SetLength(Rec.MatrixU, 20);
7909         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7910         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7911         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7912         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7913         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7914         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7915         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7916         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7917         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7918         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7919         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7920         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7921         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7922         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7923         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7924         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7925         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7926         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7927         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7928         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7929
7930         SetLength(Rec.MatrixV, 20);
7931         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7932         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7933         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7934         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7935         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7936         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7937         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7938         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7939         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7940         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7941         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7942         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7943         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7944         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7945         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7946         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7947         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7948         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7949         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7950         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7951       end;
7952     end;
7953
7954     // Daten Sammeln
7955     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7956       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7957     else
7958       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7959     Convert(glBitmapToNormalMapFunc, false, @Rec);
7960   finally
7961     SetLength(Rec.Heights, 0);
7962   end;
7963 end;
7964
7965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7966 constructor TglBitmapData.Create;
7967 begin
7968   inherited Create;
7969   fFormat := glBitmapDefaultFormat;
7970 end;
7971
7972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7973 constructor TglBitmapData.Create(const aFileName: String);
7974 begin
7975   Create;
7976   LoadFromFile(aFileName);
7977 end;
7978
7979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7980 constructor TglBitmapData.Create(const aStream: TStream);
7981 begin
7982   Create;
7983   LoadFromStream(aStream);
7984 end;
7985
7986 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7987 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7988 var
7989   ImageSize: Integer;
7990 begin
7991   Create;
7992   if not Assigned(aData) then begin
7993     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7994     GetMem(aData, ImageSize);
7995     try
7996       FillChar(aData^, ImageSize, #$FF);
7997       SetData(aData, aFormat, aSize.X, aSize.Y);
7998     except
7999       if Assigned(aData) then
8000         FreeMem(aData);
8001       raise;
8002     end;
8003   end else begin
8004     SetData(aData, aFormat, aSize.X, aSize.Y);
8005   end;
8006 end;
8007
8008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8009 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
8010 begin
8011   Create;
8012   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
8013 end;
8014
8015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8016 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
8017 begin
8018   Create;
8019   LoadFromResource(aInstance, aResource, aResType);
8020 end;
8021
8022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8023 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8024 begin
8025   Create;
8026   LoadFromResourceID(aInstance, aResourceID, aResType);
8027 end;
8028
8029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8030 destructor TglBitmapData.Destroy;
8031 begin
8032   SetData(nil, tfEmpty);
8033   inherited Destroy;
8034 end;
8035
8036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8037 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8039 function TglBitmap.GetWidth: Integer;
8040 begin
8041   if (ffX in fDimension.Fields) then
8042     result := fDimension.X
8043   else
8044     result := -1;
8045 end;
8046
8047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8048 function TglBitmap.GetHeight: Integer;
8049 begin
8050   if (ffY in fDimension.Fields) then
8051     result := fDimension.Y
8052   else
8053     result := -1;
8054 end;
8055
8056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8057 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8058 begin
8059   if fCustomData = aValue then
8060     exit;
8061   fCustomData := aValue;
8062 end;
8063
8064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8065 procedure TglBitmap.SetCustomName(const aValue: String);
8066 begin
8067   if fCustomName = aValue then
8068     exit;
8069   fCustomName := aValue;
8070 end;
8071
8072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8073 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8074 begin
8075   if fCustomNameW = aValue then
8076     exit;
8077   fCustomNameW := aValue;
8078 end;
8079
8080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8081 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8082 begin
8083   if fDeleteTextureOnFree = aValue then
8084     exit;
8085   fDeleteTextureOnFree := aValue;
8086 end;
8087
8088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8089 procedure TglBitmap.SetID(const aValue: Cardinal);
8090 begin
8091   if fID = aValue then
8092     exit;
8093   fID := aValue;
8094 end;
8095
8096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8097 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8098 begin
8099   if fMipMap = aValue then
8100     exit;
8101   fMipMap := aValue;
8102 end;
8103
8104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8105 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8106 begin
8107   if fTarget = aValue then
8108     exit;
8109   fTarget := aValue;
8110 end;
8111
8112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8113 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8114 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8115 var
8116   MaxAnisotropic: Integer;
8117 {$IFEND}
8118 begin
8119   fAnisotropic := aValue;
8120   if (ID > 0) then begin
8121 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8122     if GL_EXT_texture_filter_anisotropic then begin
8123       if fAnisotropic > 0 then begin
8124         Bind(false);
8125         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8126         if aValue > MaxAnisotropic then
8127           fAnisotropic := MaxAnisotropic;
8128         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8129       end;
8130     end else begin
8131       fAnisotropic := 0;
8132     end;
8133 {$ELSE}
8134     fAnisotropic := 0;
8135 {$IFEND}
8136   end;
8137 end;
8138
8139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8140 procedure TglBitmap.CreateID;
8141 begin
8142   if (ID <> 0) then
8143     glDeleteTextures(1, @fID);
8144   glGenTextures(1, @fID);
8145   Bind(false);
8146 end;
8147
8148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8149 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8150 begin
8151   // Set Up Parameters
8152   SetWrap(fWrapS, fWrapT, fWrapR);
8153   SetFilter(fFilterMin, fFilterMag);
8154   SetAnisotropic(fAnisotropic);
8155
8156 {$IFNDEF OPENGL_ES}
8157   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8158   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8159     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8160 {$ENDIF}
8161
8162 {$IFNDEF OPENGL_ES}
8163   // Mip Maps Generation Mode
8164   aBuildWithGlu := false;
8165   if (MipMap = mmMipmap) then begin
8166     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8167       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
8168     else
8169       aBuildWithGlu := true;
8170   end else if (MipMap = mmMipmapGlu) then
8171     aBuildWithGlu := true;
8172 {$ELSE}
8173   if (MipMap = mmMipmap) then
8174     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
8175 {$ENDIF}
8176 end;
8177
8178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8179 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8181 procedure TglBitmap.AfterConstruction;
8182 begin
8183   inherited AfterConstruction;
8184
8185   fID         := 0;
8186   fTarget     := 0;
8187 {$IFNDEF OPENGL_ES}
8188   fIsResident := false;
8189 {$ENDIF}
8190
8191   fMipMap              := glBitmapDefaultMipmap;
8192   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8193
8194   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8195   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8196 {$IFNDEF OPENGL_ES}
8197   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8198 {$ENDIF}
8199 end;
8200
8201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 procedure TglBitmap.BeforeDestruction;
8203 begin
8204   if (fID > 0) and fDeleteTextureOnFree then
8205     glDeleteTextures(1, @fID);
8206   inherited BeforeDestruction;
8207 end;
8208
8209 {$IFNDEF OPENGL_ES}
8210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8211 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8212 begin
8213   fBorderColor[0] := aRed;
8214   fBorderColor[1] := aGreen;
8215   fBorderColor[2] := aBlue;
8216   fBorderColor[3] := aAlpha;
8217   if (ID > 0) then begin
8218     Bind(false);
8219     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8220   end;
8221 end;
8222 {$ENDIF}
8223
8224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8225 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8226 begin
8227   //check MIN filter
8228   case aMin of
8229     GL_NEAREST:
8230       fFilterMin := GL_NEAREST;
8231     GL_LINEAR:
8232       fFilterMin := GL_LINEAR;
8233     GL_NEAREST_MIPMAP_NEAREST:
8234       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8235     GL_LINEAR_MIPMAP_NEAREST:
8236       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8237     GL_NEAREST_MIPMAP_LINEAR:
8238       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8239     GL_LINEAR_MIPMAP_LINEAR:
8240       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8241     else
8242       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8243   end;
8244
8245   //check MAG filter
8246   case aMag of
8247     GL_NEAREST:
8248       fFilterMag := GL_NEAREST;
8249     GL_LINEAR:
8250       fFilterMag := GL_LINEAR;
8251     else
8252       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8253   end;
8254
8255   //apply filter
8256   if (ID > 0) then begin
8257     Bind(false);
8258     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8259
8260     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8261       case fFilterMin of
8262         GL_NEAREST, GL_LINEAR:
8263           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8264         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8265           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8266         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8267           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8268       end;
8269     end else
8270       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8271   end;
8272 end;
8273
8274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8275 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8276
8277   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8278   begin
8279     case aValue of
8280 {$IFNDEF OPENGL_ES}
8281       GL_CLAMP:
8282         aTarget := GL_CLAMP;
8283 {$ENDIF}
8284
8285       GL_REPEAT:
8286         aTarget := GL_REPEAT;
8287
8288       GL_CLAMP_TO_EDGE: begin
8289 {$IFNDEF OPENGL_ES}
8290         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8291           aTarget := GL_CLAMP
8292         else
8293 {$ENDIF}
8294           aTarget := GL_CLAMP_TO_EDGE;
8295       end;
8296
8297 {$IFNDEF OPENGL_ES}
8298       GL_CLAMP_TO_BORDER: begin
8299         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8300           aTarget := GL_CLAMP_TO_BORDER
8301         else
8302           aTarget := GL_CLAMP;
8303       end;
8304 {$ENDIF}
8305
8306 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8307       GL_MIRRORED_REPEAT: begin
8308   {$IFNDEF OPENGL_ES}
8309         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8310   {$ELSE}
8311         if GL_VERSION_2_0 then
8312   {$ENDIF}
8313           aTarget := GL_MIRRORED_REPEAT
8314         else
8315           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8316       end;
8317 {$IFEND}
8318     else
8319       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8320     end;
8321   end;
8322
8323 begin
8324   CheckAndSetWrap(S, fWrapS);
8325   CheckAndSetWrap(T, fWrapT);
8326   CheckAndSetWrap(R, fWrapR);
8327
8328   if (ID > 0) then begin
8329     Bind(false);
8330     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8331     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8332 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8333     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8334     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8335 {$IFEND}
8336   end;
8337 end;
8338
8339 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8341 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8342
8343   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8344   begin
8345     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8346        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8347       fSwizzle[aIndex] := aValue
8348     else
8349       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8350   end;
8351
8352 begin
8353 {$IFNDEF OPENGL_ES}
8354   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8355     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8356 {$ELSE}
8357   if not GL_VERSION_3_0 then
8358     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8359 {$ENDIF}
8360   CheckAndSetValue(r, 0);
8361   CheckAndSetValue(g, 1);
8362   CheckAndSetValue(b, 2);
8363   CheckAndSetValue(a, 3);
8364
8365   if (ID > 0) then begin
8366     Bind(false);
8367 {$IFNDEF OPENGL_ES}
8368     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8369 {$ELSE}
8370     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8371     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8372     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8373     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8374 {$ENDIF}
8375   end;
8376 end;
8377 {$IFEND}
8378
8379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8380 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
8381 begin
8382   if aEnableTextureUnit then
8383     glEnable(Target);
8384   if (ID > 0) then
8385     glBindTexture(Target, ID);
8386 end;
8387
8388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8389 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
8390 begin
8391   if aDisableTextureUnit then
8392     glDisable(Target);
8393   glBindTexture(Target, 0);
8394 end;
8395
8396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8397 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8398 var
8399   w, h: Integer;
8400 begin
8401   w := aDataObj.Width;
8402   h := aDataObj.Height;
8403   fDimension.Fields := [];
8404   if (w > 0) then
8405     fDimension.Fields := fDimension.Fields + [ffX];
8406   if (h > 0) then
8407     fDimension.Fields := fDimension.Fields + [ffY];
8408   fDimension.X := w;
8409   fDimension.Y := h;
8410 end;
8411
8412 {$IFNDEF OPENGL_ES}
8413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8414 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8415 var
8416   Temp: PByte;
8417   TempWidth, TempHeight: Integer;
8418   TempIntFormat: GLint;
8419   IntFormat: TglBitmapFormat;
8420   FormatDesc: TFormatDescriptor;
8421 begin
8422   result := false;
8423   Bind;
8424
8425   // Request Data
8426   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8427   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8428   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8429
8430   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8431   IntFormat  := FormatDesc.Format;
8432
8433   // Getting data from OpenGL
8434   FormatDesc := TFormatDescriptor.Get(IntFormat);
8435   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8436   try
8437     if FormatDesc.IsCompressed then begin
8438       if not Assigned(glGetCompressedTexImage) then
8439         raise EglBitmap.Create('compressed formats not supported by video adapter');
8440       glGetCompressedTexImage(Target, 0, Temp)
8441     end else
8442       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8443     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8444     result := true;
8445   except
8446     if Assigned(Temp) then
8447       FreeMem(Temp);
8448     raise;
8449   end;
8450 end;
8451 {$ENDIF}
8452
8453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8454 constructor TglBitmap.Create;
8455 begin
8456   if (ClassType = TglBitmap) then
8457     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8458   inherited Create;
8459 end;
8460
8461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 constructor TglBitmap.Create(const aData: TglBitmapData);
8463 begin
8464   Create;
8465   UploadData(aData);
8466 end;
8467
8468 {$IFNDEF OPENGL_ES}
8469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8470 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8472 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8473 var
8474   fd: TglBitmapFormatDescriptor;
8475 begin
8476   // Upload data
8477   fd := aDataObj.FormatDescriptor;
8478   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8479     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8480
8481   if fd.IsCompressed then begin
8482     if not Assigned(glCompressedTexImage1D) then
8483       raise EglBitmap.Create('compressed formats not supported by video adapter');
8484     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8485   end else if aBuildWithGlu then
8486     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8487   else
8488     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8489 end;
8490
8491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8492 procedure TglBitmap1D.AfterConstruction;
8493 begin
8494   inherited;
8495   Target := GL_TEXTURE_1D;
8496 end;
8497
8498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8499 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8500 var
8501   BuildWithGlu, TexRec: Boolean;
8502   TexSize: Integer;
8503 begin
8504   if not Assigned(aDataObj) then
8505     exit;
8506
8507   // Check Texture Size
8508   if (aCheckSize) then begin
8509     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8510
8511     if (aDataObj.Width > TexSize) then
8512       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8513
8514     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8515               (Target = GL_TEXTURE_RECTANGLE);
8516     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8517       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8518   end;
8519
8520   if (fID = 0) then
8521     CreateID;
8522   SetupParameters(BuildWithGlu);
8523   UploadDataIntern(aDataObj, BuildWithGlu);
8524   glAreTexturesResident(1, @fID, @fIsResident);
8525
8526   inherited UploadData(aDataObj, aCheckSize);
8527 end;
8528 {$ENDIF}
8529
8530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8531 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8532 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8533 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
8534 var
8535   fd: TglBitmapFormatDescriptor;
8536 begin
8537   fd := aDataObj.FormatDescriptor;
8538   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8539     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8540
8541   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8542
8543   if fd.IsCompressed then begin
8544     if not Assigned(glCompressedTexImage2D) then
8545       raise EglBitmap.Create('compressed formats not supported by video adapter');
8546     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8547 {$IFNDEF OPENGL_ES}
8548   end else if aBuildWithGlu then begin
8549     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8550 {$ENDIF}
8551   end else begin
8552     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8553   end;
8554 end;
8555
8556 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8557 procedure TglBitmap2D.AfterConstruction;
8558 begin
8559   inherited;
8560   Target := GL_TEXTURE_2D;
8561 end;
8562
8563 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8564 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8565 var
8566   {$IFNDEF OPENGL_ES}
8567   BuildWithGlu, TexRec: Boolean;
8568   {$ENDIF}
8569   PotTex: Boolean;
8570   TexSize: Integer;
8571 begin
8572   if not Assigned(aDataObj) then
8573     exit;
8574
8575   // Check Texture Size
8576   if (aCheckSize) then begin
8577     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8578
8579     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8580       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8581
8582     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8583 {$IF NOT DEFINED(OPENGL_ES)}
8584     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8585     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8586       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8587 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8588     if not PotTex and not GL_OES_texture_npot then
8589       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8590 {$ELSE}
8591     if not PotTex then
8592       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8593 {$IFEND}
8594   end;
8595
8596   if (fID = 0) then
8597     CreateID;
8598   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8599   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8600 {$IFNDEF OPENGL_ES}
8601   glAreTexturesResident(1, @fID, @fIsResident);
8602 {$ENDIF}
8603
8604   inherited UploadData(aDataObj, aCheckSize);
8605 end;
8606
8607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8608 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8609 var
8610   Temp: pByte;
8611   Size, w, h: Integer;
8612   FormatDesc: TFormatDescriptor;
8613 begin
8614   FormatDesc := TFormatDescriptor.Get(aFormat);
8615   if FormatDesc.IsCompressed then
8616     raise EglBitmapUnsupportedFormat.Create(aFormat);
8617
8618   w    := aRight  - aLeft;
8619   h    := aBottom - aTop;
8620   Size := FormatDesc.GetSize(w, h);
8621   GetMem(Temp, Size);
8622   try
8623     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8624     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8625     aDataObj.SetData(Temp, aFormat, w, h);
8626     aDataObj.FlipVert;
8627   except
8628     if Assigned(Temp) then
8629       FreeMem(Temp);
8630     raise;
8631   end;
8632 end;
8633
8634 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8636 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8638 procedure TglBitmapCubeMap.AfterConstruction;
8639 begin
8640   inherited;
8641
8642 {$IFNDEF OPENGL_ES}
8643   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8644     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8645 {$ELSE}
8646   if not (GL_VERSION_2_0) then
8647     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8648 {$ENDIF}
8649
8650   SetWrap;
8651   Target   := GL_TEXTURE_CUBE_MAP;
8652 {$IFNDEF OPENGL_ES}
8653   fGenMode := GL_REFLECTION_MAP;
8654 {$ENDIF}
8655 end;
8656
8657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8658 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8659 begin
8660   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8661 end;
8662
8663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8664 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8665 var
8666   {$IFNDEF OPENGL_ES}
8667   BuildWithGlu: Boolean;
8668   {$ENDIF}
8669   TexSize: Integer;
8670 begin
8671   if (aCheckSize) then begin
8672     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8673
8674     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8675       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8676
8677 {$IF NOT DEFINED(OPENGL_ES)}
8678     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8679       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8680 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8681     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8682       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8683 {$ELSE}
8684     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8685       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8686 {$IFEND}
8687   end;
8688
8689   if (fID = 0) then
8690     CreateID;
8691   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8692   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8693
8694   inherited UploadData(aDataObj, aCheckSize);
8695 end;
8696
8697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8698 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8699 begin
8700   inherited Bind (aEnableTextureUnit);
8701 {$IFNDEF OPENGL_ES}
8702   if aEnableTexCoordsGen then begin
8703     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8704     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8705     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8706     glEnable(GL_TEXTURE_GEN_S);
8707     glEnable(GL_TEXTURE_GEN_T);
8708     glEnable(GL_TEXTURE_GEN_R);
8709   end;
8710 {$ENDIF}
8711 end;
8712
8713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8714 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8715 begin
8716   inherited Unbind(aDisableTextureUnit);
8717 {$IFNDEF OPENGL_ES}
8718   if aDisableTexCoordsGen then begin
8719     glDisable(GL_TEXTURE_GEN_S);
8720     glDisable(GL_TEXTURE_GEN_T);
8721     glDisable(GL_TEXTURE_GEN_R);
8722   end;
8723 {$ENDIF}
8724 end;
8725 {$IFEND}
8726
8727 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8729 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8731 type
8732   TVec = Array[0..2] of Single;
8733   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8734
8735   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8736   TglBitmapNormalMapRec = record
8737     HalfSize : Integer;
8738     Func: TglBitmapNormalMapGetVectorFunc;
8739   end;
8740
8741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8742 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8743 begin
8744   aVec[0] := aHalfSize;
8745   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8746   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8747 end;
8748
8749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8750 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8751 begin
8752   aVec[0] := - aHalfSize;
8753   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8754   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8755 end;
8756
8757 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8758 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8759 begin
8760   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8761   aVec[1] := aHalfSize;
8762   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8763 end;
8764
8765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8766 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8767 begin
8768   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8769   aVec[1] := - aHalfSize;
8770   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8771 end;
8772
8773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8774 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8775 begin
8776   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8777   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8778   aVec[2] := aHalfSize;
8779 end;
8780
8781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8782 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8783 begin
8784   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8785   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8786   aVec[2] := - aHalfSize;
8787 end;
8788
8789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8790 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8791 var
8792   i: Integer;
8793   Vec: TVec;
8794   Len: Single;
8795 begin
8796   with FuncRec do begin
8797     with PglBitmapNormalMapRec(Args)^ do begin
8798       Func(Vec, Position, HalfSize);
8799
8800       // Normalize
8801       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8802       if Len <> 0 then begin
8803         Vec[0] := Vec[0] * Len;
8804         Vec[1] := Vec[1] * Len;
8805         Vec[2] := Vec[2] * Len;
8806       end;
8807
8808       // Scale Vector and AddVectro
8809       Vec[0] := Vec[0] * 0.5 + 0.5;
8810       Vec[1] := Vec[1] * 0.5 + 0.5;
8811       Vec[2] := Vec[2] * 0.5 + 0.5;
8812     end;
8813
8814     // Set Color
8815     for i := 0 to 2 do
8816       Dest.Data.arr[i] := Round(Vec[i] * 255);
8817   end;
8818 end;
8819
8820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8821 procedure TglBitmapNormalMap.AfterConstruction;
8822 begin
8823   inherited;
8824 {$IFNDEF OPENGL_ES}
8825   fGenMode := GL_NORMAL_MAP;
8826 {$ENDIF}
8827 end;
8828
8829 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8830 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8831 var
8832   Rec: TglBitmapNormalMapRec;
8833   SizeRec: TglBitmapSize;
8834   DataObj: TglBitmapData;
8835 begin
8836   Rec.HalfSize := aSize div 2;
8837
8838   SizeRec.Fields := [ffX, ffY];
8839   SizeRec.X := aSize;
8840   SizeRec.Y := aSize;
8841
8842   DataObj := TglBitmapData.Create;
8843   try
8844     // Positive X
8845     Rec.Func := glBitmapNormalMapPosX;
8846     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8847     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8848
8849     // Negative X
8850     Rec.Func := glBitmapNormalMapNegX;
8851     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8852     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8853
8854     // Positive Y
8855     Rec.Func := glBitmapNormalMapPosY;
8856     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8857     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8858
8859     // Negative Y
8860     Rec.Func := glBitmapNormalMapNegY;
8861     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8862     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8863
8864     // Positive Z
8865     Rec.Func := glBitmapNormalMapPosZ;
8866     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8867     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8868
8869     // Negative Z
8870     Rec.Func := glBitmapNormalMapNegZ;
8871     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8872     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8873   finally
8874     FreeAndNil(DataObj);
8875   end;
8876 end;
8877 {$IFEND}
8878
8879 initialization
8880   glBitmapSetDefaultFormat (tfEmpty);
8881   glBitmapSetDefaultMipmap (mmMipmap);
8882   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8883   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8884 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8885   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8886 {$IFEND}
8887
8888   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8889   glBitmapSetDefaultDeleteTextureOnFree    (true);
8890
8891   TFormatDescriptor.Init;
8892
8893 finalization
8894   TFormatDescriptor.Finalize;
8895
8896 end.