glBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 {$UNDEF GLB_LAZARUS}
 183
 184 interface
 185
 186 uses
 187   {$IFDEF OPENGL_ES}            dglOpenGLES,
 188   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 189
 190   {$IF DEFINED(GLB_WIN) AND
 191        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 192
 193   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 194   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 195   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 196
 197   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 198   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 199   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 200   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 201   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 202
 203   Classes, SysUtils;
 204
 205 type
 206 {$IFNDEF fpc}
 207   QWord   = System.UInt64;
 208   PQWord  = ^QWord;
 209
 210   PtrInt  = Longint;
 211   PtrUInt = DWord;
 212 {$ENDIF}
 213
 214
 215   { type that describes the format of the data stored in a texture.
 216     the name of formats is composed of the following constituents:
 217     - multiple channels:
 218        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 219        - width of the chanel in bit       (4, 8, 16, ...)
 220     - data type                           (e.g. ub, us, ui)
 221     - number of elements of data types }
 222   TglBitmapFormat = (
 223     tfEmpty = 0,
 224
 225     tfAlpha4ub1,                //< 1 x unsigned byte
 226     tfAlpha8ub1,                //< 1 x unsigned byte
 227     tfAlpha16us1,               //< 1 x unsigned short
 228
 229     tfLuminance4ub1,            //< 1 x unsigned byte
 230     tfLuminance8ub1,            //< 1 x unsigned byte
 231     tfLuminance16us1,           //< 1 x unsigned short
 232
 233     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 235     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 236     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 237     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 238
 239     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 240     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 241     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 242     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 243     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 244     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 245     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 246     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 247     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 248     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 249     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 250     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 251
 252     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 253     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 254     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 255     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 256     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 257     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 258     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 259     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 260     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 261     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 262
 263     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 264     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 265     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 266     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 267     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 268     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 269     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 270     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 271     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 272     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 273     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 274
 275     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 276     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 277     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 278     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 279     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 280     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 281     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 282     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 283     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 284     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 285
 286     tfDepth16us1,               //< 1 x unsigned short (depth)
 287     tfDepth24ui1,               //< 1 x unsigned int (depth)
 288     tfDepth32ui1,               //< 1 x unsigned int (depth)
 289
 290     tfS3tcDtx1RGBA,
 291     tfS3tcDtx3RGBA,
 292     tfS3tcDtx5RGBA
 293   );
 294
 295   { type to define suitable file formats }
 296   TglBitmapFileType = (
 297      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 298      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 299      ftDDS,                                             //< Direct Draw Surface file (DDS)
 300      ftTGA,                                             //< Targa Image File (TGA)
 301      ftBMP,                                             //< Windows Bitmap File (BMP)
 302      ftRAW);                                            //< glBitmap RAW file format
 303    TglBitmapFileTypes = set of TglBitmapFileType;
 304
 305   { possible mipmap types }
 306   TglBitmapMipMap = (
 307      mmNone,                //< no mipmaps
 308      mmMipmap,              //< normal mipmaps
 309      mmMipmapGlu);          //< mipmaps generated with glu functions
 310
 311   { possible normal map functions }
 312    TglBitmapNormalMapFunc = (
 313      nm4Samples,
 314      nmSobel,
 315      nm3x3,
 316      nm5x5);
 317
 318  ////////////////////////////////////////////////////////////////////////////////////////////////////
 319    EglBitmap                  = class(Exception);   //< glBitmap exception
 320    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 321    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 322    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 323    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 324    public
 325      constructor Create(const aFormat: TglBitmapFormat); overload;
 326      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 327    end;
 328
 329 ////////////////////////////////////////////////////////////////////////////////////////////////////
 330   { record that stores 4 unsigned integer values }
 331   TglBitmapRec4ui = packed record
 332   case Integer of
 333     0: (r, g, b, a: Cardinal);
 334     1: (arr: array[0..3] of Cardinal);
 335   end;
 336
 337   { record that stores 4 unsigned byte values }
 338   TglBitmapRec4ub = packed record
 339   case Integer of
 340     0: (r, g, b, a: Byte);
 341     1: (arr: array[0..3] of Byte);
 342   end;
 343
 344   { record that stores 4 unsigned long integer values }
 345   TglBitmapRec4ul = packed record
 346   case Integer of
 347     0: (r, g, b, a: QWord);
 348     1: (arr: array[0..3] of QWord);
 349   end;
 350
 351   { structure to store pixel data in }
 352   TglBitmapPixelData = packed record
 353     Data:   TglBitmapRec4ui;  //< color data for each color channel
 354     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 355     Format: TglBitmapFormat;  //< format of the pixel
 356   end;
 357   PglBitmapPixelData = ^TglBitmapPixelData;
 358
 359   TglBitmapSizeFields = set of (ffX, ffY);
 360   TglBitmapSize = packed record
 361     Fields: TglBitmapSizeFields;
 362     X: Word;
 363     Y: Word;
 364   end;
 365   TglBitmapPixelPosition = TglBitmapSize;
 366
 367   { describes the properties of a given texture data format }
 368   TglBitmapFormatDescriptor = class(TObject)
 369   private
 370     // cached properties
 371     fBytesPerPixel: Single;   //< number of bytes for each pixel
 372     fChannelCount: Integer;   //< number of color channels
 373     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 374     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 375
 376     { @return @true if the format has a red color channel, @false otherwise }
 377     function GetHasRed: Boolean;
 378
 379     { @return @true if the format has a green color channel, @false otherwise }
 380     function GetHasGreen: Boolean;
 381
 382     { @return @true if the format has a blue color channel, @false otherwise }
 383     function GetHasBlue: Boolean;
 384
 385     { @return @true if the format has a alpha color channel, @false otherwise }
 386     function GetHasAlpha: Boolean;
 387
 388     { @return @true if the format has any color color channel, @false otherwise }
 389     function GetHasColor: Boolean;
 390
 391     { @return @true if the format is a grayscale format, @false otherwise }
 392     function GetIsGrayscale: Boolean;
 393   protected
 394     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 395     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 396     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 397     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 398     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 399     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 400
 401     fBitsPerPixel: Integer;           //< number of bits per pixel
 402     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 403
 404     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 405     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 406
 407     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 408     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 409     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 410
 411     { set values for this format descriptor }
 412     procedure SetValues; virtual;
 413
 414     { calculate cached values }
 415     procedure CalcValues;
 416   public
 417     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 418     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 419     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 420     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 421     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 422
 423     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 424     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 425     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 426     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 427
 428     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 429     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 430     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 431     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 432     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 433
 434     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 435     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 436     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 437
 438     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 439     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 440     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 441     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 442     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 443     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 444
 445     function GetSize(const aSize: TglBitmapSize): Integer;     overload; virtual;
 446     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
 447
 448     { constructor }
 449     constructor Create;
 450   public
 451     { get the format descriptor by a given OpenGL internal format
 452         @param aInternalFormat  OpenGL internal format to get format descriptor for
 453         @returns                suitable format descriptor or tfEmpty-Descriptor }
 454     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 455   end;
 456
 457 ////////////////////////////////////////////////////////////////////////////////////////////////////
 458   TglBitmapData = class;
 459
 460   { structure to store data for converting in }
 461   TglBitmapFunctionRec = record
 462     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 463     Size:     TglBitmapSize;          //< size of the texture
 464     Position: TglBitmapPixelPosition; //< position of the currently pixel
 465     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 466     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 467     Args:     Pointer;                //< user defined args that was passed to the convert function
 468   end;
 469
 470   { callback to use for converting texture data }
 471   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 472
 473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 474   { class to store texture data in. used to load, save and
 475     manipulate data before assigned to texture object
 476     all operations on a data object can be done from a background thread }
 477   TglBitmapData = class
 478   private { fields }
 479
 480     fData: PByte;               //< texture data
 481     fDimension: TglBitmapSize;  //< pixel size of the data
 482     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 483     fFilename: String;          //< file the data was load from
 484
 485     fScanlines:    array of PByte;  //< pointer to begin of each line
 486     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 487
 488   private { getter / setter }
 489
 490     { @returns the format descriptor suitable to the texture data format }
 491     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 492
 493     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 494     function GetWidth: Integer;
 495
 496     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 497     function GetHeight: Integer;
 498
 499     { get scanline at index aIndex
 500         @returns Pointer to start of line or @nil }
 501     function GetScanlines(const aIndex: Integer): PByte;
 502
 503     { set new value for the data format. only possible if new format has the same pixel size.
 504       if you want to convert the texture data, see ConvertTo function }
 505     procedure SetFormat(const aValue: TglBitmapFormat);
 506
 507   private { internal misc }
 508
 509     { splits a resource identifier into the resource and it's type
 510         @param aResource  resource identifier to split and store name in
 511         @param aResType   type of the resource }
 512     procedure PrepareResType(var aResource: String; var aResType: PChar);
 513
 514     { updates scanlines array }
 515     procedure UpdateScanlines;
 516
 517   private { internal load and save }
 518 {$IFDEF GLB_SUPPORT_PNG_READ}
 519     { try to load a PNG from a stream
 520         @param aStream  stream to load PNG from
 521         @returns        @true on success, @false otherwise }
 522     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 523 {$ENDIF}
 524
 525 {$ifdef GLB_SUPPORT_PNG_WRITE}
 526     { save texture data as PNG to stream
 527         @param aStream stream to save data to}
 528     procedure SavePNG(const aStream: TStream); virtual;
 529 {$ENDIF}
 530
 531 {$IFDEF GLB_SUPPORT_JPEG_READ}
 532     { try to load a JPEG from a stream
 533         @param aStream  stream to load JPEG from
 534         @returns        @true on success, @false otherwise }
 535     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 536 {$ENDIF}
 537
 538 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 539     { save texture data as JPEG to stream
 540         @param aStream stream to save data to}
 541     procedure SaveJPEG(const aStream: TStream); virtual;
 542 {$ENDIF}
 543
 544     { try to load a RAW image from a stream
 545         @param aStream  stream to load RAW image from
 546         @returns        @true on success, @false otherwise }
 547     function LoadRAW(const aStream: TStream): Boolean;
 548
 549     { save texture data as RAW image to stream
 550         @param aStream stream to save data to}
 551     procedure SaveRAW(const aStream: TStream);
 552
 553     { try to load a BMP from a stream
 554         @param aStream  stream to load BMP from
 555         @returns        @true on success, @false otherwise }
 556     function LoadBMP(const aStream: TStream): Boolean;
 557
 558     { save texture data as BMP to stream
 559         @param aStream stream to save data to}
 560     procedure SaveBMP(const aStream: TStream);
 561
 562     { try to load a TGA from a stream
 563         @param aStream  stream to load TGA from
 564         @returns        @true on success, @false otherwise }
 565     function LoadTGA(const aStream: TStream): Boolean;
 566
 567     { save texture data as TGA to stream
 568         @param aStream stream to save data to}
 569     procedure SaveTGA(const aStream: TStream);
 570
 571     { try to load a DDS from a stream
 572         @param aStream  stream to load DDS from
 573         @returns        @true on success, @false otherwise }
 574     function LoadDDS(const aStream: TStream): Boolean;
 575
 576     { save texture data as DDS to stream
 577         @param aStream stream to save data to}
 578     procedure SaveDDS(const aStream: TStream);
 579
 580   public { properties }
 581     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 582     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 583     property Filename:  String          read fFilename;                 //< file the data was loaded from
 584     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 585     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 586     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 587     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 588
 589     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 590
 591   public { flip }
 592
 593     { flip texture horizontal
 594         @returns @true in success, @false otherwise }
 595     function FlipHorz: Boolean; virtual;
 596
 597     { flip texture vertical
 598         @returns @true in success, @false otherwise }
 599     function FlipVert: Boolean; virtual;
 600
 601   public { load }
 602
 603     { load a texture from a file
 604         @param aFilename file to load texuture from }
 605     procedure LoadFromFile(const aFilename: String);
 606
 607     { load a texture from a stream
 608         @param aStream  stream to load texture from }
 609     procedure LoadFromStream(const aStream: TStream); virtual;
 610
 611     { use a function to generate texture data
 612         @param aSize    size of the texture
 613         @param aFormat  format of the texture data
 614         @param aFunc    callback to use for generation
 615         @param aArgs    user defined paramaters (use at will) }
 616     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 617
 618     { load a texture from a resource
 619         @param aInstance  resource handle
 620         @param aResource  resource indentifier
 621         @param aResType   resource type (if known) }
 622     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 623
 624     { load a texture from a resource id
 625         @param aInstance  resource handle
 626         @param aResource  resource ID
 627         @param aResType   resource type }
 628     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 629
 630   public { save }
 631
 632     { save texture data to a file
 633         @param aFilename  filename to store texture in
 634         @param aFileType  file type to store data into }
 635     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 636
 637     { save texture data to a stream
 638         @param aFilename  filename to store texture in
 639         @param aFileType  file type to store data into }
 640     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 641
 642   public { convert }
 643
 644     { convert texture data using a user defined callback
 645         @param aFunc        callback to use for converting
 646         @param aCreateTemp  create a temporary buffer to use for converting
 647         @param aArgs        user defined paramters (use at will)
 648         @returns            @true if converting was successful, @false otherwise }
 649     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 650
 651     { convert texture data using a user defined callback
 652         @param aSource      glBitmap to read data from
 653         @param aFunc        callback to use for converting
 654         @param aCreateTemp  create a temporary buffer to use for converting
 655         @param aFormat      format of the new data
 656         @param aArgs        user defined paramters (use at will)
 657         @returns            @true if converting was successful, @false otherwise }
 658     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 659       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 660
 661     { convert texture data using a specific format
 662         @param aFormat  new format of texture data
 663         @returns        @true if converting was successful, @false otherwise }
 664     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 665
 666 {$IFDEF GLB_SDL}
 667   public { SDL }
 668
 669     { assign texture data to SDL surface
 670         @param aSurface SDL surface to write data to
 671         @returns        @true on success, @false otherwise }
 672     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 673
 674     { assign texture data from SDL surface
 675         @param aSurface SDL surface to read data from
 676         @returns        @true on success, @false otherwise }
 677     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 678
 679     { assign alpha channel data to SDL surface
 680         @param aSurface SDL surface to write alpha channel data to
 681         @returns        @true on success, @false otherwise }
 682     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 683
 684     { assign alpha channel data from SDL surface
 685         @param aSurface SDL surface to read data from
 686         @param aFunc    callback to use for converting
 687         @param aArgs    user defined parameters (use at will)
 688         @returns        @true on success, @false otherwise }
 689     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 690 {$ENDIF}
 691
 692 {$IFDEF GLB_DELPHI}
 693   public { Delphi }
 694
 695     { assign texture data to TBitmap object
 696         @param aBitmap  TBitmap to write data to
 697         @returns        @true on success, @false otherwise }
 698     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 699
 700     { assign texture data from TBitmap object
 701         @param aBitmap  TBitmap to read data from
 702         @returns        @true on success, @false otherwise }
 703     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 704
 705     { assign alpha channel data to TBitmap object
 706         @param aBitmap  TBitmap to write data to
 707         @returns        @true on success, @false otherwise }
 708     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 709
 710     { assign alpha channel data from TBitmap object
 711         @param aBitmap  TBitmap to read data from
 712         @param aFunc    callback to use for converting
 713         @param aArgs    user defined parameters (use at will)
 714         @returns        @true on success, @false otherwise }
 715     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 716 {$ENDIF}
 717
 718 {$IFDEF GLB_LAZARUS}
 719   public { Lazarus }
 720
 721     { assign texture data to TLazIntfImage object
 722         @param aImage   TLazIntfImage to write data to
 723         @returns        @true on success, @false otherwise }
 724     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 725
 726     { assign texture data from TLazIntfImage object
 727         @param aImage   TLazIntfImage to read data from
 728         @returns        @true on success, @false otherwise }
 729     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 730
 731     { assign alpha channel data to TLazIntfImage object
 732         @param aImage   TLazIntfImage to write data to
 733         @returns        @true on success, @false otherwise }
 734     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 735
 736     { assign alpha channel data from TLazIntfImage object
 737         @param aImage   TLazIntfImage to read data from
 738         @param aFunc    callback to use for converting
 739         @param aArgs    user defined parameters (use at will)
 740         @returns        @true on success, @false otherwise }
 741     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 742 {$ENDIF}
 743
 744   public { Alpha }
 745     { load alpha channel data from resource
 746         @param aInstance  resource handle
 747         @param aResource  resource ID
 748         @param aResType   resource type
 749         @param aFunc      callback to use for converting
 750         @param aArgs      user defined parameters (use at will)
 751         @returns          @true on success, @false otherwise }
 752     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 753
 754     { load alpha channel data from resource ID
 755         @param aInstance    resource handle
 756         @param aResourceID  resource ID
 757         @param aResType     resource type
 758         @param aFunc        callback to use for converting
 759         @param aArgs        user defined parameters (use at will)
 760         @returns            @true on success, @false otherwise }
 761     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 762
 763     { add alpha channel data from function
 764         @param aFunc  callback to get data from
 765         @param aArgs  user defined parameters (use at will)
 766         @returns      @true on success, @false otherwise }
 767     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 768
 769     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 770         @param aFilename  file to load alpha channel data from
 771         @param aFunc      callback to use for converting
 772         @param aArgs     SetFormat user defined parameters (use at will)
 773         @returns          @true on success, @false otherwise }
 774     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 775
 776     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 777         @param aStream  stream to load alpha channel data from
 778         @param aFunc    callback to use for converting
 779         @param aArgs    user defined parameters (use at will)
 780         @returns        @true on success, @false otherwise }
 781     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 782
 783     { add alpha channel data from existing glBitmap object
 784         @param aBitmap  TglBitmap to copy alpha channel data from
 785         @param aFunc    callback to use for converting
 786         @param aArgs    user defined parameters (use at will)
 787         @returns        @true on success, @false otherwise }
 788     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 789
 790     { add alpha to pixel if the pixels color is greter than the given color value
 791         @param aRed         red threshold (0-255)
 792         @param aGreen       green threshold (0-255)
 793         @param aBlue        blue threshold (0-255)
 794         @param aDeviatation accepted deviatation (0-255)
 795         @returns            @true on success, @false otherwise }
 796     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 797
 798     { add alpha to pixel if the pixels color is greter than the given color value
 799         @param aRed         red threshold (0-Range.r)
 800         @param aGreen       green threshold (0-Range.g)
 801         @param aBlue        blue threshold (0-Range.b)
 802         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 803         @returns            @true on success, @false otherwise }
 804     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 805
 806     { add alpha to pixel if the pixels color is greter than the given color value
 807         @param aRed         red threshold (0.0-1.0)
 808         @param aGreen       green threshold (0.0-1.0)
 809         @param aBlue        blue threshold (0.0-1.0)
 810         @param aDeviatation accepted deviatation (0.0-1.0)
 811         @returns            @true on success, @false otherwise }
 812     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 813
 814     { add a constand alpha value to all pixels
 815         @param aAlpha alpha value to add (0-255)
 816         @returns      @true on success, @false otherwise }
 817     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 818
 819     { add a constand alpha value to all pixels
 820         @param aAlpha alpha value to add (0-max(Range.rgb))
 821         @returns      @true on success, @false otherwise }
 822     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 823
 824     { add a constand alpha value to all pixels
 825         @param aAlpha alpha value to add (0.0-1.0)
 826         @returns      @true on success, @false otherwise }
 827     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 828
 829     { remove alpha channel
 830         @returns  @true on success, @false otherwise }
 831     function RemoveAlpha: Boolean; virtual;
 832
 833   public { fill }
 834     { fill complete texture with one color
 835         @param aRed   red color for border (0-255)
 836         @param aGreen green color for border (0-255)
 837         @param aBlue  blue color for border (0-255)
 838         @param aAlpha alpha color for border (0-255) }
 839     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 840
 841     { fill complete texture with one color
 842         @param aRed   red color for border (0-Range.r)
 843         @param aGreen green color for border (0-Range.g)
 844         @param aBlue  blue color for border (0-Range.b)
 845         @param aAlpha alpha color for border (0-Range.a) }
 846     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 847
 848     { fill complete texture with one color
 849         @param aRed   red color for border (0.0-1.0)
 850         @param aGreen green color for border (0.0-1.0)
 851         @param aBlue  blue color for border (0.0-1.0)
 852         @param aAlpha alpha color for border (0.0-1.0) }
 853     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 854
 855   public { Misc }
 856
 857     { set data pointer of texture data
 858         @param aData    pointer to new texture data
 859         @param aFormat  format of the data stored at aData
 860         @param aWidth   width of the texture data
 861         @param aHeight  height of the texture data }
 862     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 863       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 864
 865       { create a clone of the current object
 866         @returns clone of this object}
 867     function Clone: TglBitmapData;
 868
 869     { invert color data (bitwise not)
 870         @param aRed     invert red channel
 871         @param aGreen   invert green channel
 872         @param aBlue    invert blue channel
 873         @param aAlpha   invert alpha channel }
 874     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 875
 876     { create normal map from texture data
 877         @param aFunc      normal map function to generate normalmap with
 878         @param aScale     scale of the normale stored in the normal map
 879         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 880     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 881       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 882
 883   public { constructor }
 884
 885     { constructor - creates a texutre data object }
 886     constructor Create; overload;
 887
 888     { constructor - creates a texture data object and loads it from a file
 889         @param aFilename file to load texture from }
 890     constructor Create(const aFileName: String); overload;
 891
 892     { constructor - creates a texture data object and loads it from a stream
 893         @param aStream stream to load texture from }
 894     constructor Create(const aStream: TStream); overload;
 895
 896     { constructor - creates a texture data object with the given size, format and data
 897         @param aSize    size of the texture
 898         @param aFormat  format of the given data
 899         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 900     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 901
 902     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 903         @param aSize    size of the texture
 904         @param aFormat  format of the given data
 905         @param aFunc    callback to use for generating the data
 906         @param aArgs    user defined parameters (use at will) }
 907     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 908
 909     { constructor - creates a texture data object and loads it from a resource
 910         @param aInstance  resource handle
 911         @param aResource  resource indentifier
 912         @param aResType   resource type (if known) }
 913     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 914
 915     { constructor - creates a texture data object and loads it from a resource
 916         @param aInstance    resource handle
 917         @param aResourceID  resource ID
 918         @param aResType     resource type (if known) }
 919     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 920
 921     { destructor }
 922     destructor Destroy; override;
 923
 924   end;
 925
 926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 927   { base class for all glBitmap classes. used to manage OpenGL texture objects
 928     all operations on a bitmap object must be done from the render thread }
 929   TglBitmap = class
 930   protected
 931     fID: GLuint;                          //< name of the OpenGL texture object
 932     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 933     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 934
 935     // texture properties
 936     fFilterMin: GLenum;                   //< min filter to apply to the texture
 937     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 938     fWrapS: GLenum;                       //< texture wrapping for x axis
 939     fWrapT: GLenum;                       //< texture wrapping for y axis
 940     fWrapR: GLenum;                       //< texture wrapping for z axis
 941     fAnisotropic: Integer;                //< anisotropic level
 942     fBorderColor: array[0..3] of Single;  //< color of the texture border
 943
 944 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 945     //Swizzle
 946     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 947 {$IFEND}
 948 {$IFNDEF OPENGL_ES}
 949     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 950 {$ENDIF}
 951
 952     fDimension: TglBitmapSize;            //< size of this texture
 953     fMipMap: TglBitmapMipMap;             //< mipmap type
 954
 955     // CustomData
 956     fCustomData: Pointer;                 //< user defined data
 957     fCustomName: String;                  //< user defined name
 958     fCustomNameW: WideString;             //< user defined name
 959   protected
 960     { @returns the actual width of the texture }
 961     function GetWidth:  Integer; virtual;
 962
 963     { @returns the actual height of the texture }
 964     function GetHeight: Integer; virtual;
 965
 966   protected
 967     { set a new value for fCustomData }
 968     procedure SetCustomData(const aValue: Pointer);
 969
 970     { set a new value for fCustomName }
 971     procedure SetCustomName(const aValue: String);
 972
 973     { set a new value for fCustomNameW }
 974     procedure SetCustomNameW(const aValue: WideString);
 975
 976     { set new value for fDeleteTextureOnFree }
 977     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 978
 979     { set name of OpenGL texture object }
 980     procedure SetID(const aValue: Cardinal);
 981
 982     { set new value for fMipMap }
 983     procedure SetMipMap(const aValue: TglBitmapMipMap);
 984
 985     { set new value for target }
 986     procedure SetTarget(const aValue: Cardinal);
 987
 988     { set new value for fAnisotrophic }
 989     procedure SetAnisotropic(const aValue: Integer);
 990
 991   protected
 992     { create OpenGL texture object (delete exisiting object if exists) }
 993     procedure CreateID;
 994
 995     { setup texture parameters }
 996     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
 997
 998   protected
 999     property Width:  Integer read GetWidth;   //< the actual width of the texture
1000     property Height: Integer read GetHeight;  //< the actual height of the texture
1001
1002   public
1003     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1004     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1005     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1006
1007     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1008     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1009
1010     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1011     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1012     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1013
1014     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1015 {$IFNDEF OPENGL_ES}
1016     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1017 {$ENDIF}
1018
1019     { this method is called after the constructor and sets the default values of this object }
1020     procedure AfterConstruction; override;
1021
1022     { this method is called before the destructor and does some cleanup }
1023     procedure BeforeDestruction; override;
1024
1025   public
1026 {$IFNDEF OPENGL_ES}
1027     { set the new value for texture border color
1028         @param aRed   red color for border (0.0-1.0)
1029         @param aGreen green color for border (0.0-1.0)
1030         @param aBlue  blue color for border (0.0-1.0)
1031         @param aAlpha alpha color for border (0.0-1.0) }
1032     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1033 {$ENDIF}
1034
1035   public
1036     { set new texture filer
1037         @param aMin   min filter
1038         @param aMag   mag filter }
1039     procedure SetFilter(const aMin, aMag: GLenum);
1040
1041     { set new texture wrapping
1042         @param S  texture wrapping for x axis
1043         @param T  texture wrapping for y axis
1044         @param R  texture wrapping for z axis }
1045     procedure SetWrap(
1046       const S: GLenum = GL_CLAMP_TO_EDGE;
1047       const T: GLenum = GL_CLAMP_TO_EDGE;
1048       const R: GLenum = GL_CLAMP_TO_EDGE);
1049
1050 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1051     { set new swizzle
1052         @param r  swizzle for red channel
1053         @param g  swizzle for green channel
1054         @param b  swizzle for blue channel
1055         @param a  swizzle for alpha channel }
1056     procedure SetSwizzle(const r, g, b, a: GLenum);
1057 {$IFEND}
1058
1059   public
1060     { bind texture
1061         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1062     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1063
1064     { bind texture
1065         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1066     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1067
1068     { upload texture data from given data object to video card
1069         @param aData        texture data object that contains the actual data
1070         @param aCheckSize   check size before upload and throw exception if something is wrong }
1071     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1072
1073 {$IFNDEF OPENGL_ES}
1074     { download texture data from video card and store it into given data object
1075         @returns @true when download was successfull, @false otherwise }
1076     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1077 {$ENDIF}
1078   public
1079     { constructor - creates an empty texture }
1080     constructor Create; overload;
1081
1082     { constructor - creates an texture object and uploads the given data }
1083     constructor Create(const aData: TglBitmapData); overload;
1084
1085   end;
1086
1087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1088 {$IF NOT DEFINED(OPENGL_ES)}
1089   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1090     all operations on a bitmap object must be done from the render thread }
1091   TglBitmap1D = class(TglBitmap)
1092   protected
1093
1094     { upload the texture data to video card
1095         @param aDataObj       texture data object that contains the actual data
1096         @param aBuildWithGlu  use glu functions to build mipmaps }
1097     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1098
1099   public
1100     property Width; //< actual with of the texture
1101
1102     { this method is called after constructor and initializes the object }
1103     procedure AfterConstruction; override;
1104
1105     { upload texture data from given data object to video card
1106         @param aData        texture data object that contains the actual data
1107         @param aCheckSize   check size before upload and throw exception if something is wrong }
1108     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1109
1110   end;
1111 {$IFEND}
1112
1113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1114   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1115     all operations on a bitmap object must be done from the render thread }
1116   TglBitmap2D = class(TglBitmap)
1117   protected
1118
1119     { upload the texture data to video card
1120         @param aDataObj       texture data object that contains the actual data
1121         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1122         @param aBuildWithGlu  use glu functions to build mipmaps }
1123     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1124       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1125
1126   public
1127     property Width;   //< actual width of the texture
1128     property Height;  //< actual height of the texture
1129
1130     { this method is called after constructor and initializes the object }
1131     procedure AfterConstruction; override;
1132
1133     { upload texture data from given data object to video card
1134         @param aData        texture data object that contains the actual data
1135         @param aCheckSize   check size before upload and throw exception if something is wrong }
1136     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1137
1138   public
1139
1140     { copy a part of the frame buffer to the texture
1141         @param aTop     topmost pixel to copy
1142         @param aLeft    leftmost pixel to copy
1143         @param aRight   rightmost pixel to copy
1144         @param aBottom  bottommost pixel to copy
1145         @param aFormat  format to store data in
1146         @param aDataObj texture data object to store the data in }
1147     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1148
1149   end;
1150
1151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1152 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1153   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1154     all operations on a bitmap object must be done from the render thread }
1155   TglBitmapCubeMap = class(TglBitmap2D)
1156   protected
1157   {$IFNDEF OPENGL_ES}
1158     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1159   {$ENDIF}
1160
1161   public
1162     { this method is called after constructor and initializes the object }
1163     procedure AfterConstruction; override;
1164
1165     { upload texture data from given data object to video card
1166         @param aData        texture data object that contains the actual data
1167         @param aCheckSize   check size before upload and throw exception if something is wrong }
1168     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1169
1170     { upload texture data from given data object to video card
1171         @param aData        texture data object that contains the actual data
1172         @param aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1173         @param aCheckSize   check size before upload and throw exception if something is wrong }
1174     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1175
1176     { bind texture
1177         @param aEnableTexCoordsGen  enable cube map generator
1178         @param aEnableTextureUnit   enable texture unit }
1179     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1180
1181     { unbind texture
1182         @param aDisableTexCoordsGen   disable cube map generator
1183         @param aDisableTextureUnit    disable texture unit }
1184     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1185   end;
1186 {$IFEND}
1187
1188 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1190   { wrapper class for cube normal maps
1191     all operations on a bitmap object must be done from the render thread }
1192   TglBitmapNormalMap = class(TglBitmapCubeMap)
1193   public
1194     { this method is called after constructor and initializes the object }
1195     procedure AfterConstruction; override;
1196
1197     { create cube normal map from texture data and upload it to video card
1198         @param aSize        size of each cube map texture
1199         @param aCheckSize   check size before upload and throw exception if something is wrong }
1200     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1201   end;
1202 {$IFEND}
1203
1204 const
1205   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1206
1207 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1208 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1209 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1210 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1211 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1212 procedure glBitmapSetDefaultWrap(
1213   const S: Cardinal = GL_CLAMP_TO_EDGE;
1214   const T: Cardinal = GL_CLAMP_TO_EDGE;
1215   const R: Cardinal = GL_CLAMP_TO_EDGE);
1216
1217 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1218 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1219 {$IFEND}
1220
1221 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1222 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1223 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1224 function glBitmapGetDefaultFormat: TglBitmapFormat;
1225 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1226 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1227 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1228 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1229 {$IFEND}
1230
1231 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1232 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1233 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1234 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1235 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1236 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1237 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1238
1239 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1240
1241 {$IFDEF GLB_DELPHI}
1242 function CreateGrayPalette: HPALETTE;
1243 {$ENDIF}
1244
1245 implementation
1246
1247 uses
1248   Math, syncobjs, typinfo
1249   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1250
1251
1252 var
1253   glBitmapDefaultDeleteTextureOnFree: Boolean;
1254   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1255   glBitmapDefaultFormat: TglBitmapFormat;
1256   glBitmapDefaultMipmap: TglBitmapMipMap;
1257   glBitmapDefaultFilterMin: Cardinal;
1258   glBitmapDefaultFilterMag: Cardinal;
1259   glBitmapDefaultWrapS: Cardinal;
1260   glBitmapDefaultWrapT: Cardinal;
1261   glBitmapDefaultWrapR: Cardinal;
1262   glDefaultSwizzle: array[0..3] of GLenum;
1263
1264 ////////////////////////////////////////////////////////////////////////////////////////////////////
1265 type
1266   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1267   public
1268     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1269     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1270
1271     function CreateMappingData: Pointer; virtual;
1272     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1273
1274     function IsEmpty: Boolean; virtual;
1275     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1276
1277     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1278
1279     constructor Create; virtual;
1280   public
1281     class procedure Init;
1282     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1283     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1284     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1285     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1286     class procedure Clear;
1287     class procedure Finalize;
1288   end;
1289   TFormatDescriptorClass = class of TFormatDescriptor;
1290
1291   TfdEmpty = class(TFormatDescriptor);
1292
1293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1294   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1295     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1296     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1297   end;
1298
1299   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1300     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1301     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1302   end;
1303
1304   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1305     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1306     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1307   end;
1308
1309   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* 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   TfdRGBub3 = class(TFormatDescriptor) //3* 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   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
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   TfdRGBAub4 = class(TfdRGBub3) //3* 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   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1335   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1336     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1337     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1338   end;
1339
1340   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1341     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1342     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1343   end;
1344
1345   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1346     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1347     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1348   end;
1349
1350   TfdDepthUS1 = 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   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* 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   TfdRGBus3 = class(TFormatDescriptor) //3* 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   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
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   TfdRGBAus4 = class(TfdRGBus3) //4* 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   TfdARGBus4 = class(TfdRGBus3) //4* 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   TfdBGRAus4 = class(TfdBGRus3) //4* 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   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1391   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394   end;
1395
1396   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1397     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1398     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1399   end;
1400
1401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1402   TfdAlpha4ub1 = class(TfdAlphaUB1)
1403     procedure SetValues; override;
1404   end;
1405
1406   TfdAlpha8ub1 = class(TfdAlphaUB1)
1407     procedure SetValues; override;
1408   end;
1409
1410   TfdAlpha16us1 = class(TfdAlphaUS1)
1411     procedure SetValues; override;
1412   end;
1413
1414   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1415     procedure SetValues; override;
1416   end;
1417
1418   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1419     procedure SetValues; override;
1420   end;
1421
1422   TfdLuminance16us1 = class(TfdLuminanceUS1)
1423     procedure SetValues; override;
1424   end;
1425
1426   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1427     procedure SetValues; override;
1428   end;
1429
1430   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1431     procedure SetValues; override;
1432   end;
1433
1434   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1435     procedure SetValues; override;
1436   end;
1437
1438   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1439     procedure SetValues; override;
1440   end;
1441
1442   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1443     procedure SetValues; override;
1444   end;
1445
1446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1447   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1448     procedure SetValues; override;
1449   end;
1450
1451   TfdRGBX4us1 = class(TfdUniversalUS1)
1452     procedure SetValues; override;
1453   end;
1454
1455   TfdXRGB4us1 = class(TfdUniversalUS1)
1456     procedure SetValues; override;
1457   end;
1458
1459   TfdR5G6B5us1 = class(TfdUniversalUS1)
1460     procedure SetValues; override;
1461   end;
1462
1463   TfdRGB5X1us1 = class(TfdUniversalUS1)
1464     procedure SetValues; override;
1465   end;
1466
1467   TfdX1RGB5us1 = class(TfdUniversalUS1)
1468     procedure SetValues; override;
1469   end;
1470
1471   TfdRGB8ub3 = class(TfdRGBub3)
1472     procedure SetValues; override;
1473   end;
1474
1475   TfdRGBX8ui1 = class(TfdUniversalUI1)
1476     procedure SetValues; override;
1477   end;
1478
1479   TfdXRGB8ui1 = class(TfdUniversalUI1)
1480     procedure SetValues; override;
1481   end;
1482
1483   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1484     procedure SetValues; override;
1485   end;
1486
1487   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1488     procedure SetValues; override;
1489   end;
1490
1491   TfdRGB16us3 = class(TfdRGBus3)
1492     procedure SetValues; override;
1493   end;
1494
1495   TfdRGBA4us1 = class(TfdUniversalUS1)
1496     procedure SetValues; override;
1497   end;
1498
1499   TfdARGB4us1 = class(TfdUniversalUS1)
1500     procedure SetValues; override;
1501   end;
1502
1503   TfdRGB5A1us1 = class(TfdUniversalUS1)
1504     procedure SetValues; override;
1505   end;
1506
1507   TfdA1RGB5us1 = class(TfdUniversalUS1)
1508     procedure SetValues; override;
1509   end;
1510
1511   TfdRGBA8ui1 = class(TfdUniversalUI1)
1512     procedure SetValues; override;
1513   end;
1514
1515   TfdARGB8ui1 = class(TfdUniversalUI1)
1516     procedure SetValues; override;
1517   end;
1518
1519   TfdRGBA8ub4 = class(TfdRGBAub4)
1520     procedure SetValues; override;
1521   end;
1522
1523   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1524     procedure SetValues; override;
1525   end;
1526
1527   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1528     procedure SetValues; override;
1529   end;
1530
1531   TfdRGBA16us4 = class(TfdRGBAus4)
1532     procedure SetValues; override;
1533   end;
1534
1535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1536   TfdBGRX4us1 = class(TfdUniversalUS1)
1537     procedure SetValues; override;
1538   end;
1539
1540   TfdXBGR4us1 = class(TfdUniversalUS1)
1541     procedure SetValues; override;
1542   end;
1543
1544   TfdB5G6R5us1 = class(TfdUniversalUS1)
1545     procedure SetValues; override;
1546   end;
1547
1548   TfdBGR5X1us1 = class(TfdUniversalUS1)
1549     procedure SetValues; override;
1550   end;
1551
1552   TfdX1BGR5us1 = class(TfdUniversalUS1)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdBGR8ub3 = class(TfdBGRub3)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdBGRX8ui1 = class(TfdUniversalUI1)
1561     procedure SetValues; override;
1562   end;
1563
1564   TfdXBGR8ui1 = class(TfdUniversalUI1)
1565     procedure SetValues; override;
1566   end;
1567
1568   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1569     procedure SetValues; override;
1570   end;
1571
1572   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1573     procedure SetValues; override;
1574   end;
1575
1576   TfdBGR16us3 = class(TfdBGRus3)
1577     procedure SetValues; override;
1578   end;
1579
1580   TfdBGRA4us1 = class(TfdUniversalUS1)
1581     procedure SetValues; override;
1582   end;
1583
1584   TfdABGR4us1 = class(TfdUniversalUS1)
1585     procedure SetValues; override;
1586   end;
1587
1588   TfdBGR5A1us1 = class(TfdUniversalUS1)
1589     procedure SetValues; override;
1590   end;
1591
1592   TfdA1BGR5us1 = class(TfdUniversalUS1)
1593     procedure SetValues; override;
1594   end;
1595
1596   TfdBGRA8ui1 = class(TfdUniversalUI1)
1597     procedure SetValues; override;
1598   end;
1599
1600   TfdABGR8ui1 = class(TfdUniversalUI1)
1601     procedure SetValues; override;
1602   end;
1603
1604   TfdBGRA8ub4 = class(TfdBGRAub4)
1605     procedure SetValues; override;
1606   end;
1607
1608   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1609     procedure SetValues; override;
1610   end;
1611
1612   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1613     procedure SetValues; override;
1614   end;
1615
1616   TfdBGRA16us4 = class(TfdBGRAus4)
1617     procedure SetValues; override;
1618   end;
1619
1620   TfdDepth16us1 = class(TfdDepthUS1)
1621     procedure SetValues; override;
1622   end;
1623
1624   TfdDepth24ui1 = class(TfdDepthUI1)
1625     procedure SetValues; override;
1626   end;
1627
1628   TfdDepth32ui1 = class(TfdDepthUI1)
1629     procedure SetValues; override;
1630   end;
1631
1632   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1633     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1634     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1635     procedure SetValues; override;
1636   end;
1637
1638   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1639     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1640     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1641     procedure SetValues; override;
1642   end;
1643
1644   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1645     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1646     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1647     procedure SetValues; override;
1648   end;
1649
1650 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1651   TbmpBitfieldFormat = class(TFormatDescriptor)
1652   public
1653     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1654     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1655     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1656     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1657   end;
1658
1659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1660   TbmpColorTableEnty = packed record
1661     b, g, r, a: Byte;
1662   end;
1663   TbmpColorTable = array of TbmpColorTableEnty;
1664   TbmpColorTableFormat = class(TFormatDescriptor)
1665   private
1666     fColorTable: TbmpColorTable;
1667   protected
1668     procedure SetValues; override;
1669   public
1670     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1671
1672     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1673     procedure CalcValues;
1674     procedure CreateColorTable;
1675
1676     function CreateMappingData: Pointer; override;
1677     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1678     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1679     destructor Destroy; override;
1680   end;
1681
1682 const
1683   LUMINANCE_WEIGHT_R = 0.30;
1684   LUMINANCE_WEIGHT_G = 0.59;
1685   LUMINANCE_WEIGHT_B = 0.11;
1686
1687   ALPHA_WEIGHT_R = 0.30;
1688   ALPHA_WEIGHT_G = 0.59;
1689   ALPHA_WEIGHT_B = 0.11;
1690
1691   DEPTH_WEIGHT_R = 0.333333333;
1692   DEPTH_WEIGHT_G = 0.333333333;
1693   DEPTH_WEIGHT_B = 0.333333333;
1694
1695   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1696     TfdEmpty,
1697
1698     TfdAlpha4ub1,
1699     TfdAlpha8ub1,
1700     TfdAlpha16us1,
1701
1702     TfdLuminance4ub1,
1703     TfdLuminance8ub1,
1704     TfdLuminance16us1,
1705
1706     TfdLuminance4Alpha4ub2,
1707     TfdLuminance6Alpha2ub2,
1708     TfdLuminance8Alpha8ub2,
1709     TfdLuminance12Alpha4us2,
1710     TfdLuminance16Alpha16us2,
1711
1712     TfdR3G3B2ub1,
1713     TfdRGBX4us1,
1714     TfdXRGB4us1,
1715     TfdR5G6B5us1,
1716     TfdRGB5X1us1,
1717     TfdX1RGB5us1,
1718     TfdRGB8ub3,
1719     TfdRGBX8ui1,
1720     TfdXRGB8ui1,
1721     TfdRGB10X2ui1,
1722     TfdX2RGB10ui1,
1723     TfdRGB16us3,
1724
1725     TfdRGBA4us1,
1726     TfdARGB4us1,
1727     TfdRGB5A1us1,
1728     TfdA1RGB5us1,
1729     TfdRGBA8ui1,
1730     TfdARGB8ui1,
1731     TfdRGBA8ub4,
1732     TfdRGB10A2ui1,
1733     TfdA2RGB10ui1,
1734     TfdRGBA16us4,
1735
1736     TfdBGRX4us1,
1737     TfdXBGR4us1,
1738     TfdB5G6R5us1,
1739     TfdBGR5X1us1,
1740     TfdX1BGR5us1,
1741     TfdBGR8ub3,
1742     TfdBGRX8ui1,
1743     TfdXBGR8ui1,
1744     TfdBGR10X2ui1,
1745     TfdX2BGR10ui1,
1746     TfdBGR16us3,
1747
1748     TfdBGRA4us1,
1749     TfdABGR4us1,
1750     TfdBGR5A1us1,
1751     TfdA1BGR5us1,
1752     TfdBGRA8ui1,
1753     TfdABGR8ui1,
1754     TfdBGRA8ub4,
1755     TfdBGR10A2ui1,
1756     TfdA2BGR10ui1,
1757     TfdBGRA16us4,
1758
1759     TfdDepth16us1,
1760     TfdDepth24ui1,
1761     TfdDepth32ui1,
1762
1763     TfdS3tcDtx1RGBA,
1764     TfdS3tcDtx3RGBA,
1765     TfdS3tcDtx5RGBA
1766   );
1767
1768 var
1769   FormatDescriptorCS: TCriticalSection;
1770   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1771
1772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1773 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1774 begin
1775   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1776 end;
1777
1778 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1779 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1780 begin
1781   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1782 end;
1783
1784 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1786 begin
1787   result.Fields := [];
1788   if (X >= 0) then
1789     result.Fields := result.Fields + [ffX];
1790   if (Y >= 0) then
1791     result.Fields := result.Fields + [ffY];
1792   result.X := Max(0, X);
1793   result.Y := Max(0, Y);
1794 end;
1795
1796 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1797 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1798 begin
1799   result := glBitmapSize(X, Y);
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1804 begin
1805   result.r := r;
1806   result.g := g;
1807   result.b := b;
1808   result.a := a;
1809 end;
1810
1811 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1812 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1813 begin
1814   result.r := r;
1815   result.g := g;
1816   result.b := b;
1817   result.a := a;
1818 end;
1819
1820 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1821 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1822 begin
1823   result.r := r;
1824   result.g := g;
1825   result.b := b;
1826   result.a := a;
1827 end;
1828
1829 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1830 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1831 var
1832   i: Integer;
1833 begin
1834   result := false;
1835   for i := 0 to high(r1.arr) do
1836     if (r1.arr[i] <> r2.arr[i]) then
1837       exit;
1838   result := true;
1839 end;
1840
1841 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1842 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1843 var
1844   i: Integer;
1845 begin
1846   result := false;
1847   for i := 0 to high(r1.arr) do
1848     if (r1.arr[i] <> r2.arr[i]) then
1849       exit;
1850   result := true;
1851 end;
1852
1853 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1854 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1855 var
1856   desc: TFormatDescriptor;
1857   p, tmp: PByte;
1858   x, y, i: Integer;
1859   md: Pointer;
1860   px: TglBitmapPixelData;
1861 begin
1862   result := nil;
1863   desc := TFormatDescriptor.Get(aFormat);
1864   if (desc.IsCompressed) or (desc.glFormat = 0) then
1865     exit;
1866
1867   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1868   md := desc.CreateMappingData;
1869   try
1870     tmp := p;
1871     desc.PreparePixel(px);
1872     for y := 0 to 4 do
1873       for x := 0 to 4 do begin
1874         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1875         for i := 0 to 3 do begin
1876           if ((y < 3) and (y = i)) or
1877              ((y = 3) and (i < 3)) or
1878              ((y = 4) and (i = 3))
1879           then
1880             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1881           else if ((y < 4) and (i = 3)) or
1882                   ((y = 4) and (i < 3))
1883           then
1884             px.Data.arr[i] := px.Range.arr[i]
1885           else
1886             px.Data.arr[i] := 0; //px.Range.arr[i];
1887         end;
1888         desc.Map(px, tmp, md);
1889       end;
1890   finally
1891     desc.FreeMappingData(md);
1892   end;
1893
1894   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1895 end;
1896
1897 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1898 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1899 begin
1900   result.r := r;
1901   result.g := g;
1902   result.b := b;
1903   result.a := a;
1904 end;
1905
1906 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1907 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1908 begin
1909   result := [];
1910
1911   if (aFormat in [
1912         //8bpp
1913         tfAlpha4ub1, tfAlpha8ub1,
1914         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1915
1916         //16bpp
1917         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1918         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1919         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1920
1921         //24bpp
1922         tfBGR8ub3, tfRGB8ub3,
1923
1924         //32bpp
1925         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1926         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1927   then
1928     result := result + [ ftBMP ];
1929
1930   if (aFormat in [
1931         //8bbp
1932         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1933
1934         //16bbp
1935         tfAlpha16us1, tfLuminance16us1,
1936         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1937         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1938
1939         //24bbp
1940         tfBGR8ub3,
1941
1942         //32bbp
1943         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1944         tfDepth24ui1, tfDepth32ui1])
1945   then
1946     result := result + [ftTGA];
1947
1948   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1949     result := result + [ftDDS];
1950
1951 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1952   if aFormat in [
1953       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1954       tfRGB8ub3, tfRGBA8ui1,
1955       tfBGR8ub3, tfBGRA8ui1] then
1956     result := result + [ftPNG];
1957 {$ENDIF}
1958
1959 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1960   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1961     result := result + [ftJPEG];
1962 {$ENDIF}
1963 end;
1964
1965 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1966 function IsPowerOfTwo(aNumber: Integer): Boolean;
1967 begin
1968   while (aNumber and 1) = 0 do
1969     aNumber := aNumber shr 1;
1970   result := aNumber = 1;
1971 end;
1972
1973 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1974 function GetTopMostBit(aBitSet: QWord): Integer;
1975 begin
1976   result := 0;
1977   while aBitSet > 0 do begin
1978     inc(result);
1979     aBitSet := aBitSet shr 1;
1980   end;
1981 end;
1982
1983 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1984 function CountSetBits(aBitSet: QWord): Integer;
1985 begin
1986   result := 0;
1987   while aBitSet > 0 do begin
1988     if (aBitSet and 1) = 1 then
1989       inc(result);
1990     aBitSet := aBitSet shr 1;
1991   end;
1992 end;
1993
1994 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1995 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1996 begin
1997   result := Trunc(
1998     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1999     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2000     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2001 end;
2002
2003 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2004 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2005 begin
2006   result := Trunc(
2007     DEPTH_WEIGHT_R * aPixel.Data.r +
2008     DEPTH_WEIGHT_G * aPixel.Data.g +
2009     DEPTH_WEIGHT_B * aPixel.Data.b);
2010 end;
2011
2012 {$IFDEF GLB_SDL_IMAGE}
2013 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2014 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2015 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2016 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2017 begin
2018   result := TStream(context^.unknown.data1).Seek(offset, whence);
2019 end;
2020
2021 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2022 begin
2023   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2024 end;
2025
2026 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2027 begin
2028   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2029 end;
2030
2031 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2032 begin
2033   result := 0;
2034 end;
2035
2036 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2037 begin
2038   result := SDL_AllocRW;
2039
2040   if result = nil then
2041     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2042
2043   result^.seek := glBitmapRWseek;
2044   result^.read := glBitmapRWread;
2045   result^.write := glBitmapRWwrite;
2046   result^.close := glBitmapRWclose;
2047   result^.unknown.data1 := Stream;
2048 end;
2049 {$ENDIF}
2050
2051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2052 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2053 begin
2054   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2055 end;
2056
2057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2058 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2059 begin
2060   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2061 end;
2062
2063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2064 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2065 begin
2066   glBitmapDefaultMipmap := aValue;
2067 end;
2068
2069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2070 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2071 begin
2072   glBitmapDefaultFormat := aFormat;
2073 end;
2074
2075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2076 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2077 begin
2078   glBitmapDefaultFilterMin := aMin;
2079   glBitmapDefaultFilterMag := aMag;
2080 end;
2081
2082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2083 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2084 begin
2085   glBitmapDefaultWrapS := S;
2086   glBitmapDefaultWrapT := T;
2087   glBitmapDefaultWrapR := R;
2088 end;
2089
2090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2091 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2092 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2093 begin
2094   glDefaultSwizzle[0] := r;
2095   glDefaultSwizzle[1] := g;
2096   glDefaultSwizzle[2] := b;
2097   glDefaultSwizzle[3] := a;
2098 end;
2099 {$IFEND}
2100
2101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2102 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2103 begin
2104   result := glBitmapDefaultDeleteTextureOnFree;
2105 end;
2106
2107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2108 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2109 begin
2110   result := glBitmapDefaultFreeDataAfterGenTextures;
2111 end;
2112
2113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2114 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2115 begin
2116   result := glBitmapDefaultMipmap;
2117 end;
2118
2119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 function glBitmapGetDefaultFormat: TglBitmapFormat;
2121 begin
2122   result := glBitmapDefaultFormat;
2123 end;
2124
2125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2126 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2127 begin
2128   aMin := glBitmapDefaultFilterMin;
2129   aMag := glBitmapDefaultFilterMag;
2130 end;
2131
2132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2133 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2134 begin
2135   S := glBitmapDefaultWrapS;
2136   T := glBitmapDefaultWrapT;
2137   R := glBitmapDefaultWrapR;
2138 end;
2139
2140 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2142 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2143 begin
2144   r := glDefaultSwizzle[0];
2145   g := glDefaultSwizzle[1];
2146   b := glDefaultSwizzle[2];
2147   a := glDefaultSwizzle[3];
2148 end;
2149 {$IFEND}
2150
2151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2152 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2154 function TFormatDescriptor.CreateMappingData: Pointer;
2155 begin
2156   result := nil;
2157 end;
2158
2159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2160 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2161 begin
2162   //DUMMY
2163 end;
2164
2165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2166 function TFormatDescriptor.IsEmpty: Boolean;
2167 begin
2168   result := (fFormat = tfEmpty);
2169 end;
2170
2171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2173 var
2174   i: Integer;
2175   m: TglBitmapRec4ul;
2176 begin
2177   result := false;
2178   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2179     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2180   m := Mask;
2181   for i := 0 to 3 do
2182     if (aMask.arr[i] <> m.arr[i]) then
2183       exit;
2184   result := true;
2185 end;
2186
2187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2189 begin
2190   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2191   aPixel.Data   := Range;
2192   aPixel.Format := fFormat;
2193   aPixel.Range  := Range;
2194 end;
2195
2196 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2197 constructor TFormatDescriptor.Create;
2198 begin
2199   inherited Create;
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2205 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2206 begin
2207   aData^ := aPixel.Data.a;
2208   inc(aData);
2209 end;
2210
2211 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2212 begin
2213   aPixel.Data.r := 0;
2214   aPixel.Data.g := 0;
2215   aPixel.Data.b := 0;
2216   aPixel.Data.a := aData^;
2217   inc(aData);
2218 end;
2219
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2222 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2223 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2224 begin
2225   aData^ := LuminanceWeight(aPixel);
2226   inc(aData);
2227 end;
2228
2229 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2230 begin
2231   aPixel.Data.r := aData^;
2232   aPixel.Data.g := aData^;
2233   aPixel.Data.b := aData^;
2234   aPixel.Data.a := 0;
2235   inc(aData);
2236 end;
2237
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2242 var
2243   i: Integer;
2244 begin
2245   aData^ := 0;
2246   for i := 0 to 3 do
2247     if (Range.arr[i] > 0) then
2248       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2249   inc(aData);
2250 end;
2251
2252 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2253 var
2254   i: Integer;
2255 begin
2256   for i := 0 to 3 do
2257     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2258   inc(aData);
2259 end;
2260
2261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2262 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2264 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2265 begin
2266   inherited Map(aPixel, aData, aMapData);
2267   aData^ := aPixel.Data.a;
2268   inc(aData);
2269 end;
2270
2271 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2272 begin
2273   inherited Unmap(aData, aPixel, aMapData);
2274   aPixel.Data.a := aData^;
2275   inc(aData);
2276 end;
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2281 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2282 begin
2283   aData^ := aPixel.Data.r;
2284   inc(aData);
2285   aData^ := aPixel.Data.g;
2286   inc(aData);
2287   aData^ := aPixel.Data.b;
2288   inc(aData);
2289 end;
2290
2291 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2292 begin
2293   aPixel.Data.r := aData^;
2294   inc(aData);
2295   aPixel.Data.g := aData^;
2296   inc(aData);
2297   aPixel.Data.b := aData^;
2298   inc(aData);
2299   aPixel.Data.a := 0;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2305 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2306 begin
2307   aData^ := aPixel.Data.b;
2308   inc(aData);
2309   aData^ := aPixel.Data.g;
2310   inc(aData);
2311   aData^ := aPixel.Data.r;
2312   inc(aData);
2313 end;
2314
2315 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2316 begin
2317   aPixel.Data.b := aData^;
2318   inc(aData);
2319   aPixel.Data.g := aData^;
2320   inc(aData);
2321   aPixel.Data.r := aData^;
2322   inc(aData);
2323   aPixel.Data.a := 0;
2324 end;
2325
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2330 begin
2331   inherited Map(aPixel, aData, aMapData);
2332   aData^ := aPixel.Data.a;
2333   inc(aData);
2334 end;
2335
2336 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2337 begin
2338   inherited Unmap(aData, aPixel, aMapData);
2339   aPixel.Data.a := aData^;
2340   inc(aData);
2341 end;
2342
2343 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2344 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2346 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2347 begin
2348   inherited Map(aPixel, aData, aMapData);
2349   aData^ := aPixel.Data.a;
2350   inc(aData);
2351 end;
2352
2353 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2354 begin
2355   inherited Unmap(aData, aPixel, aMapData);
2356   aPixel.Data.a := aData^;
2357   inc(aData);
2358 end;
2359
2360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2361 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2363 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2364 begin
2365   PWord(aData)^ := aPixel.Data.a;
2366   inc(aData, 2);
2367 end;
2368
2369 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2370 begin
2371   aPixel.Data.r := 0;
2372   aPixel.Data.g := 0;
2373   aPixel.Data.b := 0;
2374   aPixel.Data.a := PWord(aData)^;
2375   inc(aData, 2);
2376 end;
2377
2378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2379 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2381 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2382 begin
2383   PWord(aData)^ := LuminanceWeight(aPixel);
2384   inc(aData, 2);
2385 end;
2386
2387 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2388 begin
2389   aPixel.Data.r := PWord(aData)^;
2390   aPixel.Data.g := PWord(aData)^;
2391   aPixel.Data.b := PWord(aData)^;
2392   aPixel.Data.a := 0;
2393   inc(aData, 2);
2394 end;
2395
2396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2397 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2399 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2400 var
2401   i: Integer;
2402 begin
2403   PWord(aData)^ := 0;
2404   for i := 0 to 3 do
2405     if (Range.arr[i] > 0) then
2406       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2407   inc(aData, 2);
2408 end;
2409
2410 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2411 var
2412   i: Integer;
2413 begin
2414   for i := 0 to 3 do
2415     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2416   inc(aData, 2);
2417 end;
2418
2419 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2420 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2422 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2423 begin
2424   PWord(aData)^ := DepthWeight(aPixel);
2425   inc(aData, 2);
2426 end;
2427
2428 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2429 begin
2430   aPixel.Data.r := PWord(aData)^;
2431   aPixel.Data.g := PWord(aData)^;
2432   aPixel.Data.b := PWord(aData)^;
2433   aPixel.Data.a := PWord(aData)^;;
2434   inc(aData, 2);
2435 end;
2436
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2441 begin
2442   inherited Map(aPixel, aData, aMapData);
2443   PWord(aData)^ := aPixel.Data.a;
2444   inc(aData, 2);
2445 end;
2446
2447 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2448 begin
2449   inherited Unmap(aData, aPixel, aMapData);
2450   aPixel.Data.a := PWord(aData)^;
2451   inc(aData, 2);
2452 end;
2453
2454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2457 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2458 begin
2459   PWord(aData)^ := aPixel.Data.r;
2460   inc(aData, 2);
2461   PWord(aData)^ := aPixel.Data.g;
2462   inc(aData, 2);
2463   PWord(aData)^ := aPixel.Data.b;
2464   inc(aData, 2);
2465 end;
2466
2467 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2468 begin
2469   aPixel.Data.r := PWord(aData)^;
2470   inc(aData, 2);
2471   aPixel.Data.g := PWord(aData)^;
2472   inc(aData, 2);
2473   aPixel.Data.b := PWord(aData)^;
2474   inc(aData, 2);
2475   aPixel.Data.a := 0;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2481 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2482 begin
2483   PWord(aData)^ := aPixel.Data.b;
2484   inc(aData, 2);
2485   PWord(aData)^ := aPixel.Data.g;
2486   inc(aData, 2);
2487   PWord(aData)^ := aPixel.Data.r;
2488   inc(aData, 2);
2489 end;
2490
2491 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2492 begin
2493   aPixel.Data.b := PWord(aData)^;
2494   inc(aData, 2);
2495   aPixel.Data.g := PWord(aData)^;
2496   inc(aData, 2);
2497   aPixel.Data.r := PWord(aData)^;
2498   inc(aData, 2);
2499   aPixel.Data.a := 0;
2500 end;
2501
2502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2503 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2505 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2506 begin
2507   inherited Map(aPixel, aData, aMapData);
2508   PWord(aData)^ := aPixel.Data.a;
2509   inc(aData, 2);
2510 end;
2511
2512 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2513 begin
2514   inherited Unmap(aData, aPixel, aMapData);
2515   aPixel.Data.a := PWord(aData)^;
2516   inc(aData, 2);
2517 end;
2518
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 begin
2524   PWord(aData)^ := aPixel.Data.a;
2525   inc(aData, 2);
2526   inherited Map(aPixel, aData, aMapData);
2527 end;
2528
2529 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2530 begin
2531   aPixel.Data.a := PWord(aData)^;
2532   inc(aData, 2);
2533   inherited Unmap(aData, aPixel, aMapData);
2534 end;
2535
2536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2537 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2539 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2540 begin
2541   inherited Map(aPixel, aData, aMapData);
2542   PWord(aData)^ := aPixel.Data.a;
2543   inc(aData, 2);
2544 end;
2545
2546 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2547 begin
2548   inherited Unmap(aData, aPixel, aMapData);
2549   aPixel.Data.a := PWord(aData)^;
2550   inc(aData, 2);
2551 end;
2552
2553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2557 begin
2558   PWord(aData)^ := aPixel.Data.a;
2559   inc(aData, 2);
2560   inherited Map(aPixel, aData, aMapData);
2561 end;
2562
2563 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2564 begin
2565   aPixel.Data.a := PWord(aData)^;
2566   inc(aData, 2);
2567   inherited Unmap(aData, aPixel, aMapData);
2568 end;
2569
2570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2573 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2574 var
2575   i: Integer;
2576 begin
2577   PCardinal(aData)^ := 0;
2578   for i := 0 to 3 do
2579     if (Range.arr[i] > 0) then
2580       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2581   inc(aData, 4);
2582 end;
2583
2584 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2585 var
2586   i: Integer;
2587 begin
2588   for i := 0 to 3 do
2589     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2590   inc(aData, 2);
2591 end;
2592
2593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2594 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2595 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2596 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2597 begin
2598   PCardinal(aData)^ := DepthWeight(aPixel);
2599   inc(aData, 4);
2600 end;
2601
2602 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2603 begin
2604   aPixel.Data.r := PCardinal(aData)^;
2605   aPixel.Data.g := PCardinal(aData)^;
2606   aPixel.Data.b := PCardinal(aData)^;
2607   aPixel.Data.a := PCardinal(aData)^;
2608   inc(aData, 4);
2609 end;
2610
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2614 procedure TfdAlpha4ub1.SetValues;
2615 begin
2616   inherited SetValues;
2617   fBitsPerPixel     := 8;
2618   fFormat           := tfAlpha4ub1;
2619   fWithAlpha        := tfAlpha4ub1;
2620   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2621   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2622 {$IFNDEF OPENGL_ES}
2623   fOpenGLFormat     := tfAlpha4ub1;
2624   fglFormat         := GL_ALPHA;
2625   fglInternalFormat := GL_ALPHA4;
2626   fglDataFormat     := GL_UNSIGNED_BYTE;
2627 {$ELSE}
2628   fOpenGLFormat     := tfAlpha8ub1;
2629 {$ENDIF}
2630 end;
2631
2632 procedure TfdAlpha8ub1.SetValues;
2633 begin
2634   inherited SetValues;
2635   fBitsPerPixel     := 8;
2636   fFormat           := tfAlpha8ub1;
2637   fWithAlpha        := tfAlpha8ub1;
2638   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2639   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2640   fOpenGLFormat     := tfAlpha8ub1;
2641   fglFormat         := GL_ALPHA;
2642   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2643   fglDataFormat     := GL_UNSIGNED_BYTE;
2644 end;
2645
2646 procedure TfdAlpha16us1.SetValues;
2647 begin
2648   inherited SetValues;
2649   fBitsPerPixel     := 16;
2650   fFormat           := tfAlpha16us1;
2651   fWithAlpha        := tfAlpha16us1;
2652   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2653   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2654 {$IFNDEF OPENGL_ES}
2655   fOpenGLFormat     := tfAlpha16us1;
2656   fglFormat         := GL_ALPHA;
2657   fglInternalFormat := GL_ALPHA16;
2658   fglDataFormat     := GL_UNSIGNED_SHORT;
2659 {$ELSE}
2660   fOpenGLFormat     := tfAlpha8ub1;
2661 {$ENDIF}
2662 end;
2663
2664 procedure TfdLuminance4ub1.SetValues;
2665 begin
2666   inherited SetValues;
2667   fBitsPerPixel     := 8;
2668   fFormat           := tfLuminance4ub1;
2669   fWithAlpha        := tfLuminance4Alpha4ub2;
2670   fWithoutAlpha     := tfLuminance4ub1;
2671   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2672   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2673 {$IFNDEF OPENGL_ES}
2674   fOpenGLFormat     := tfLuminance4ub1;
2675   fglFormat         := GL_LUMINANCE;
2676   fglInternalFormat := GL_LUMINANCE4;
2677   fglDataFormat     := GL_UNSIGNED_BYTE;
2678 {$ELSE}
2679   fOpenGLFormat     := tfLuminance8ub1;
2680 {$ENDIF}
2681 end;
2682
2683 procedure TfdLuminance8ub1.SetValues;
2684 begin
2685   inherited SetValues;
2686   fBitsPerPixel     := 8;
2687   fFormat           := tfLuminance8ub1;
2688   fWithAlpha        := tfLuminance8Alpha8ub2;
2689   fWithoutAlpha     := tfLuminance8ub1;
2690   fOpenGLFormat     := tfLuminance8ub1;
2691   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2692   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2693   fglFormat         := GL_LUMINANCE;
2694   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2695   fglDataFormat     := GL_UNSIGNED_BYTE;
2696 end;
2697
2698 procedure TfdLuminance16us1.SetValues;
2699 begin
2700   inherited SetValues;
2701   fBitsPerPixel     := 16;
2702   fFormat           := tfLuminance16us1;
2703   fWithAlpha        := tfLuminance16Alpha16us2;
2704   fWithoutAlpha     := tfLuminance16us1;
2705   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2706   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2707 {$IFNDEF OPENGL_ES}
2708   fOpenGLFormat     := tfLuminance16us1;
2709   fglFormat         := GL_LUMINANCE;
2710   fglInternalFormat := GL_LUMINANCE16;
2711   fglDataFormat     := GL_UNSIGNED_SHORT;
2712 {$ELSE}
2713   fOpenGLFormat     := tfLuminance8ub1;
2714 {$ENDIF}
2715 end;
2716
2717 procedure TfdLuminance4Alpha4ub2.SetValues;
2718 begin
2719   inherited SetValues;
2720   fBitsPerPixel     := 16;
2721   fFormat           := tfLuminance4Alpha4ub2;
2722   fWithAlpha        := tfLuminance4Alpha4ub2;
2723   fWithoutAlpha     := tfLuminance4ub1;
2724   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2725   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2726 {$IFNDEF OPENGL_ES}
2727   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2728   fglFormat         := GL_LUMINANCE_ALPHA;
2729   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2730   fglDataFormat     := GL_UNSIGNED_BYTE;
2731 {$ELSE}
2732   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2733 {$ENDIF}
2734 end;
2735
2736 procedure TfdLuminance6Alpha2ub2.SetValues;
2737 begin
2738   inherited SetValues;
2739   fBitsPerPixel     := 16;
2740   fFormat           := tfLuminance6Alpha2ub2;
2741   fWithAlpha        := tfLuminance6Alpha2ub2;
2742   fWithoutAlpha     := tfLuminance8ub1;
2743   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2744   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2745 {$IFNDEF OPENGL_ES}
2746   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2747   fglFormat         := GL_LUMINANCE_ALPHA;
2748   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2749   fglDataFormat     := GL_UNSIGNED_BYTE;
2750 {$ELSE}
2751   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2752 {$ENDIF}
2753 end;
2754
2755 procedure TfdLuminance8Alpha8ub2.SetValues;
2756 begin
2757   inherited SetValues;
2758   fBitsPerPixel     := 16;
2759   fFormat           := tfLuminance8Alpha8ub2;
2760   fWithAlpha        := tfLuminance8Alpha8ub2;
2761   fWithoutAlpha     := tfLuminance8ub1;
2762   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2763   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2764   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2765   fglFormat         := GL_LUMINANCE_ALPHA;
2766   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2767   fglDataFormat     := GL_UNSIGNED_BYTE;
2768 end;
2769
2770 procedure TfdLuminance12Alpha4us2.SetValues;
2771 begin
2772   inherited SetValues;
2773   fBitsPerPixel     := 32;
2774   fFormat           := tfLuminance12Alpha4us2;
2775   fWithAlpha        := tfLuminance12Alpha4us2;
2776   fWithoutAlpha     := tfLuminance16us1;
2777   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2778   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2779 {$IFNDEF OPENGL_ES}
2780   fOpenGLFormat     := tfLuminance12Alpha4us2;
2781   fglFormat         := GL_LUMINANCE_ALPHA;
2782   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2783   fglDataFormat     := GL_UNSIGNED_SHORT;
2784 {$ELSE}
2785   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2786 {$ENDIF}
2787 end;
2788
2789 procedure TfdLuminance16Alpha16us2.SetValues;
2790 begin
2791   inherited SetValues;
2792   fBitsPerPixel     := 32;
2793   fFormat           := tfLuminance16Alpha16us2;
2794   fWithAlpha        := tfLuminance16Alpha16us2;
2795   fWithoutAlpha     := tfLuminance16us1;
2796   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2797   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2798 {$IFNDEF OPENGL_ES}
2799   fOpenGLFormat     := tfLuminance16Alpha16us2;
2800   fglFormat         := GL_LUMINANCE_ALPHA;
2801   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2802   fglDataFormat     := GL_UNSIGNED_SHORT;
2803 {$ELSE}
2804   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2805 {$ENDIF}
2806 end;
2807
2808 procedure TfdR3G3B2ub1.SetValues;
2809 begin
2810   inherited SetValues;
2811   fBitsPerPixel     := 8;
2812   fFormat           := tfR3G3B2ub1;
2813   fWithAlpha        := tfRGBA4us1;
2814   fWithoutAlpha     := tfR3G3B2ub1;
2815   fRGBInverted      := tfEmpty;
2816   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2817   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2818 {$IFNDEF OPENGL_ES}
2819   fOpenGLFormat     := tfR3G3B2ub1;
2820   fglFormat         := GL_RGB;
2821   fglInternalFormat := GL_R3_G3_B2;
2822   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2823 {$ELSE}
2824   fOpenGLFormat     := tfR5G6B5us1;
2825 {$ENDIF}
2826 end;
2827
2828 procedure TfdRGBX4us1.SetValues;
2829 begin
2830   inherited SetValues;
2831   fBitsPerPixel     := 16;
2832   fFormat           := tfRGBX4us1;
2833   fWithAlpha        := tfRGBA4us1;
2834   fWithoutAlpha     := tfRGBX4us1;
2835   fRGBInverted      := tfBGRX4us1;
2836   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2837   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2838 {$IFNDEF OPENGL_ES}
2839   fOpenGLFormat     := tfRGBX4us1;
2840   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2841   fglInternalFormat := GL_RGB4;
2842   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2843 {$ELSE}
2844   fOpenGLFormat     := tfR5G6B5us1;
2845 {$ENDIF}
2846 end;
2847
2848 procedure TfdXRGB4us1.SetValues;
2849 begin
2850   inherited SetValues;
2851   fBitsPerPixel     := 16;
2852   fFormat           := tfXRGB4us1;
2853   fWithAlpha        := tfARGB4us1;
2854   fWithoutAlpha     := tfXRGB4us1;
2855   fRGBInverted      := tfXBGR4us1;
2856   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2857   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2858 {$IFNDEF OPENGL_ES}
2859   fOpenGLFormat     := tfXRGB4us1;
2860   fglFormat         := GL_BGRA;
2861   fglInternalFormat := GL_RGB4;
2862   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2863 {$ELSE}
2864   fOpenGLFormat     := tfR5G6B5us1;
2865 {$ENDIF}
2866 end;
2867
2868 procedure TfdR5G6B5us1.SetValues;
2869 begin
2870   inherited SetValues;
2871   fBitsPerPixel     := 16;
2872   fFormat           := tfR5G6B5us1;
2873   fWithAlpha        := tfRGB5A1us1;
2874   fWithoutAlpha     := tfR5G6B5us1;
2875   fRGBInverted      := tfB5G6R5us1;
2876   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2877   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2878 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2879   fOpenGLFormat     := tfR5G6B5us1;
2880   fglFormat         := GL_RGB;
2881   fglInternalFormat := GL_RGB565;
2882   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2883 {$ELSE}
2884   fOpenGLFormat     := tfRGB8ub3;
2885 {$IFEND}
2886 end;
2887
2888 procedure TfdRGB5X1us1.SetValues;
2889 begin
2890   inherited SetValues;
2891   fBitsPerPixel     := 16;
2892   fFormat           := tfRGB5X1us1;
2893   fWithAlpha        := tfRGB5A1us1;
2894   fWithoutAlpha     := tfRGB5X1us1;
2895   fRGBInverted      := tfBGR5X1us1;
2896   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2897   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2898 {$IFNDEF OPENGL_ES}
2899   fOpenGLFormat     := tfRGB5X1us1;
2900   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2901   fglInternalFormat := GL_RGB5;
2902   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2903 {$ELSE}
2904   fOpenGLFormat     := tfR5G6B5us1;
2905 {$ENDIF}
2906 end;
2907
2908 procedure TfdX1RGB5us1.SetValues;
2909 begin
2910   inherited SetValues;
2911   fBitsPerPixel     := 16;
2912   fFormat           := tfX1RGB5us1;
2913   fWithAlpha        := tfA1RGB5us1;
2914   fWithoutAlpha     := tfX1RGB5us1;
2915   fRGBInverted      := tfX1BGR5us1;
2916   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2917   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2918 {$IFNDEF OPENGL_ES}
2919   fOpenGLFormat     := tfX1RGB5us1;
2920   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2921   fglInternalFormat := GL_RGB5;
2922   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2923 {$ELSE}
2924   fOpenGLFormat     := tfR5G6B5us1;
2925 {$ENDIF}
2926 end;
2927
2928 procedure TfdRGB8ub3.SetValues;
2929 begin
2930   inherited SetValues;
2931   fBitsPerPixel     := 24;
2932   fFormat           := tfRGB8ub3;
2933   fWithAlpha        := tfRGBA8ub4;
2934   fWithoutAlpha     := tfRGB8ub3;
2935   fRGBInverted      := tfBGR8ub3;
2936   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2937   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2938   fOpenGLFormat     := tfRGB8ub3;
2939   fglFormat         := GL_RGB;
2940   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2941   fglDataFormat     := GL_UNSIGNED_BYTE;
2942 end;
2943
2944 procedure TfdRGBX8ui1.SetValues;
2945 begin
2946   inherited SetValues;
2947   fBitsPerPixel     := 32;
2948   fFormat           := tfRGBX8ui1;
2949   fWithAlpha        := tfRGBA8ui1;
2950   fWithoutAlpha     := tfRGBX8ui1;
2951   fRGBInverted      := tfBGRX8ui1;
2952   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2953   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2954 {$IFNDEF OPENGL_ES}
2955   fOpenGLFormat     := tfRGBX8ui1;
2956   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2957   fglInternalFormat := GL_RGB8;
2958   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2959 {$ELSE}
2960   fOpenGLFormat     := tfRGB8ub3;
2961 {$ENDIF}
2962 end;
2963
2964 procedure TfdXRGB8ui1.SetValues;
2965 begin
2966   inherited SetValues;
2967   fBitsPerPixel     := 32;
2968   fFormat           := tfXRGB8ui1;
2969   fWithAlpha        := tfXRGB8ui1;
2970   fWithoutAlpha     := tfXRGB8ui1;
2971   fOpenGLFormat     := tfXRGB8ui1;
2972   fRGBInverted      := tfXBGR8ui1;
2973   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2974   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2975 {$IFNDEF OPENGL_ES}
2976   fOpenGLFormat     := tfXRGB8ui1;
2977   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2978   fglInternalFormat := GL_RGB8;
2979   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2980 {$ELSE}
2981   fOpenGLFormat     := tfRGB8ub3;
2982 {$ENDIF}
2983 end;
2984
2985 procedure TfdRGB10X2ui1.SetValues;
2986 begin
2987   inherited SetValues;
2988   fBitsPerPixel     := 32;
2989   fFormat           := tfRGB10X2ui1;
2990   fWithAlpha        := tfRGB10A2ui1;
2991   fWithoutAlpha     := tfRGB10X2ui1;
2992   fRGBInverted      := tfBGR10X2ui1;
2993   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
2994   fShift            := glBitmapRec4ub(22, 12,  2, 0);
2995 {$IFNDEF OPENGL_ES}
2996   fOpenGLFormat     := tfRGB10X2ui1;
2997   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2998   fglInternalFormat := GL_RGB10;
2999   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3000 {$ELSE}
3001   fOpenGLFormat     := tfRGB16us3;
3002 {$ENDIF}
3003 end;
3004
3005 procedure TfdX2RGB10ui1.SetValues;
3006 begin
3007   inherited SetValues;
3008   fBitsPerPixel     := 32;
3009   fFormat           := tfX2RGB10ui1;
3010   fWithAlpha        := tfA2RGB10ui1;
3011   fWithoutAlpha     := tfX2RGB10ui1;
3012   fRGBInverted      := tfX2BGR10ui1;
3013   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3014   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3015 {$IFNDEF OPENGL_ES}
3016   fOpenGLFormat     := tfX2RGB10ui1;
3017   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3018   fglInternalFormat := GL_RGB10;
3019   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3020 {$ELSE}
3021   fOpenGLFormat     := tfRGB16us3;
3022 {$ENDIF}
3023 end;
3024
3025 procedure TfdRGB16us3.SetValues;
3026 begin
3027   inherited SetValues;
3028   fBitsPerPixel     := 48;
3029   fFormat           := tfRGB16us3;
3030   fWithAlpha        := tfRGBA16us4;
3031   fWithoutAlpha     := tfRGB16us3;
3032   fRGBInverted      := tfBGR16us3;
3033   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3034   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3035 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3036   fOpenGLFormat     := tfRGB16us3;
3037   fglFormat         := GL_RGB;
3038   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3039   fglDataFormat     := GL_UNSIGNED_SHORT;
3040 {$ELSE}
3041   fOpenGLFormat     := tfRGB8ub3;
3042 {$IFEND}
3043 end;
3044
3045 procedure TfdRGBA4us1.SetValues;
3046 begin
3047   inherited SetValues;
3048   fBitsPerPixel     := 16;
3049   fFormat           := tfRGBA4us1;
3050   fWithAlpha        := tfRGBA4us1;
3051   fWithoutAlpha     := tfRGBX4us1;
3052   fOpenGLFormat     := tfRGBA4us1;
3053   fRGBInverted      := tfBGRA4us1;
3054   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3055   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3056   fglFormat         := GL_RGBA;
3057   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3058   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3059 end;
3060
3061 procedure TfdARGB4us1.SetValues;
3062 begin
3063   inherited SetValues;
3064   fBitsPerPixel     := 16;
3065   fFormat           := tfARGB4us1;
3066   fWithAlpha        := tfARGB4us1;
3067   fWithoutAlpha     := tfXRGB4us1;
3068   fRGBInverted      := tfABGR4us1;
3069   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3070   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3071 {$IFNDEF OPENGL_ES}
3072   fOpenGLFormat     := tfARGB4us1;
3073   fglFormat         := GL_BGRA;
3074   fglInternalFormat := GL_RGBA4;
3075   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3076 {$ELSE}
3077   fOpenGLFormat     := tfRGBA4us1;
3078 {$ENDIF}
3079 end;
3080
3081 procedure TfdRGB5A1us1.SetValues;
3082 begin
3083   inherited SetValues;
3084   fBitsPerPixel     := 16;
3085   fFormat           := tfRGB5A1us1;
3086   fWithAlpha        := tfRGB5A1us1;
3087   fWithoutAlpha     := tfRGB5X1us1;
3088   fOpenGLFormat     := tfRGB5A1us1;
3089   fRGBInverted      := tfBGR5A1us1;
3090   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3091   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3092   fglFormat         := GL_RGBA;
3093   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3094   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3095 end;
3096
3097 procedure TfdA1RGB5us1.SetValues;
3098 begin
3099   inherited SetValues;
3100   fBitsPerPixel     := 16;
3101   fFormat           := tfA1RGB5us1;
3102   fWithAlpha        := tfA1RGB5us1;
3103   fWithoutAlpha     := tfX1RGB5us1;
3104   fRGBInverted      := tfA1BGR5us1;
3105   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3106   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3107 {$IFNDEF OPENGL_ES}
3108   fOpenGLFormat     := tfA1RGB5us1;
3109   fglFormat         := GL_BGRA;
3110   fglInternalFormat := GL_RGB5_A1;
3111   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3112 {$ELSE}
3113   fOpenGLFormat     := tfRGB5A1us1;
3114 {$ENDIF}
3115 end;
3116
3117 procedure TfdRGBA8ui1.SetValues;
3118 begin
3119   inherited SetValues;
3120   fBitsPerPixel     := 32;
3121   fFormat           := tfRGBA8ui1;
3122   fWithAlpha        := tfRGBA8ui1;
3123   fWithoutAlpha     := tfRGBX8ui1;
3124   fRGBInverted      := tfBGRA8ui1;
3125   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3126   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3127 {$IFNDEF OPENGL_ES}
3128   fOpenGLFormat     := tfRGBA8ui1;
3129   fglFormat         := GL_RGBA;
3130   fglInternalFormat := GL_RGBA8;
3131   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3132 {$ELSE}
3133   fOpenGLFormat     := tfRGBA8ub4;
3134 {$ENDIF}
3135 end;
3136
3137 procedure TfdARGB8ui1.SetValues;
3138 begin
3139   inherited SetValues;
3140   fBitsPerPixel     := 32;
3141   fFormat           := tfARGB8ui1;
3142   fWithAlpha        := tfARGB8ui1;
3143   fWithoutAlpha     := tfXRGB8ui1;
3144   fRGBInverted      := tfABGR8ui1;
3145   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3146   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3147 {$IFNDEF OPENGL_ES}
3148   fOpenGLFormat     := tfARGB8ui1;
3149   fglFormat         := GL_BGRA;
3150   fglInternalFormat := GL_RGBA8;
3151   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3152 {$ELSE}
3153   fOpenGLFormat     := tfRGBA8ub4;
3154 {$ENDIF}
3155 end;
3156
3157 procedure TfdRGBA8ub4.SetValues;
3158 begin
3159   inherited SetValues;
3160   fBitsPerPixel     := 32;
3161   fFormat           := tfRGBA8ub4;
3162   fWithAlpha        := tfRGBA8ub4;
3163   fWithoutAlpha     := tfRGB8ub3;
3164   fOpenGLFormat     := tfRGBA8ub4;
3165   fRGBInverted      := tfBGRA8ub4;
3166   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3167   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3168   fglFormat         := GL_RGBA;
3169   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3170   fglDataFormat     := GL_UNSIGNED_BYTE;
3171 end;
3172
3173 procedure TfdRGB10A2ui1.SetValues;
3174 begin
3175   inherited SetValues;
3176   fBitsPerPixel     := 32;
3177   fFormat           := tfRGB10A2ui1;
3178   fWithAlpha        := tfRGB10A2ui1;
3179   fWithoutAlpha     := tfRGB10X2ui1;
3180   fRGBInverted      := tfBGR10A2ui1;
3181   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3182   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3183 {$IFNDEF OPENGL_ES}
3184   fOpenGLFormat     := tfRGB10A2ui1;
3185   fglFormat         := GL_RGBA;
3186   fglInternalFormat := GL_RGB10_A2;
3187   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3188 {$ELSE}
3189   fOpenGLFormat     := tfA2RGB10ui1;
3190 {$ENDIF}
3191 end;
3192
3193 procedure TfdA2RGB10ui1.SetValues;
3194 begin
3195   inherited SetValues;
3196   fBitsPerPixel     := 32;
3197   fFormat           := tfA2RGB10ui1;
3198   fWithAlpha        := tfA2RGB10ui1;
3199   fWithoutAlpha     := tfX2RGB10ui1;
3200   fRGBInverted      := tfA2BGR10ui1;
3201   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3202   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3203 {$IF NOT DEFINED(OPENGL_ES)}
3204   fOpenGLFormat     := tfA2RGB10ui1;
3205   fglFormat         := GL_BGRA;
3206   fglInternalFormat := GL_RGB10_A2;
3207   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3208 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3209   fOpenGLFormat     := tfA2RGB10ui1;
3210   fglFormat         := GL_RGBA;
3211   fglInternalFormat := GL_RGB10_A2;
3212   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3213 {$ELSE}
3214   fOpenGLFormat     := tfRGBA8ui1;
3215 {$IFEND}
3216 end;
3217
3218 procedure TfdRGBA16us4.SetValues;
3219 begin
3220   inherited SetValues;
3221   fBitsPerPixel     := 64;
3222   fFormat           := tfRGBA16us4;
3223   fWithAlpha        := tfRGBA16us4;
3224   fWithoutAlpha     := tfRGB16us3;
3225   fRGBInverted      := tfBGRA16us4;
3226   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3227   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3228 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3229   fOpenGLFormat     := tfRGBA16us4;
3230   fglFormat         := GL_RGBA;
3231   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3232   fglDataFormat     := GL_UNSIGNED_SHORT;
3233 {$ELSE}
3234   fOpenGLFormat     := tfRGBA8ub4;
3235 {$IFEND}
3236 end;
3237
3238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3241 procedure TfdBGRX4us1.SetValues;
3242 begin
3243   inherited SetValues;
3244   fBitsPerPixel     := 16;
3245   fFormat           := tfBGRX4us1;
3246   fWithAlpha        := tfBGRA4us1;
3247   fWithoutAlpha     := tfBGRX4us1;
3248   fRGBInverted      := tfRGBX4us1;
3249   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3250   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3251 {$IFNDEF OPENGL_ES}
3252   fOpenGLFormat     := tfBGRX4us1;
3253   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3254   fglInternalFormat := GL_RGB4;
3255   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3256 {$ELSE}
3257   fOpenGLFormat     := tfR5G6B5us1;
3258 {$ENDIF}
3259 end;
3260
3261 procedure TfdXBGR4us1.SetValues;
3262 begin
3263   inherited SetValues;
3264   fBitsPerPixel     := 16;
3265   fFormat           := tfXBGR4us1;
3266   fWithAlpha        := tfABGR4us1;
3267   fWithoutAlpha     := tfXBGR4us1;
3268   fRGBInverted      := tfXRGB4us1;
3269   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3270   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3271 {$IFNDEF OPENGL_ES}
3272   fOpenGLFormat     := tfXBGR4us1;
3273   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3274   fglInternalFormat := GL_RGB4;
3275   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3276 {$ELSE}
3277   fOpenGLFormat     := tfR5G6B5us1;
3278 {$ENDIF}
3279 end;
3280
3281 procedure TfdB5G6R5us1.SetValues;
3282 begin
3283   inherited SetValues;
3284   fBitsPerPixel     := 16;
3285   fFormat           := tfB5G6R5us1;
3286   fWithAlpha        := tfBGR5A1us1;
3287   fWithoutAlpha     := tfB5G6R5us1;
3288   fRGBInverted      := tfR5G6B5us1;
3289   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3290   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3291 {$IFNDEF OPENGL_ES}
3292   fOpenGLFormat     := tfB5G6R5us1;
3293   fglFormat         := GL_RGB;
3294   fglInternalFormat := GL_RGB565;
3295   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3296 {$ELSE}
3297   fOpenGLFormat     := tfR5G6B5us1;
3298 {$ENDIF}
3299 end;
3300
3301 procedure TfdBGR5X1us1.SetValues;
3302 begin
3303   inherited SetValues;
3304   fBitsPerPixel     := 16;
3305   fFormat           := tfBGR5X1us1;
3306   fWithAlpha        := tfBGR5A1us1;
3307   fWithoutAlpha     := tfBGR5X1us1;
3308   fRGBInverted      := tfRGB5X1us1;
3309   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3310   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3311 {$IFNDEF OPENGL_ES}
3312   fOpenGLFormat     := tfBGR5X1us1;
3313   fglFormat         := GL_BGRA;
3314   fglInternalFormat := GL_RGB5;
3315   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3316 {$ELSE}
3317   fOpenGLFormat     := tfR5G6B5us1;
3318 {$ENDIF}
3319 end;
3320
3321 procedure TfdX1BGR5us1.SetValues;
3322 begin
3323   inherited SetValues;
3324   fBitsPerPixel     := 16;
3325   fFormat           := tfX1BGR5us1;
3326   fWithAlpha        := tfA1BGR5us1;
3327   fWithoutAlpha     := tfX1BGR5us1;
3328   fRGBInverted      := tfX1RGB5us1;
3329   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3330   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3331 {$IFNDEF OPENGL_ES}
3332   fOpenGLFormat     := tfX1BGR5us1;
3333   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3334   fglInternalFormat := GL_RGB5;
3335   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3336 {$ELSE}
3337   fOpenGLFormat     := tfR5G6B5us1;
3338 {$ENDIF}
3339 end;
3340
3341 procedure TfdBGR8ub3.SetValues;
3342 begin
3343   inherited SetValues;
3344   fBitsPerPixel     := 24;
3345   fFormat           := tfBGR8ub3;
3346   fWithAlpha        := tfBGRA8ub4;
3347   fWithoutAlpha     := tfBGR8ub3;
3348   fRGBInverted      := tfRGB8ub3;
3349   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3350   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3351 {$IFNDEF OPENGL_ES}
3352   fOpenGLFormat     := tfBGR8ub3;
3353   fglFormat         := GL_BGR;
3354   fglInternalFormat := GL_RGB8;
3355   fglDataFormat     := GL_UNSIGNED_BYTE;
3356 {$ELSE}
3357   fOpenGLFormat     := tfRGB8ub3;
3358 {$ENDIF}
3359 end;
3360
3361 procedure TfdBGRX8ui1.SetValues;
3362 begin
3363   inherited SetValues;
3364   fBitsPerPixel     := 32;
3365   fFormat           := tfBGRX8ui1;
3366   fWithAlpha        := tfBGRA8ui1;
3367   fWithoutAlpha     := tfBGRX8ui1;
3368   fRGBInverted      := tfRGBX8ui1;
3369   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3370   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3371 {$IFNDEF OPENGL_ES}
3372   fOpenGLFormat     := tfBGRX8ui1;
3373   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3374   fglInternalFormat := GL_RGB8;
3375   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3376 {$ELSE}
3377   fOpenGLFormat     := tfRGB8ub3;
3378 {$ENDIF}
3379 end;
3380
3381 procedure TfdXBGR8ui1.SetValues;
3382 begin
3383   inherited SetValues;
3384   fBitsPerPixel     := 32;
3385   fFormat           := tfXBGR8ui1;
3386   fWithAlpha        := tfABGR8ui1;
3387   fWithoutAlpha     := tfXBGR8ui1;
3388   fRGBInverted      := tfXRGB8ui1;
3389   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3390   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3391 {$IFNDEF OPENGL_ES}
3392   fOpenGLFormat     := tfXBGR8ui1;
3393   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3394   fglInternalFormat := GL_RGB8;
3395   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3396 {$ELSE}
3397   fOpenGLFormat     := tfRGB8ub3;
3398 {$ENDIF}
3399 end;
3400
3401 procedure TfdBGR10X2ui1.SetValues;
3402 begin
3403   inherited SetValues;
3404   fBitsPerPixel     := 32;
3405   fFormat           := tfBGR10X2ui1;
3406   fWithAlpha        := tfBGR10A2ui1;
3407   fWithoutAlpha     := tfBGR10X2ui1;
3408   fRGBInverted      := tfRGB10X2ui1;
3409   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3410   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3411 {$IFNDEF OPENGL_ES}
3412   fOpenGLFormat     := tfBGR10X2ui1;
3413   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3414   fglInternalFormat := GL_RGB10;
3415   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3416 {$ELSE}
3417   fOpenGLFormat     := tfRGB16us3;
3418 {$ENDIF}
3419 end;
3420
3421 procedure TfdX2BGR10ui1.SetValues;
3422 begin
3423   inherited SetValues;
3424   fBitsPerPixel     := 32;
3425   fFormat           := tfX2BGR10ui1;
3426   fWithAlpha        := tfA2BGR10ui1;
3427   fWithoutAlpha     := tfX2BGR10ui1;
3428   fRGBInverted      := tfX2RGB10ui1;
3429   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3430   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3431 {$IFNDEF OPENGL_ES}
3432   fOpenGLFormat     := tfX2BGR10ui1;
3433   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3434   fglInternalFormat := GL_RGB10;
3435   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3436 {$ELSE}
3437   fOpenGLFormat     := tfRGB16us3;
3438 {$ENDIF}
3439 end;
3440
3441 procedure TfdBGR16us3.SetValues;
3442 begin
3443   inherited SetValues;
3444   fBitsPerPixel     := 48;
3445   fFormat           := tfBGR16us3;
3446   fWithAlpha        := tfBGRA16us4;
3447   fWithoutAlpha     := tfBGR16us3;
3448   fRGBInverted      := tfRGB16us3;
3449   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3450   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3451 {$IFNDEF OPENGL_ES}
3452   fOpenGLFormat     := tfBGR16us3;
3453   fglFormat         := GL_BGR;
3454   fglInternalFormat := GL_RGB16;
3455   fglDataFormat     := GL_UNSIGNED_SHORT;
3456 {$ELSE}
3457   fOpenGLFormat     := tfRGB16us3;
3458 {$ENDIF}
3459 end;
3460
3461 procedure TfdBGRA4us1.SetValues;
3462 begin
3463   inherited SetValues;
3464   fBitsPerPixel     := 16;
3465   fFormat           := tfBGRA4us1;
3466   fWithAlpha        := tfBGRA4us1;
3467   fWithoutAlpha     := tfBGRX4us1;
3468   fRGBInverted      := tfRGBA4us1;
3469   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3470   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3471 {$IFNDEF OPENGL_ES}
3472   fOpenGLFormat     := tfBGRA4us1;
3473   fglFormat         := GL_BGRA;
3474   fglInternalFormat := GL_RGBA4;
3475   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3476 {$ELSE}
3477   fOpenGLFormat     := tfRGBA4us1;
3478 {$ENDIF}
3479 end;
3480
3481 procedure TfdABGR4us1.SetValues;
3482 begin
3483   inherited SetValues;
3484   fBitsPerPixel     := 16;
3485   fFormat           := tfABGR4us1;
3486   fWithAlpha        := tfABGR4us1;
3487   fWithoutAlpha     := tfXBGR4us1;
3488   fRGBInverted      := tfARGB4us1;
3489   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3490   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3491 {$IFNDEF OPENGL_ES}
3492   fOpenGLFormat     := tfABGR4us1;
3493   fglFormat         := GL_RGBA;
3494   fglInternalFormat := GL_RGBA4;
3495   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3496 {$ELSE}
3497   fOpenGLFormat     := tfRGBA4us1;
3498 {$ENDIF}
3499 end;
3500
3501 procedure TfdBGR5A1us1.SetValues;
3502 begin
3503   inherited SetValues;
3504   fBitsPerPixel     := 16;
3505   fFormat           := tfBGR5A1us1;
3506   fWithAlpha        := tfBGR5A1us1;
3507   fWithoutAlpha     := tfBGR5X1us1;
3508   fRGBInverted      := tfRGB5A1us1;
3509   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3510   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3511 {$IFNDEF OPENGL_ES}
3512   fOpenGLFormat     := tfBGR5A1us1;
3513   fglFormat         := GL_BGRA;
3514   fglInternalFormat := GL_RGB5_A1;
3515   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3516 {$ELSE}
3517   fOpenGLFormat     := tfRGB5A1us1;
3518 {$ENDIF}
3519 end;
3520
3521 procedure TfdA1BGR5us1.SetValues;
3522 begin
3523   inherited SetValues;
3524   fBitsPerPixel     := 16;
3525   fFormat           := tfA1BGR5us1;
3526   fWithAlpha        := tfA1BGR5us1;
3527   fWithoutAlpha     := tfX1BGR5us1;
3528   fRGBInverted      := tfA1RGB5us1;
3529   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3530   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3531 {$IFNDEF OPENGL_ES}
3532   fOpenGLFormat     := tfA1BGR5us1;
3533   fglFormat         := GL_RGBA;
3534   fglInternalFormat := GL_RGB5_A1;
3535   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3536 {$ELSE}
3537   fOpenGLFormat     := tfRGB5A1us1;
3538 {$ENDIF}
3539 end;
3540
3541 procedure TfdBGRA8ui1.SetValues;
3542 begin
3543   inherited SetValues;
3544   fBitsPerPixel     := 32;
3545   fFormat           := tfBGRA8ui1;
3546   fWithAlpha        := tfBGRA8ui1;
3547   fWithoutAlpha     := tfBGRX8ui1;
3548   fRGBInverted      := tfRGBA8ui1;
3549   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3550   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3551 {$IFNDEF OPENGL_ES}
3552   fOpenGLFormat     := tfBGRA8ui1;
3553   fglFormat         := GL_BGRA;
3554   fglInternalFormat := GL_RGBA8;
3555   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3556 {$ELSE}
3557   fOpenGLFormat     := tfRGBA8ub4;
3558 {$ENDIF}
3559 end;
3560
3561 procedure TfdABGR8ui1.SetValues;
3562 begin
3563   inherited SetValues;
3564   fBitsPerPixel     := 32;
3565   fFormat           := tfABGR8ui1;
3566   fWithAlpha        := tfABGR8ui1;
3567   fWithoutAlpha     := tfXBGR8ui1;
3568   fRGBInverted      := tfARGB8ui1;
3569   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3570   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3571 {$IFNDEF OPENGL_ES}
3572   fOpenGLFormat     := tfABGR8ui1;
3573   fglFormat         := GL_RGBA;
3574   fglInternalFormat := GL_RGBA8;
3575   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3576 {$ELSE}
3577   fOpenGLFormat     := tfRGBA8ub4
3578 {$ENDIF}
3579 end;
3580
3581 procedure TfdBGRA8ub4.SetValues;
3582 begin
3583   inherited SetValues;
3584   fBitsPerPixel     := 32;
3585   fFormat           := tfBGRA8ub4;
3586   fWithAlpha        := tfBGRA8ub4;
3587   fWithoutAlpha     := tfBGR8ub3;
3588   fRGBInverted      := tfRGBA8ub4;
3589   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3590   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3591 {$IFNDEF OPENGL_ES}
3592   fOpenGLFormat     := tfBGRA8ub4;
3593   fglFormat         := GL_BGRA;
3594   fglInternalFormat := GL_RGBA8;
3595   fglDataFormat     := GL_UNSIGNED_BYTE;
3596 {$ELSE}
3597   fOpenGLFormat     := tfRGBA8ub4;
3598 {$ENDIF}
3599 end;
3600
3601 procedure TfdBGR10A2ui1.SetValues;
3602 begin
3603   inherited SetValues;
3604   fBitsPerPixel     := 32;
3605   fFormat           := tfBGR10A2ui1;
3606   fWithAlpha        := tfBGR10A2ui1;
3607   fWithoutAlpha     := tfBGR10X2ui1;
3608   fRGBInverted      := tfRGB10A2ui1;
3609   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3610   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3611 {$IFNDEF OPENGL_ES}
3612   fOpenGLFormat     := tfBGR10A2ui1;
3613   fglFormat         := GL_BGRA;
3614   fglInternalFormat := GL_RGB10_A2;
3615   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3616 {$ELSE}
3617   fOpenGLFormat     := tfA2RGB10ui1;
3618 {$ENDIF}
3619 end;
3620
3621 procedure TfdA2BGR10ui1.SetValues;
3622 begin
3623   inherited SetValues;
3624   fBitsPerPixel     := 32;
3625   fFormat           := tfA2BGR10ui1;
3626   fWithAlpha        := tfA2BGR10ui1;
3627   fWithoutAlpha     := tfX2BGR10ui1;
3628   fRGBInverted      := tfA2RGB10ui1;
3629   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3630   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3631 {$IFNDEF OPENGL_ES}
3632   fOpenGLFormat     := tfA2BGR10ui1;
3633   fglFormat         := GL_RGBA;
3634   fglInternalFormat := GL_RGB10_A2;
3635   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3636 {$ELSE}
3637   fOpenGLFormat     := tfA2RGB10ui1;
3638 {$ENDIF}
3639 end;
3640
3641 procedure TfdBGRA16us4.SetValues;
3642 begin
3643   inherited SetValues;
3644   fBitsPerPixel     := 64;
3645   fFormat           := tfBGRA16us4;
3646   fWithAlpha        := tfBGRA16us4;
3647   fWithoutAlpha     := tfBGR16us3;
3648   fRGBInverted      := tfRGBA16us4;
3649   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3650   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3651 {$IFNDEF OPENGL_ES}
3652   fOpenGLFormat     := tfBGRA16us4;
3653   fglFormat         := GL_BGRA;
3654   fglInternalFormat := GL_RGBA16;
3655   fglDataFormat     := GL_UNSIGNED_SHORT;
3656 {$ELSE}
3657   fOpenGLFormat     := tfRGBA16us4;
3658 {$ENDIF}
3659 end;
3660
3661 procedure TfdDepth16us1.SetValues;
3662 begin
3663   inherited SetValues;
3664   fBitsPerPixel     := 16;
3665   fFormat           := tfDepth16us1;
3666   fWithoutAlpha     := tfDepth16us1;
3667   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3668   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3669 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3670   fOpenGLFormat     := tfDepth16us1;
3671   fglFormat         := GL_DEPTH_COMPONENT;
3672   fglInternalFormat := GL_DEPTH_COMPONENT16;
3673   fglDataFormat     := GL_UNSIGNED_SHORT;
3674 {$IFEND}
3675 end;
3676
3677 procedure TfdDepth24ui1.SetValues;
3678 begin
3679   inherited SetValues;
3680   fBitsPerPixel     := 32;
3681   fFormat           := tfDepth24ui1;
3682   fWithoutAlpha     := tfDepth24ui1;
3683   fOpenGLFormat     := tfDepth24ui1;
3684   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3685   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3686 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3687   fOpenGLFormat     := tfDepth24ui1;
3688   fglFormat         := GL_DEPTH_COMPONENT;
3689   fglInternalFormat := GL_DEPTH_COMPONENT24;
3690   fglDataFormat     := GL_UNSIGNED_INT;
3691 {$IFEND}
3692 end;
3693
3694 procedure TfdDepth32ui1.SetValues;
3695 begin
3696   inherited SetValues;
3697   fBitsPerPixel     := 32;
3698   fFormat           := tfDepth32ui1;
3699   fWithoutAlpha     := tfDepth32ui1;
3700   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3701   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3702 {$IF NOT DEFINED(OPENGL_ES)}
3703   fOpenGLFormat     := tfDepth32ui1;
3704   fglFormat         := GL_DEPTH_COMPONENT;
3705   fglInternalFormat := GL_DEPTH_COMPONENT32;
3706   fglDataFormat     := GL_UNSIGNED_INT;
3707 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3708   fOpenGLFormat     := tfDepth24ui1;
3709 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3710   fOpenGLFormat     := tfDepth16us1;
3711 {$IFEND}
3712 end;
3713
3714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3715 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3716 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3717 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3718 begin
3719   raise EglBitmap.Create('mapping for compressed formats is not supported');
3720 end;
3721
3722 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3723 begin
3724   raise EglBitmap.Create('mapping for compressed formats is not supported');
3725 end;
3726
3727 procedure TfdS3tcDtx1RGBA.SetValues;
3728 begin
3729   inherited SetValues;
3730   fFormat           := tfS3tcDtx1RGBA;
3731   fWithAlpha        := tfS3tcDtx1RGBA;
3732   fUncompressed     := tfRGB5A1us1;
3733   fBitsPerPixel     := 4;
3734   fIsCompressed     := true;
3735 {$IFNDEF OPENGL_ES}
3736   fOpenGLFormat     := tfS3tcDtx1RGBA;
3737   fglFormat         := GL_COMPRESSED_RGBA;
3738   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3739   fglDataFormat     := GL_UNSIGNED_BYTE;
3740 {$ELSE}
3741   fOpenGLFormat     := fUncompressed;
3742 {$ENDIF}
3743 end;
3744
3745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3746 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3747 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3748 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3749 begin
3750   raise EglBitmap.Create('mapping for compressed formats is not supported');
3751 end;
3752
3753 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3754 begin
3755   raise EglBitmap.Create('mapping for compressed formats is not supported');
3756 end;
3757
3758 procedure TfdS3tcDtx3RGBA.SetValues;
3759 begin
3760   inherited SetValues;
3761   fFormat           := tfS3tcDtx3RGBA;
3762   fWithAlpha        := tfS3tcDtx3RGBA;
3763   fUncompressed     := tfRGBA8ub4;
3764   fBitsPerPixel     := 8;
3765   fIsCompressed     := true;
3766 {$IFNDEF OPENGL_ES}
3767   fOpenGLFormat     := tfS3tcDtx3RGBA;
3768   fglFormat         := GL_COMPRESSED_RGBA;
3769   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3770   fglDataFormat     := GL_UNSIGNED_BYTE;
3771 {$ELSE}
3772   fOpenGLFormat     := fUncompressed;
3773 {$ENDIF}
3774 end;
3775
3776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3777 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3779 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3780 begin
3781   raise EglBitmap.Create('mapping for compressed formats is not supported');
3782 end;
3783
3784 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3785 begin
3786   raise EglBitmap.Create('mapping for compressed formats is not supported');
3787 end;
3788
3789 procedure TfdS3tcDtx5RGBA.SetValues;
3790 begin
3791   inherited SetValues;
3792   fFormat           := tfS3tcDtx3RGBA;
3793   fWithAlpha        := tfS3tcDtx3RGBA;
3794   fUncompressed     := tfRGBA8ub4;
3795   fBitsPerPixel     := 8;
3796   fIsCompressed     := true;
3797 {$IFNDEF OPENGL_ES}
3798   fOpenGLFormat     := tfS3tcDtx3RGBA;
3799   fglFormat         := GL_COMPRESSED_RGBA;
3800   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3801   fglDataFormat     := GL_UNSIGNED_BYTE;
3802 {$ELSE}
3803   fOpenGLFormat     := fUncompressed;
3804 {$ENDIF}
3805 end;
3806
3807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3808 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3809 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3810 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3811 begin
3812   result := (fPrecision.r > 0);
3813 end;
3814
3815 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3816 begin
3817   result := (fPrecision.g > 0);
3818 end;
3819
3820 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3821 begin
3822   result := (fPrecision.b > 0);
3823 end;
3824
3825 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3826 begin
3827   result := (fPrecision.a > 0);
3828 end;
3829
3830 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3831 begin
3832   result := HasRed or HasGreen or HasBlue;
3833 end;
3834
3835 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3836 begin
3837   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3838 end;
3839
3840 procedure TglBitmapFormatDescriptor.SetValues;
3841 begin
3842   fFormat       := tfEmpty;
3843   fWithAlpha    := tfEmpty;
3844   fWithoutAlpha := tfEmpty;
3845   fOpenGLFormat := tfEmpty;
3846   fRGBInverted  := tfEmpty;
3847   fUncompressed := tfEmpty;
3848
3849   fBitsPerPixel := 0;
3850   fIsCompressed := false;
3851
3852   fglFormat         := 0;
3853   fglInternalFormat := 0;
3854   fglDataFormat     := 0;
3855
3856   FillChar(fPrecision, 0, SizeOf(fPrecision));
3857   FillChar(fShift,     0, SizeOf(fShift));
3858 end;
3859
3860 procedure TglBitmapFormatDescriptor.CalcValues;
3861 var
3862   i: Integer;
3863 begin
3864   fBytesPerPixel := fBitsPerPixel / 8;
3865   fChannelCount  := 0;
3866   for i := 0 to 3 do begin
3867     if (fPrecision.arr[i] > 0) then
3868       inc(fChannelCount);
3869     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3870     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3871   end;
3872 end;
3873
3874 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3875 var
3876   w, h: Integer;
3877 begin
3878   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3879     w := Max(1, aSize.X);
3880     h := Max(1, aSize.Y);
3881     result := GetSize(w, h);
3882   end else
3883     result := 0;
3884 end;
3885
3886 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3887 begin
3888   result := 0;
3889   if (aWidth <= 0) or (aHeight <= 0) then
3890     exit;
3891   result := Ceil(aWidth * aHeight * BytesPerPixel);
3892 end;
3893
3894 constructor TglBitmapFormatDescriptor.Create;
3895 begin
3896   inherited Create;
3897   SetValues;
3898   CalcValues;
3899 end;
3900
3901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3902 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3903 var
3904   f: TglBitmapFormat;
3905 begin
3906   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3907     result := TFormatDescriptor.Get(f);
3908     if (result.glInternalFormat = aInternalFormat) then
3909       exit;
3910   end;
3911   result := TFormatDescriptor.Get(tfEmpty);
3912 end;
3913
3914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3915 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3917 class procedure TFormatDescriptor.Init;
3918 begin
3919   if not Assigned(FormatDescriptorCS) then
3920     FormatDescriptorCS := TCriticalSection.Create;
3921 end;
3922
3923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3924 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3925 begin
3926   FormatDescriptorCS.Enter;
3927   try
3928     result := FormatDescriptors[aFormat];
3929     if not Assigned(result) then begin
3930       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3931       FormatDescriptors[aFormat] := result;
3932     end;
3933   finally
3934     FormatDescriptorCS.Leave;
3935   end;
3936 end;
3937
3938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3939 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3940 begin
3941   result := Get(Get(aFormat).WithAlpha);
3942 end;
3943
3944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3945 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3946 var
3947   ft: TglBitmapFormat;
3948 begin
3949   // find matching format with OpenGL support
3950   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3951     result := Get(ft);
3952     if (result.MaskMatch(aMask))      and
3953        (result.glFormat <> 0)         and
3954        (result.glInternalFormat <> 0) and
3955        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3956     then
3957       exit;
3958   end;
3959
3960   // find matching format without OpenGL Support
3961   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3962     result := Get(ft);
3963     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3964       exit;
3965   end;
3966
3967   result := TFormatDescriptor.Get(tfEmpty);
3968 end;
3969
3970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3971 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3972 var
3973   ft: TglBitmapFormat;
3974 begin
3975   // find matching format with OpenGL support
3976   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3977     result := Get(ft);
3978     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3979        glBitmapRec4ubCompare(result.Precision, aPrec) and
3980        (result.glFormat <> 0)         and
3981        (result.glInternalFormat <> 0) and
3982        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3983     then
3984       exit;
3985   end;
3986
3987   // find matching format without OpenGL Support
3988   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3989     result := Get(ft);
3990     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3991        glBitmapRec4ubCompare(result.Precision, aPrec)  and
3992        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3993       exit;
3994   end;
3995
3996   result := TFormatDescriptor.Get(tfEmpty);
3997 end;
3998
3999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4000 class procedure TFormatDescriptor.Clear;
4001 var
4002   f: TglBitmapFormat;
4003 begin
4004   FormatDescriptorCS.Enter;
4005   try
4006     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4007       FreeAndNil(FormatDescriptors[f]);
4008   finally
4009     FormatDescriptorCS.Leave;
4010   end;
4011 end;
4012
4013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4014 class procedure TFormatDescriptor.Finalize;
4015 begin
4016   Clear;
4017   FreeAndNil(FormatDescriptorCS);
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4024 var
4025   i: Integer;
4026 begin
4027   for i := 0 to 3 do begin
4028     fShift.arr[i] := 0;
4029     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4030       aMask.arr[i] := aMask.arr[i] shr 1;
4031       inc(fShift.arr[i]);
4032     end;
4033     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4034   end;
4035   fBitsPerPixel := aBPP;
4036   CalcValues;
4037 end;
4038
4039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4040 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4041 begin
4042   fBitsPerPixel := aBBP;
4043   fPrecision    := aPrec;
4044   fShift        := aShift;
4045   CalcValues;
4046 end;
4047
4048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4049 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4050 var
4051   data: QWord;
4052 begin
4053   data :=
4054     ((aPixel.Data.r and Range.r) shl Shift.r) or
4055     ((aPixel.Data.g and Range.g) shl Shift.g) or
4056     ((aPixel.Data.b and Range.b) shl Shift.b) or
4057     ((aPixel.Data.a and Range.a) shl Shift.a);
4058   case BitsPerPixel of
4059     8:           aData^  := data;
4060    16:     PWord(aData)^ := data;
4061    32: PCardinal(aData)^ := data;
4062    64:    PQWord(aData)^ := data;
4063   else
4064     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4065   end;
4066   inc(aData, Round(BytesPerPixel));
4067 end;
4068
4069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4070 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4071 var
4072   data: QWord;
4073   i: Integer;
4074 begin
4075   case BitsPerPixel of
4076      8: data :=           aData^;
4077     16: data :=     PWord(aData)^;
4078     32: data := PCardinal(aData)^;
4079     64: data :=    PQWord(aData)^;
4080   else
4081     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4082   end;
4083   for i := 0 to 3 do
4084     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4085   inc(aData, Round(BytesPerPixel));
4086 end;
4087
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4091 procedure TbmpColorTableFormat.SetValues;
4092 begin
4093   inherited SetValues;
4094   fShift := glBitmapRec4ub(8, 8, 8, 0);
4095 end;
4096
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4099 begin
4100   fFormat       := aFormat;
4101   fBitsPerPixel := aBPP;
4102   fPrecision    := aPrec;
4103   fShift        := aShift;
4104   CalcValues;
4105 end;
4106
4107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4108 procedure TbmpColorTableFormat.CalcValues;
4109 begin
4110   inherited CalcValues;
4111 end;
4112
4113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4114 procedure TbmpColorTableFormat.CreateColorTable;
4115 var
4116   i: Integer;
4117 begin
4118   SetLength(fColorTable, 256);
4119   if not HasColor then begin
4120     // alpha
4121     for i := 0 to High(fColorTable) do begin
4122       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4123       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4124       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4125       fColorTable[i].a := 0;
4126     end;
4127   end else begin
4128     // normal
4129     for i := 0 to High(fColorTable) do begin
4130       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4131       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4132       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4133       fColorTable[i].a := 0;
4134     end;
4135   end;
4136 end;
4137
4138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4139 function TbmpColorTableFormat.CreateMappingData: Pointer;
4140 begin
4141   result := Pointer(0);
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4146 begin
4147   if (BitsPerPixel <> 8) then
4148     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4149   if not HasColor then
4150     // alpha
4151     aData^ := aPixel.Data.a
4152   else
4153     // normal
4154     aData^ := Round(
4155       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4156       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4157       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4158   inc(aData);
4159 end;
4160
4161 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4162 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4163
4164   function ReadValue: Byte;
4165   var
4166     i: PtrUInt;
4167   begin
4168     if (BitsPerPixel = 8) then begin
4169       result := aData^;
4170       inc(aData);
4171     end else begin
4172       i := {%H-}PtrUInt(aMapData);
4173       if (BitsPerPixel > 1) then
4174         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4175       else
4176         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4177       inc(i, BitsPerPixel);
4178       while (i >= 8) do begin
4179         inc(aData);
4180         dec(i, 8);
4181       end;
4182       aMapData := {%H-}Pointer(i);
4183     end;
4184   end;
4185
4186 begin
4187   if (BitsPerPixel > 8) then
4188     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4189   with fColorTable[ReadValue] do begin
4190     aPixel.Data.r := r;
4191     aPixel.Data.g := g;
4192     aPixel.Data.b := b;
4193     aPixel.Data.a := a;
4194   end;
4195 end;
4196
4197 destructor TbmpColorTableFormat.Destroy;
4198 begin
4199   SetLength(fColorTable, 0);
4200   inherited Destroy;
4201 end;
4202
4203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4204 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4206 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4207 var
4208   i: Integer;
4209 begin
4210   for i := 0 to 3 do begin
4211     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4212       if (aSourceFD.Range.arr[i] > 0) then
4213         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4214       else
4215         aPixel.Data.arr[i] := 0;
4216     end;
4217   end;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4222 begin
4223   with aFuncRec do begin
4224     if (Source.Range.r   > 0) then
4225       Dest.Data.r := Source.Data.r;
4226     if (Source.Range.g > 0) then
4227       Dest.Data.g := Source.Data.g;
4228     if (Source.Range.b  > 0) then
4229       Dest.Data.b := Source.Data.b;
4230     if (Source.Range.a > 0) then
4231       Dest.Data.a := Source.Data.a;
4232   end;
4233 end;
4234
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4237 var
4238   i: Integer;
4239 begin
4240   with aFuncRec do begin
4241     for i := 0 to 3 do
4242       if (Source.Range.arr[i] > 0) then
4243         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4244   end;
4245 end;
4246
4247 type
4248   TShiftData = packed record
4249     case Integer of
4250       0: (r, g, b, a: SmallInt);
4251       1: (arr: array[0..3] of SmallInt);
4252   end;
4253   PShiftData = ^TShiftData;
4254
4255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4256 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4257 var
4258   i: Integer;
4259 begin
4260   with aFuncRec do
4261     for i := 0 to 3 do
4262       if (Source.Range.arr[i] > 0) then
4263         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4264 end;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4268 var
4269   i: Integer;
4270 begin
4271   with aFuncRec do begin
4272     Dest.Data := Source.Data;
4273     for i := 0 to 3 do
4274       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4275         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4276   end;
4277 end;
4278
4279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4280 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4281 var
4282   i: Integer;
4283 begin
4284   with aFuncRec do begin
4285     for i := 0 to 3 do
4286       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4287   end;
4288 end;
4289
4290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4291 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4292 var
4293   Temp: Single;
4294 begin
4295   with FuncRec do begin
4296     if (FuncRec.Args = nil) then begin //source has no alpha
4297       Temp :=
4298         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4299         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4300         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4301       Dest.Data.a := Round(Dest.Range.a * Temp);
4302     end else
4303       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4304   end;
4305 end;
4306
4307 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4308 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4309 type
4310   PglBitmapPixelData = ^TglBitmapPixelData;
4311 begin
4312   with FuncRec do begin
4313     Dest.Data.r := Source.Data.r;
4314     Dest.Data.g := Source.Data.g;
4315     Dest.Data.b := Source.Data.b;
4316
4317     with PglBitmapPixelData(Args)^ do
4318       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4319           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4320           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4321         Dest.Data.a := 0
4322       else
4323         Dest.Data.a := Dest.Range.a;
4324   end;
4325 end;
4326
4327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4328 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4329 begin
4330   with FuncRec do begin
4331     Dest.Data.r := Source.Data.r;
4332     Dest.Data.g := Source.Data.g;
4333     Dest.Data.b := Source.Data.b;
4334     Dest.Data.a := PCardinal(Args)^;
4335   end;
4336 end;
4337
4338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4339 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4340 type
4341   PRGBPix = ^TRGBPix;
4342   TRGBPix = array [0..2] of byte;
4343 var
4344   Temp: Byte;
4345 begin
4346   while aWidth > 0 do begin
4347     Temp := PRGBPix(aData)^[0];
4348     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4349     PRGBPix(aData)^[2] := Temp;
4350
4351     if aHasAlpha then
4352       Inc(aData, 4)
4353     else
4354       Inc(aData, 3);
4355     dec(aWidth);
4356   end;
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4362 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4363 begin
4364   result := TFormatDescriptor.Get(fFormat);
4365 end;
4366
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 function TglBitmapData.GetWidth: Integer;
4369 begin
4370   if (ffX in fDimension.Fields) then
4371     result := fDimension.X
4372   else
4373     result := -1;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmapData.GetHeight: Integer;
4378 begin
4379   if (ffY in fDimension.Fields) then
4380     result := fDimension.Y
4381   else
4382     result := -1;
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4387 begin
4388   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4389     result := fScanlines[aIndex]
4390   else
4391     result := nil;
4392 end;
4393
4394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4395 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4396 begin
4397   if fFormat = aValue then
4398     exit;
4399   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4400     raise EglBitmapUnsupportedFormat.Create(Format);
4401   SetData(fData, aValue, Width, Height);
4402 end;
4403
4404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4405 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4406 var
4407   TempPos: Integer;
4408 begin
4409   if not Assigned(aResType) then begin
4410     TempPos   := Pos('.', aResource);
4411     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4412     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4413   end;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 procedure TglBitmapData.UpdateScanlines;
4418 var
4419   w, h, i, LineWidth: Integer;
4420 begin
4421   w := Width;
4422   h := Height;
4423   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4424   if fHasScanlines then begin
4425     SetLength(fScanlines, h);
4426     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4427     for i := 0 to h-1 do begin
4428       fScanlines[i] := fData;
4429       Inc(fScanlines[i], i * LineWidth);
4430     end;
4431   end else
4432     SetLength(fScanlines, 0);
4433 end;
4434
4435 {$IFDEF GLB_SUPPORT_PNG_READ}
4436 {$IF DEFINED(GLB_LAZ_PNG)}
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4440 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4441 const
4442   MAGIC_LEN = 8;
4443   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4444 var
4445   reader: TLazReaderPNG;
4446   intf: TLazIntfImage;
4447   StreamPos: Int64;
4448   magic: String[MAGIC_LEN];
4449 begin
4450   result := true;
4451   StreamPos := aStream.Position;
4452
4453   SetLength(magic, MAGIC_LEN);
4454   aStream.Read(magic[1], MAGIC_LEN);
4455   aStream.Position := StreamPos;
4456   if (magic <> PNG_MAGIC) then begin
4457     result := false;
4458     exit;
4459   end;
4460
4461   intf   := TLazIntfImage.Create(0, 0);
4462   reader := TLazReaderPNG.Create;
4463   try try
4464     reader.UpdateDescription := true;
4465     reader.ImageRead(aStream, intf);
4466     AssignFromLazIntfImage(intf);
4467   except
4468     result := false;
4469     aStream.Position := StreamPos;
4470     exit;
4471   end;
4472   finally
4473     reader.Free;
4474     intf.Free;
4475   end;
4476 end;
4477
4478 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4480 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4481 var
4482   Surface: PSDL_Surface;
4483   RWops: PSDL_RWops;
4484 begin
4485   result := false;
4486   RWops := glBitmapCreateRWops(aStream);
4487   try
4488     if IMG_isPNG(RWops) > 0 then begin
4489       Surface := IMG_LoadPNG_RW(RWops);
4490       try
4491         AssignFromSurface(Surface);
4492         result := true;
4493       finally
4494         SDL_FreeSurface(Surface);
4495       end;
4496     end;
4497   finally
4498     SDL_FreeRW(RWops);
4499   end;
4500 end;
4501
4502 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4504 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4505 begin
4506   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4507 end;
4508
4509 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4510 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4511 var
4512   StreamPos: Int64;
4513   signature: array [0..7] of byte;
4514   png: png_structp;
4515   png_info: png_infop;
4516
4517   TempHeight, TempWidth: Integer;
4518   Format: TglBitmapFormat;
4519
4520   png_data: pByte;
4521   png_rows: array of pByte;
4522   Row, LineSize: Integer;
4523 begin
4524   result := false;
4525
4526   if not init_libPNG then
4527     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4528
4529   try
4530     // signature
4531     StreamPos := aStream.Position;
4532     aStream.Read(signature{%H-}, 8);
4533     aStream.Position := StreamPos;
4534
4535     if png_check_sig(@signature, 8) <> 0 then begin
4536       // png read struct
4537       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4538       if png = nil then
4539         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4540
4541       // png info
4542       png_info := png_create_info_struct(png);
4543       if png_info = nil then begin
4544         png_destroy_read_struct(@png, nil, nil);
4545         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4546       end;
4547
4548       // set read callback
4549       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4550
4551       // read informations
4552       png_read_info(png, png_info);
4553
4554       // size
4555       TempHeight := png_get_image_height(png, png_info);
4556       TempWidth := png_get_image_width(png, png_info);
4557
4558       // format
4559       case png_get_color_type(png, png_info) of
4560         PNG_COLOR_TYPE_GRAY:
4561           Format := tfLuminance8ub1;
4562         PNG_COLOR_TYPE_GRAY_ALPHA:
4563           Format := tfLuminance8Alpha8us1;
4564         PNG_COLOR_TYPE_RGB:
4565           Format := tfRGB8ub3;
4566         PNG_COLOR_TYPE_RGB_ALPHA:
4567           Format := tfRGBA8ub4;
4568         else
4569           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4570       end;
4571
4572       // cut upper 8 bit from 16 bit formats
4573       if png_get_bit_depth(png, png_info) > 8 then
4574         png_set_strip_16(png);
4575
4576       // expand bitdepth smaller than 8
4577       if png_get_bit_depth(png, png_info) < 8 then
4578         png_set_expand(png);
4579
4580       // allocating mem for scanlines
4581       LineSize := png_get_rowbytes(png, png_info);
4582       GetMem(png_data, TempHeight * LineSize);
4583       try
4584         SetLength(png_rows, TempHeight);
4585         for Row := Low(png_rows) to High(png_rows) do begin
4586           png_rows[Row] := png_data;
4587           Inc(png_rows[Row], Row * LineSize);
4588         end;
4589
4590         // read complete image into scanlines
4591         png_read_image(png, @png_rows[0]);
4592
4593         // read end
4594         png_read_end(png, png_info);
4595
4596         // destroy read struct
4597         png_destroy_read_struct(@png, @png_info, nil);
4598
4599         SetLength(png_rows, 0);
4600
4601         // set new data
4602         SetData(png_data, Format, TempWidth, TempHeight);
4603
4604         result := true;
4605       except
4606         if Assigned(png_data) then
4607           FreeMem(png_data);
4608         raise;
4609       end;
4610     end;
4611   finally
4612     quit_libPNG;
4613   end;
4614 end;
4615
4616 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4618 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4619 var
4620   StreamPos: Int64;
4621   Png: TPNGObject;
4622   Header: String[8];
4623   Row, Col, PixSize, LineSize: Integer;
4624   NewImage, pSource, pDest, pAlpha: pByte;
4625   PngFormat: TglBitmapFormat;
4626   FormatDesc: TFormatDescriptor;
4627
4628 const
4629   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4630
4631 begin
4632   result := false;
4633
4634   StreamPos := aStream.Position;
4635   aStream.Read(Header[0], SizeOf(Header));
4636   aStream.Position := StreamPos;
4637
4638   {Test if the header matches}
4639   if Header = PngHeader then begin
4640     Png := TPNGObject.Create;
4641     try
4642       Png.LoadFromStream(aStream);
4643
4644       case Png.Header.ColorType of
4645         COLOR_GRAYSCALE:
4646           PngFormat := tfLuminance8ub1;
4647         COLOR_GRAYSCALEALPHA:
4648           PngFormat := tfLuminance8Alpha8us1;
4649         COLOR_RGB:
4650           PngFormat := tfBGR8ub3;
4651         COLOR_RGBALPHA:
4652           PngFormat := tfBGRA8ub4;
4653         else
4654           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4655       end;
4656
4657       FormatDesc := TFormatDescriptor.Get(PngFormat);
4658       PixSize    := Round(FormatDesc.PixelSize);
4659       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4660
4661       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4662       try
4663         pDest := NewImage;
4664
4665         case Png.Header.ColorType of
4666           COLOR_RGB, COLOR_GRAYSCALE:
4667             begin
4668               for Row := 0 to Png.Height -1 do begin
4669                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4670                 Inc(pDest, LineSize);
4671               end;
4672             end;
4673           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4674             begin
4675               PixSize := PixSize -1;
4676
4677               for Row := 0 to Png.Height -1 do begin
4678                 pSource := Png.Scanline[Row];
4679                 pAlpha := pByte(Png.AlphaScanline[Row]);
4680
4681                 for Col := 0 to Png.Width -1 do begin
4682                   Move (pSource^, pDest^, PixSize);
4683                   Inc(pSource, PixSize);
4684                   Inc(pDest, PixSize);
4685
4686                   pDest^ := pAlpha^;
4687                   inc(pAlpha);
4688                   Inc(pDest);
4689                 end;
4690               end;
4691             end;
4692           else
4693             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4694         end;
4695
4696         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4697
4698         result := true;
4699       except
4700         if Assigned(NewImage) then
4701           FreeMem(NewImage);
4702         raise;
4703       end;
4704     finally
4705       Png.Free;
4706     end;
4707   end;
4708 end;
4709 {$IFEND}
4710 {$ENDIF}
4711
4712 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4713 {$IFDEF GLB_LIB_PNG}
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4716 begin
4717   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4718 end;
4719 {$ENDIF}
4720
4721 {$IF DEFINED(GLB_LAZ_PNG)}
4722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4723 procedure TglBitmapData.SavePNG(const aStream: TStream);
4724 var
4725   png: TPortableNetworkGraphic;
4726   intf: TLazIntfImage;
4727   raw: TRawImage;
4728 begin
4729   png  := TPortableNetworkGraphic.Create;
4730   intf := TLazIntfImage.Create(0, 0);
4731   try
4732     if not AssignToLazIntfImage(intf) then
4733       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4734     intf.GetRawImage(raw);
4735     png.LoadFromRawImage(raw, false);
4736     png.SaveToStream(aStream);
4737   finally
4738     png.Free;
4739     intf.Free;
4740   end;
4741 end;
4742
4743 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4745 procedure TglBitmapData.SavePNG(const aStream: TStream);
4746 var
4747   png: png_structp;
4748   png_info: png_infop;
4749   png_rows: array of pByte;
4750   LineSize: Integer;
4751   ColorType: Integer;
4752   Row: Integer;
4753   FormatDesc: TFormatDescriptor;
4754 begin
4755   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4756     raise EglBitmapUnsupportedFormat.Create(Format);
4757
4758   if not init_libPNG then
4759     raise Exception.Create('unable to initialize libPNG.');
4760
4761   try
4762     case Format of
4763       tfAlpha8ub1, tfLuminance8ub1:
4764         ColorType := PNG_COLOR_TYPE_GRAY;
4765       tfLuminance8Alpha8us1:
4766         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4767       tfBGR8ub3, tfRGB8ub3:
4768         ColorType := PNG_COLOR_TYPE_RGB;
4769       tfBGRA8ub4, tfRGBA8ub4:
4770         ColorType := PNG_COLOR_TYPE_RGBA;
4771       else
4772         raise EglBitmapUnsupportedFormat.Create(Format);
4773     end;
4774
4775     FormatDesc := TFormatDescriptor.Get(Format);
4776     LineSize := FormatDesc.GetSize(Width, 1);
4777
4778     // creating array for scanline
4779     SetLength(png_rows, Height);
4780     try
4781       for Row := 0 to Height - 1 do begin
4782         png_rows[Row] := Data;
4783         Inc(png_rows[Row], Row * LineSize)
4784       end;
4785
4786       // write struct
4787       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4788       if png = nil then
4789         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4790
4791       // create png info
4792       png_info := png_create_info_struct(png);
4793       if png_info = nil then begin
4794         png_destroy_write_struct(@png, nil);
4795         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4796       end;
4797
4798       // set read callback
4799       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4800
4801       // set compression
4802       png_set_compression_level(png, 6);
4803
4804       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4805         png_set_bgr(png);
4806
4807       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4808       png_write_info(png, png_info);
4809       png_write_image(png, @png_rows[0]);
4810       png_write_end(png, png_info);
4811       png_destroy_write_struct(@png, @png_info);
4812     finally
4813       SetLength(png_rows, 0);
4814     end;
4815   finally
4816     quit_libPNG;
4817   end;
4818 end;
4819
4820 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4822 procedure TglBitmapData.SavePNG(const aStream: TStream);
4823 var
4824   Png: TPNGObject;
4825
4826   pSource, pDest: pByte;
4827   X, Y, PixSize: Integer;
4828   ColorType: Cardinal;
4829   Alpha: Boolean;
4830
4831   pTemp: pByte;
4832   Temp: Byte;
4833 begin
4834   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4835     raise EglBitmapUnsupportedFormat.Create(Format);
4836
4837   case Format of
4838     tfAlpha8ub1, tfLuminance8ub1: begin
4839       ColorType := COLOR_GRAYSCALE;
4840       PixSize   := 1;
4841       Alpha     := false;
4842     end;
4843     tfLuminance8Alpha8us1: begin
4844       ColorType := COLOR_GRAYSCALEALPHA;
4845       PixSize   := 1;
4846       Alpha     := true;
4847     end;
4848     tfBGR8ub3, tfRGB8ub3: begin
4849       ColorType := COLOR_RGB;
4850       PixSize   := 3;
4851       Alpha     := false;
4852     end;
4853     tfBGRA8ub4, tfRGBA8ub4: begin
4854       ColorType := COLOR_RGBALPHA;
4855       PixSize   := 3;
4856       Alpha     := true
4857     end;
4858   else
4859     raise EglBitmapUnsupportedFormat.Create(Format);
4860   end;
4861
4862   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4863   try
4864     // Copy ImageData
4865     pSource := Data;
4866     for Y := 0 to Height -1 do begin
4867       pDest := png.ScanLine[Y];
4868       for X := 0 to Width -1 do begin
4869         Move(pSource^, pDest^, PixSize);
4870         Inc(pDest, PixSize);
4871         Inc(pSource, PixSize);
4872         if Alpha then begin
4873           png.AlphaScanline[Y]^[X] := pSource^;
4874           Inc(pSource);
4875         end;
4876       end;
4877
4878       // convert RGB line to BGR
4879       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4880         pTemp := png.ScanLine[Y];
4881         for X := 0 to Width -1 do begin
4882           Temp := pByteArray(pTemp)^[0];
4883           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4884           pByteArray(pTemp)^[2] := Temp;
4885           Inc(pTemp, 3);
4886         end;
4887       end;
4888     end;
4889
4890     // Save to Stream
4891     Png.CompressionLevel := 6;
4892     Png.SaveToStream(aStream);
4893   finally
4894     FreeAndNil(Png);
4895   end;
4896 end;
4897 {$IFEND}
4898 {$ENDIF}
4899
4900 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4901 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4903 {$IFDEF GLB_LIB_JPEG}
4904 type
4905   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4906   glBitmap_libJPEG_source_mgr = record
4907     pub: jpeg_source_mgr;
4908
4909     SrcStream: TStream;
4910     SrcBuffer: array [1..4096] of byte;
4911   end;
4912
4913   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4914   glBitmap_libJPEG_dest_mgr = record
4915     pub: jpeg_destination_mgr;
4916
4917     DestStream: TStream;
4918     DestBuffer: array [1..4096] of byte;
4919   end;
4920
4921 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4922 begin
4923   //DUMMY
4924 end;
4925
4926
4927 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4928 begin
4929   //DUMMY
4930 end;
4931
4932
4933 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4934 begin
4935   //DUMMY
4936 end;
4937
4938 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4939 begin
4940   //DUMMY
4941 end;
4942
4943
4944 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4945 begin
4946   //DUMMY
4947 end;
4948
4949
4950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4951 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4952 var
4953   src: glBitmap_libJPEG_source_mgr_ptr;
4954   bytes: integer;
4955 begin
4956   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4957
4958   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4959         if (bytes <= 0) then begin
4960                 src^.SrcBuffer[1] := $FF;
4961                 src^.SrcBuffer[2] := JPEG_EOI;
4962                 bytes := 2;
4963         end;
4964
4965         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4966         src^.pub.bytes_in_buffer := bytes;
4967
4968   result := true;
4969 end;
4970
4971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4972 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4973 var
4974   src: glBitmap_libJPEG_source_mgr_ptr;
4975 begin
4976   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4977
4978   if num_bytes > 0 then begin
4979     // wanted byte isn't in buffer so set stream position and read buffer
4980     if num_bytes > src^.pub.bytes_in_buffer then begin
4981       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
4982       src^.pub.fill_input_buffer(cinfo);
4983     end else begin
4984       // wanted byte is in buffer so only skip
4985                 inc(src^.pub.next_input_byte, num_bytes);
4986                 dec(src^.pub.bytes_in_buffer, num_bytes);
4987     end;
4988   end;
4989 end;
4990
4991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4992 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
4993 var
4994   dest: glBitmap_libJPEG_dest_mgr_ptr;
4995 begin
4996   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
4997
4998   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
4999     // write complete buffer
5000     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5001
5002     // reset buffer
5003     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5004     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5005   end;
5006
5007   result := true;
5008 end;
5009
5010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5011 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5012 var
5013   Idx: Integer;
5014   dest: glBitmap_libJPEG_dest_mgr_ptr;
5015 begin
5016   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5017
5018   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5019     // check for endblock
5020     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5021       // write endblock
5022       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5023
5024       // leave
5025       break;
5026     end else
5027       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5028   end;
5029 end;
5030 {$ENDIF}
5031
5032 {$IFDEF GLB_SUPPORT_JPEG_READ}
5033 {$IF DEFINED(GLB_LAZ_JPEG)}
5034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5035 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5036 const
5037   MAGIC_LEN = 2;
5038   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5039 var
5040   intf: TLazIntfImage;
5041   reader: TFPReaderJPEG;
5042   StreamPos: Int64;
5043   magic: String[MAGIC_LEN];
5044 begin
5045   result := true;
5046   StreamPos := aStream.Position;
5047
5048   SetLength(magic, MAGIC_LEN);
5049   aStream.Read(magic[1], MAGIC_LEN);
5050   aStream.Position := StreamPos;
5051   if (magic <> JPEG_MAGIC) then begin
5052     result := false;
5053     exit;
5054   end;
5055
5056   reader := TFPReaderJPEG.Create;
5057   intf := TLazIntfImage.Create(0, 0);
5058   try try
5059     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5060     reader.ImageRead(aStream, intf);
5061     AssignFromLazIntfImage(intf);
5062   except
5063     result := false;
5064     aStream.Position := StreamPos;
5065     exit;
5066   end;
5067   finally
5068     reader.Free;
5069     intf.Free;
5070   end;
5071 end;
5072
5073 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5075 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5076 var
5077   Surface: PSDL_Surface;
5078   RWops: PSDL_RWops;
5079 begin
5080   result := false;
5081
5082   RWops := glBitmapCreateRWops(aStream);
5083   try
5084     if IMG_isJPG(RWops) > 0 then begin
5085       Surface := IMG_LoadJPG_RW(RWops);
5086       try
5087         AssignFromSurface(Surface);
5088         result := true;
5089       finally
5090         SDL_FreeSurface(Surface);
5091       end;
5092     end;
5093   finally
5094     SDL_FreeRW(RWops);
5095   end;
5096 end;
5097
5098 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5100 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5101 var
5102   StreamPos: Int64;
5103   Temp: array[0..1]of Byte;
5104
5105   jpeg: jpeg_decompress_struct;
5106   jpeg_err: jpeg_error_mgr;
5107
5108   IntFormat: TglBitmapFormat;
5109   pImage: pByte;
5110   TempHeight, TempWidth: Integer;
5111
5112   pTemp: pByte;
5113   Row: Integer;
5114
5115   FormatDesc: TFormatDescriptor;
5116 begin
5117   result := false;
5118
5119   if not init_libJPEG then
5120     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5121
5122   try
5123     // reading first two bytes to test file and set cursor back to begin
5124     StreamPos := aStream.Position;
5125     aStream.Read({%H-}Temp[0], 2);
5126     aStream.Position := StreamPos;
5127
5128     // if Bitmap then read file.
5129     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5130       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5131       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5132
5133       // error managment
5134       jpeg.err := jpeg_std_error(@jpeg_err);
5135       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5136       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5137
5138       // decompression struct
5139       jpeg_create_decompress(@jpeg);
5140
5141       // allocation space for streaming methods
5142       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5143
5144       // seeting up custom functions
5145       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5146         pub.init_source       := glBitmap_libJPEG_init_source;
5147         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5148         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5149         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5150         pub.term_source       := glBitmap_libJPEG_term_source;
5151
5152         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5153         pub.next_input_byte := nil;   // until buffer loaded
5154
5155         SrcStream := aStream;
5156       end;
5157
5158       // set global decoding state
5159       jpeg.global_state := DSTATE_START;
5160
5161       // read header of jpeg
5162       jpeg_read_header(@jpeg, false);
5163
5164       // setting output parameter
5165       case jpeg.jpeg_color_space of
5166         JCS_GRAYSCALE:
5167           begin
5168             jpeg.out_color_space := JCS_GRAYSCALE;
5169             IntFormat := tfLuminance8ub1;
5170           end;
5171         else
5172           jpeg.out_color_space := JCS_RGB;
5173           IntFormat := tfRGB8ub3;
5174       end;
5175
5176       // reading image
5177       jpeg_start_decompress(@jpeg);
5178
5179       TempHeight := jpeg.output_height;
5180       TempWidth := jpeg.output_width;
5181
5182       FormatDesc := TFormatDescriptor.Get(IntFormat);
5183
5184       // creating new image
5185       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5186       try
5187         pTemp := pImage;
5188
5189         for Row := 0 to TempHeight -1 do begin
5190           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5191           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5192         end;
5193
5194         // finish decompression
5195         jpeg_finish_decompress(@jpeg);
5196
5197         // destroy decompression
5198         jpeg_destroy_decompress(@jpeg);
5199
5200         SetData(pImage, IntFormat, TempWidth, TempHeight);
5201
5202         result := true;
5203       except
5204         if Assigned(pImage) then
5205           FreeMem(pImage);
5206         raise;
5207       end;
5208     end;
5209   finally
5210     quit_libJPEG;
5211   end;
5212 end;
5213
5214 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5216 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5217 var
5218   bmp: TBitmap;
5219   jpg: TJPEGImage;
5220   StreamPos: Int64;
5221   Temp: array[0..1]of Byte;
5222 begin
5223   result := false;
5224
5225   // reading first two bytes to test file and set cursor back to begin
5226   StreamPos := aStream.Position;
5227   aStream.Read(Temp[0], 2);
5228   aStream.Position := StreamPos;
5229
5230   // if Bitmap then read file.
5231   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5232     bmp := TBitmap.Create;
5233     try
5234       jpg := TJPEGImage.Create;
5235       try
5236         jpg.LoadFromStream(aStream);
5237         bmp.Assign(jpg);
5238         result := AssignFromBitmap(bmp);
5239       finally
5240         jpg.Free;
5241       end;
5242     finally
5243       bmp.Free;
5244     end;
5245   end;
5246 end;
5247 {$IFEND}
5248 {$ENDIF}
5249
5250 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5251 {$IF DEFINED(GLB_LAZ_JPEG)}
5252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5253 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5254 var
5255   jpeg: TJPEGImage;
5256   intf: TLazIntfImage;
5257   raw: TRawImage;
5258 begin
5259   jpeg := TJPEGImage.Create;
5260   intf := TLazIntfImage.Create(0, 0);
5261   try
5262     if not AssignToLazIntfImage(intf) then
5263       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5264     intf.GetRawImage(raw);
5265     jpeg.LoadFromRawImage(raw, false);
5266     jpeg.SaveToStream(aStream);
5267   finally
5268     intf.Free;
5269     jpeg.Free;
5270   end;
5271 end;
5272
5273 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5275 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5276 var
5277   jpeg: jpeg_compress_struct;
5278   jpeg_err: jpeg_error_mgr;
5279   Row: Integer;
5280   pTemp, pTemp2: pByte;
5281
5282   procedure CopyRow(pDest, pSource: pByte);
5283   var
5284     X: Integer;
5285   begin
5286     for X := 0 to Width - 1 do begin
5287       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5288       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5289       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5290       Inc(pDest, 3);
5291       Inc(pSource, 3);
5292     end;
5293   end;
5294
5295 begin
5296   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5297     raise EglBitmapUnsupportedFormat.Create(Format);
5298
5299   if not init_libJPEG then
5300     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5301
5302   try
5303     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5304     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5305
5306     // error managment
5307     jpeg.err := jpeg_std_error(@jpeg_err);
5308     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5309     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5310
5311     // compression struct
5312     jpeg_create_compress(@jpeg);
5313
5314     // allocation space for streaming methods
5315     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5316
5317     // seeting up custom functions
5318     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5319       pub.init_destination    := glBitmap_libJPEG_init_destination;
5320       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5321       pub.term_destination    := glBitmap_libJPEG_term_destination;
5322
5323       pub.next_output_byte  := @DestBuffer[1];
5324       pub.free_in_buffer    := Length(DestBuffer);
5325
5326       DestStream := aStream;
5327     end;
5328
5329     // very important state
5330     jpeg.global_state := CSTATE_START;
5331     jpeg.image_width  := Width;
5332     jpeg.image_height := Height;
5333     case Format of
5334       tfAlpha8ub1, tfLuminance8ub1: begin
5335         jpeg.input_components := 1;
5336         jpeg.in_color_space   := JCS_GRAYSCALE;
5337       end;
5338       tfRGB8ub3, tfBGR8ub3: begin
5339         jpeg.input_components := 3;
5340         jpeg.in_color_space   := JCS_RGB;
5341       end;
5342     end;
5343
5344     jpeg_set_defaults(@jpeg);
5345     jpeg_set_quality(@jpeg, 95, true);
5346     jpeg_start_compress(@jpeg, true);
5347     pTemp := Data;
5348
5349     if Format = tfBGR8ub3 then
5350       GetMem(pTemp2, fRowSize)
5351     else
5352       pTemp2 := pTemp;
5353
5354     try
5355       for Row := 0 to jpeg.image_height -1 do begin
5356         // prepare row
5357         if Format = tfBGR8ub3 then
5358           CopyRow(pTemp2, pTemp)
5359         else
5360           pTemp2 := pTemp;
5361
5362         // write row
5363         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5364         inc(pTemp, fRowSize);
5365       end;
5366     finally
5367       // free memory
5368       if Format = tfBGR8ub3 then
5369         FreeMem(pTemp2);
5370     end;
5371     jpeg_finish_compress(@jpeg);
5372     jpeg_destroy_compress(@jpeg);
5373   finally
5374     quit_libJPEG;
5375   end;
5376 end;
5377
5378 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5380 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5381 var
5382   Bmp: TBitmap;
5383   Jpg: TJPEGImage;
5384 begin
5385   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5386     raise EglBitmapUnsupportedFormat.Create(Format);
5387
5388   Bmp := TBitmap.Create;
5389   try
5390     Jpg := TJPEGImage.Create;
5391     try
5392       AssignToBitmap(Bmp);
5393       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5394         Jpg.Grayscale   := true;
5395         Jpg.PixelFormat := jf8Bit;
5396       end;
5397       Jpg.Assign(Bmp);
5398       Jpg.SaveToStream(aStream);
5399     finally
5400       FreeAndNil(Jpg);
5401     end;
5402   finally
5403     FreeAndNil(Bmp);
5404   end;
5405 end;
5406 {$IFEND}
5407 {$ENDIF}
5408
5409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5410 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5411 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5412 type
5413   RawHeader = packed record
5414     Magic:        String[5];
5415     Version:      Byte;
5416     Width:        Integer;
5417     Height:       Integer;
5418     DataSize:     Integer;
5419     BitsPerPixel: Integer;
5420     Precision:    TglBitmapRec4ub;
5421     Shift:        TglBitmapRec4ub;
5422   end;
5423
5424 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5425 var
5426   header: RawHeader;
5427   StartPos: Int64;
5428   fd: TFormatDescriptor;
5429   buf: PByte;
5430 begin
5431   result := false;
5432   StartPos := aStream.Position;
5433   aStream.Read(header{%H-}, SizeOf(header));
5434   if (header.Magic <> 'glBMP') then begin
5435     aStream.Position := StartPos;
5436     exit;
5437   end;
5438
5439   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5440   if (fd.Format = tfEmpty) then
5441     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5442
5443   buf := GetMemory(header.DataSize);
5444   aStream.Read(buf^, header.DataSize);
5445   SetData(buf, fd.Format, header.Width, header.Height);
5446
5447   result := true;
5448 end;
5449
5450 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5451 var
5452   header: RawHeader;
5453   fd: TFormatDescriptor;
5454 begin
5455   fd := TFormatDescriptor.Get(Format);
5456   header.Magic        := 'glBMP';
5457   header.Version      := 1;
5458   header.Width        := Width;
5459   header.Height       := Height;
5460   header.DataSize     := fd.GetSize(fDimension);
5461   header.BitsPerPixel := fd.BitsPerPixel;
5462   header.Precision    := fd.Precision;
5463   header.Shift        := fd.Shift;
5464   aStream.Write(header, SizeOf(header));
5465   aStream.Write(Data^,  header.DataSize);
5466 end;
5467
5468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5469 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5471 const
5472   BMP_MAGIC          = $4D42;
5473
5474   BMP_COMP_RGB       = 0;
5475   BMP_COMP_RLE8      = 1;
5476   BMP_COMP_RLE4      = 2;
5477   BMP_COMP_BITFIELDS = 3;
5478
5479 type
5480   TBMPHeader = packed record
5481     bfType: Word;
5482     bfSize: Cardinal;
5483     bfReserved1: Word;
5484     bfReserved2: Word;
5485     bfOffBits: Cardinal;
5486   end;
5487
5488   TBMPInfo = packed record
5489     biSize: Cardinal;
5490     biWidth: Longint;
5491     biHeight: Longint;
5492     biPlanes: Word;
5493     biBitCount: Word;
5494     biCompression: Cardinal;
5495     biSizeImage: Cardinal;
5496     biXPelsPerMeter: Longint;
5497     biYPelsPerMeter: Longint;
5498     biClrUsed: Cardinal;
5499     biClrImportant: Cardinal;
5500   end;
5501
5502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5503 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5504
5505   //////////////////////////////////////////////////////////////////////////////////////////////////
5506   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5507   var
5508     tmp, i: Cardinal;
5509   begin
5510     result := tfEmpty;
5511     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5512     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5513
5514     //Read Compression
5515     case aInfo.biCompression of
5516       BMP_COMP_RLE4,
5517       BMP_COMP_RLE8: begin
5518         raise EglBitmap.Create('RLE compression is not supported');
5519       end;
5520       BMP_COMP_BITFIELDS: begin
5521         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5522           for i := 0 to 2 do begin
5523             aStream.Read(tmp{%H-}, SizeOf(tmp));
5524             aMask.arr[i] := tmp;
5525           end;
5526         end else
5527           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5528       end;
5529     end;
5530
5531     //get suitable format
5532     case aInfo.biBitCount of
5533        8: result := tfLuminance8ub1;
5534       16: result := tfX1RGB5us1;
5535       24: result := tfBGR8ub3;
5536       32: result := tfXRGB8ui1;
5537     end;
5538   end;
5539
5540   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5541   var
5542     i, c: Integer;
5543     fd: TFormatDescriptor;
5544     ColorTable: TbmpColorTable;
5545   begin
5546     result := nil;
5547     if (aInfo.biBitCount >= 16) then
5548       exit;
5549     aFormat := tfLuminance8ub1;
5550     c := aInfo.biClrUsed;
5551     if (c = 0) then
5552       c := 1 shl aInfo.biBitCount;
5553     SetLength(ColorTable, c);
5554     for i := 0 to c-1 do begin
5555       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5556       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5557         aFormat := tfRGB8ub3;
5558     end;
5559
5560     fd := TFormatDescriptor.Get(aFormat);
5561     result := TbmpColorTableFormat.Create;
5562     result.ColorTable   := ColorTable;
5563     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5564   end;
5565
5566   //////////////////////////////////////////////////////////////////////////////////////////////////
5567   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5568   var
5569     fd: TFormatDescriptor;
5570   begin
5571     result := nil;
5572     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5573
5574       // find suitable format ...
5575       fd := TFormatDescriptor.GetFromMask(aMask);
5576       if (fd.Format <> tfEmpty) then begin
5577         aFormat := fd.Format;
5578         exit;
5579       end;
5580
5581       // or create custom bitfield format
5582       result := TbmpBitfieldFormat.Create;
5583       result.SetCustomValues(aInfo.biBitCount, aMask);
5584     end;
5585   end;
5586
5587 var
5588   //simple types
5589   StartPos: Int64;
5590   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5591   PaddingBuff: Cardinal;
5592   LineBuf, ImageData, TmpData: PByte;
5593   SourceMD, DestMD: Pointer;
5594   BmpFormat: TglBitmapFormat;
5595
5596   //records
5597   Mask: TglBitmapRec4ul;
5598   Header: TBMPHeader;
5599   Info: TBMPInfo;
5600
5601   //classes
5602   SpecialFormat: TFormatDescriptor;
5603   FormatDesc: TFormatDescriptor;
5604
5605   //////////////////////////////////////////////////////////////////////////////////////////////////
5606   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5607   var
5608     i: Integer;
5609     Pixel: TglBitmapPixelData;
5610   begin
5611     aStream.Read(aLineBuf^, rbLineSize);
5612     SpecialFormat.PreparePixel(Pixel);
5613     for i := 0 to Info.biWidth-1 do begin
5614       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5615       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5616       FormatDesc.Map(Pixel, aData, DestMD);
5617     end;
5618   end;
5619
5620 begin
5621   result        := false;
5622   BmpFormat     := tfEmpty;
5623   SpecialFormat := nil;
5624   LineBuf       := nil;
5625   SourceMD      := nil;
5626   DestMD        := nil;
5627
5628   // Header
5629   StartPos := aStream.Position;
5630   aStream.Read(Header{%H-}, SizeOf(Header));
5631
5632   if Header.bfType = BMP_MAGIC then begin
5633     try try
5634       BmpFormat        := ReadInfo(Info, Mask);
5635       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5636       if not Assigned(SpecialFormat) then
5637         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5638       aStream.Position := StartPos + Header.bfOffBits;
5639
5640       if (BmpFormat <> tfEmpty) then begin
5641         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5642         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5643         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5644         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5645
5646         //get Memory
5647         DestMD    := FormatDesc.CreateMappingData;
5648         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5649         GetMem(ImageData, ImageSize);
5650         if Assigned(SpecialFormat) then begin
5651           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5652           SourceMD := SpecialFormat.CreateMappingData;
5653         end;
5654
5655         //read Data
5656         try try
5657           FillChar(ImageData^, ImageSize, $FF);
5658           TmpData := ImageData;
5659           if (Info.biHeight > 0) then
5660             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5661           for i := 0 to Abs(Info.biHeight)-1 do begin
5662             if Assigned(SpecialFormat) then
5663               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5664             else
5665               aStream.Read(TmpData^, wbLineSize);   //else only read data
5666             if (Info.biHeight > 0) then
5667               dec(TmpData, wbLineSize)
5668             else
5669               inc(TmpData, wbLineSize);
5670             aStream.Read(PaddingBuff{%H-}, Padding);
5671           end;
5672           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5673           result := true;
5674         finally
5675           if Assigned(LineBuf) then
5676             FreeMem(LineBuf);
5677           if Assigned(SourceMD) then
5678             SpecialFormat.FreeMappingData(SourceMD);
5679           FormatDesc.FreeMappingData(DestMD);
5680         end;
5681         except
5682           if Assigned(ImageData) then
5683             FreeMem(ImageData);
5684           raise;
5685         end;
5686       end else
5687         raise EglBitmap.Create('LoadBMP - No suitable format found');
5688     except
5689       aStream.Position := StartPos;
5690       raise;
5691     end;
5692     finally
5693       FreeAndNil(SpecialFormat);
5694     end;
5695   end
5696     else aStream.Position := StartPos;
5697 end;
5698
5699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5700 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5701 var
5702   Header: TBMPHeader;
5703   Info: TBMPInfo;
5704   Converter: TFormatDescriptor;
5705   FormatDesc: TFormatDescriptor;
5706   SourceFD, DestFD: Pointer;
5707   pData, srcData, dstData, ConvertBuffer: pByte;
5708
5709   Pixel: TglBitmapPixelData;
5710   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5711   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5712
5713   PaddingBuff: Cardinal;
5714
5715   function GetLineWidth : Integer;
5716   begin
5717     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5718   end;
5719
5720 begin
5721   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5722     raise EglBitmapUnsupportedFormat.Create(Format);
5723
5724   Converter  := nil;
5725   FormatDesc := TFormatDescriptor.Get(Format);
5726   ImageSize  := FormatDesc.GetSize(Dimension);
5727
5728   FillChar(Header{%H-}, SizeOf(Header), 0);
5729   Header.bfType      := BMP_MAGIC;
5730   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5731   Header.bfReserved1 := 0;
5732   Header.bfReserved2 := 0;
5733   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5734
5735   FillChar(Info{%H-}, SizeOf(Info), 0);
5736   Info.biSize        := SizeOf(Info);
5737   Info.biWidth       := Width;
5738   Info.biHeight      := Height;
5739   Info.biPlanes      := 1;
5740   Info.biCompression := BMP_COMP_RGB;
5741   Info.biSizeImage   := ImageSize;
5742
5743   try
5744     case Format of
5745       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5746       begin
5747         Info.biBitCount  :=  8;
5748         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5749         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5750         Converter := TbmpColorTableFormat.Create;
5751         with (Converter as TbmpColorTableFormat) do begin
5752           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5753           CreateColorTable;
5754         end;
5755       end;
5756
5757       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5758       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5759       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5760       begin
5761         Info.biBitCount    := 16;
5762         Info.biCompression := BMP_COMP_BITFIELDS;
5763       end;
5764
5765       tfBGR8ub3, tfRGB8ub3:
5766       begin
5767         Info.biBitCount := 24;
5768         if (Format = tfRGB8ub3) then
5769           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5770       end;
5771
5772       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5773       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5774       begin
5775         Info.biBitCount    := 32;
5776         Info.biCompression := BMP_COMP_BITFIELDS;
5777       end;
5778     else
5779       raise EglBitmapUnsupportedFormat.Create(Format);
5780     end;
5781     Info.biXPelsPerMeter := 2835;
5782     Info.biYPelsPerMeter := 2835;
5783
5784     // prepare bitmasks
5785     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5786       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5787       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5788
5789       RedMask    := FormatDesc.Mask.r;
5790       GreenMask  := FormatDesc.Mask.g;
5791       BlueMask   := FormatDesc.Mask.b;
5792       AlphaMask  := FormatDesc.Mask.a;
5793     end;
5794
5795     // headers
5796     aStream.Write(Header, SizeOf(Header));
5797     aStream.Write(Info, SizeOf(Info));
5798
5799     // colortable
5800     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5801       with (Converter as TbmpColorTableFormat) do
5802         aStream.Write(ColorTable[0].b,
5803           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5804
5805     // bitmasks
5806     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5807       aStream.Write(RedMask,   SizeOf(Cardinal));
5808       aStream.Write(GreenMask, SizeOf(Cardinal));
5809       aStream.Write(BlueMask,  SizeOf(Cardinal));
5810       aStream.Write(AlphaMask, SizeOf(Cardinal));
5811     end;
5812
5813     // image data
5814     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5815     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5816     Padding     := GetLineWidth - wbLineSize;
5817     PaddingBuff := 0;
5818
5819     pData := Data;
5820     inc(pData, (Height-1) * rbLineSize);
5821
5822     // prepare row buffer. But only for RGB because RGBA supports color masks
5823     // so it's possible to change color within the image.
5824     if Assigned(Converter) then begin
5825       FormatDesc.PreparePixel(Pixel);
5826       GetMem(ConvertBuffer, wbLineSize);
5827       SourceFD := FormatDesc.CreateMappingData;
5828       DestFD   := Converter.CreateMappingData;
5829     end else
5830       ConvertBuffer := nil;
5831
5832     try
5833       for LineIdx := 0 to Height - 1 do begin
5834         // preparing row
5835         if Assigned(Converter) then begin
5836           srcData := pData;
5837           dstData := ConvertBuffer;
5838           for PixelIdx := 0 to Info.biWidth-1 do begin
5839             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5840             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5841             Converter.Map(Pixel, dstData, DestFD);
5842           end;
5843           aStream.Write(ConvertBuffer^, wbLineSize);
5844         end else begin
5845           aStream.Write(pData^, rbLineSize);
5846         end;
5847         dec(pData, rbLineSize);
5848         if (Padding > 0) then
5849           aStream.Write(PaddingBuff, Padding);
5850       end;
5851     finally
5852       // destroy row buffer
5853       if Assigned(ConvertBuffer) then begin
5854         FormatDesc.FreeMappingData(SourceFD);
5855         Converter.FreeMappingData(DestFD);
5856         FreeMem(ConvertBuffer);
5857       end;
5858     end;
5859   finally
5860     if Assigned(Converter) then
5861       Converter.Free;
5862   end;
5863 end;
5864
5865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5866 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5868 type
5869   TTGAHeader = packed record
5870     ImageID: Byte;
5871     ColorMapType: Byte;
5872     ImageType: Byte;
5873     //ColorMapSpec: Array[0..4] of Byte;
5874     ColorMapStart: Word;
5875     ColorMapLength: Word;
5876     ColorMapEntrySize: Byte;
5877     OrigX: Word;
5878     OrigY: Word;
5879     Width: Word;
5880     Height: Word;
5881     Bpp: Byte;
5882     ImageDesc: Byte;
5883   end;
5884
5885 const
5886   TGA_UNCOMPRESSED_RGB  =  2;
5887   TGA_UNCOMPRESSED_GRAY =  3;
5888   TGA_COMPRESSED_RGB    = 10;
5889   TGA_COMPRESSED_GRAY   = 11;
5890
5891   TGA_NONE_COLOR_TABLE  = 0;
5892
5893 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5894 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5895 var
5896   Header: TTGAHeader;
5897   ImageData: System.PByte;
5898   StartPosition: Int64;
5899   PixelSize, LineSize: Integer;
5900   tgaFormat: TglBitmapFormat;
5901   FormatDesc: TFormatDescriptor;
5902   Counter: packed record
5903     X, Y: packed record
5904       low, high, dir: Integer;
5905     end;
5906   end;
5907
5908 const
5909   CACHE_SIZE = $4000;
5910
5911   ////////////////////////////////////////////////////////////////////////////////////////
5912   procedure ReadUncompressed;
5913   var
5914     i, j: Integer;
5915     buf, tmp1, tmp2: System.PByte;
5916   begin
5917     buf := nil;
5918     if (Counter.X.dir < 0) then
5919       GetMem(buf, LineSize);
5920     try
5921       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5922         tmp1 := ImageData;
5923         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5924         if (Counter.X.dir < 0) then begin               //flip X
5925           aStream.Read(buf^, LineSize);
5926           tmp2 := buf;
5927           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5928           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5929             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5930               tmp1^ := tmp2^;
5931               inc(tmp1);
5932               inc(tmp2);
5933             end;
5934             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5935           end;
5936         end else
5937           aStream.Read(tmp1^, LineSize);
5938         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5939       end;
5940     finally
5941       if Assigned(buf) then
5942         FreeMem(buf);
5943     end;
5944   end;
5945
5946   ////////////////////////////////////////////////////////////////////////////////////////
5947   procedure ReadCompressed;
5948
5949     /////////////////////////////////////////////////////////////////
5950     var
5951       TmpData: System.PByte;
5952       LinePixelsRead: Integer;
5953     procedure CheckLine;
5954     begin
5955       if (LinePixelsRead >= Header.Width) then begin
5956         LinePixelsRead := 0;
5957         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5958         TmpData := ImageData;
5959         inc(TmpData, Counter.Y.low * LineSize);           //set line
5960         if (Counter.X.dir < 0) then                       //if x flipped then
5961           inc(TmpData, LineSize - PixelSize);             //set last pixel
5962       end;
5963     end;
5964
5965     /////////////////////////////////////////////////////////////////
5966     var
5967       Cache: PByte;
5968       CacheSize, CachePos: Integer;
5969     procedure CachedRead(out Buffer; Count: Integer);
5970     var
5971       BytesRead: Integer;
5972     begin
5973       if (CachePos + Count > CacheSize) then begin
5974         //if buffer overflow save non read bytes
5975         BytesRead := 0;
5976         if (CacheSize - CachePos > 0) then begin
5977           BytesRead := CacheSize - CachePos;
5978           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
5979           inc(CachePos, BytesRead);
5980         end;
5981
5982         //load cache from file
5983         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
5984         aStream.Read(Cache^, CacheSize);
5985         CachePos := 0;
5986
5987         //read rest of requested bytes
5988         if (Count - BytesRead > 0) then begin
5989           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
5990           inc(CachePos, Count - BytesRead);
5991         end;
5992       end else begin
5993         //if no buffer overflow just read the data
5994         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
5995         inc(CachePos, Count);
5996       end;
5997     end;
5998
5999     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6000     begin
6001       case PixelSize of
6002         1: begin
6003           aBuffer^ := aData^;
6004           inc(aBuffer, Counter.X.dir);
6005         end;
6006         2: begin
6007           PWord(aBuffer)^ := PWord(aData)^;
6008           inc(aBuffer, 2 * Counter.X.dir);
6009         end;
6010         3: begin
6011           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6012           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6013           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6014           inc(aBuffer, 3 * Counter.X.dir);
6015         end;
6016         4: begin
6017           PCardinal(aBuffer)^ := PCardinal(aData)^;
6018           inc(aBuffer, 4 * Counter.X.dir);
6019         end;
6020       end;
6021     end;
6022
6023   var
6024     TotalPixelsToRead, TotalPixelsRead: Integer;
6025     Temp: Byte;
6026     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6027     PixelRepeat: Boolean;
6028     PixelsToRead, PixelCount: Integer;
6029   begin
6030     CacheSize := 0;
6031     CachePos  := 0;
6032
6033     TotalPixelsToRead := Header.Width * Header.Height;
6034     TotalPixelsRead   := 0;
6035     LinePixelsRead    := 0;
6036
6037     GetMem(Cache, CACHE_SIZE);
6038     try
6039       TmpData := ImageData;
6040       inc(TmpData, Counter.Y.low * LineSize);           //set line
6041       if (Counter.X.dir < 0) then                       //if x flipped then
6042         inc(TmpData, LineSize - PixelSize);             //set last pixel
6043
6044       repeat
6045         //read CommandByte
6046         CachedRead(Temp, 1);
6047         PixelRepeat  := (Temp and $80) > 0;
6048         PixelsToRead := (Temp and $7F) + 1;
6049         inc(TotalPixelsRead, PixelsToRead);
6050
6051         if PixelRepeat then
6052           CachedRead(buf[0], PixelSize);
6053         while (PixelsToRead > 0) do begin
6054           CheckLine;
6055           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6056           while (PixelCount > 0) do begin
6057             if not PixelRepeat then
6058               CachedRead(buf[0], PixelSize);
6059             PixelToBuffer(@buf[0], TmpData);
6060             inc(LinePixelsRead);
6061             dec(PixelsToRead);
6062             dec(PixelCount);
6063           end;
6064         end;
6065       until (TotalPixelsRead >= TotalPixelsToRead);
6066     finally
6067       FreeMem(Cache);
6068     end;
6069   end;
6070
6071   function IsGrayFormat: Boolean;
6072   begin
6073     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6074   end;
6075
6076 begin
6077   result := false;
6078
6079   // reading header to test file and set cursor back to begin
6080   StartPosition := aStream.Position;
6081   aStream.Read(Header{%H-}, SizeOf(Header));
6082
6083   // no colormapped files
6084   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6085     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6086   begin
6087     try
6088       if Header.ImageID <> 0 then       // skip image ID
6089         aStream.Position := aStream.Position + Header.ImageID;
6090
6091       tgaFormat := tfEmpty;
6092       case Header.Bpp of
6093          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6094                0: tgaFormat := tfLuminance8ub1;
6095                8: tgaFormat := tfAlpha8ub1;
6096             end;
6097
6098         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6099                0: tgaFormat := tfLuminance16us1;
6100                8: tgaFormat := tfLuminance8Alpha8ub2;
6101             end else case (Header.ImageDesc and $F) of
6102                0: tgaFormat := tfX1RGB5us1;
6103                1: tgaFormat := tfA1RGB5us1;
6104                4: tgaFormat := tfARGB4us1;
6105             end;
6106
6107         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6108                0: tgaFormat := tfBGR8ub3;
6109             end;
6110
6111         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6112                0: tgaFormat := tfDepth32ui1;
6113             end else case (Header.ImageDesc and $F) of
6114                0: tgaFormat := tfX2RGB10ui1;
6115                2: tgaFormat := tfA2RGB10ui1;
6116                8: tgaFormat := tfARGB8ui1;
6117             end;
6118       end;
6119
6120       if (tgaFormat = tfEmpty) then
6121         raise EglBitmap.Create('LoadTga - unsupported format');
6122
6123       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6124       PixelSize  := FormatDesc.GetSize(1, 1);
6125       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6126
6127       GetMem(ImageData, LineSize * Header.Height);
6128       try
6129         //column direction
6130         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6131           Counter.X.low  := Header.Height-1;;
6132           Counter.X.high := 0;
6133           Counter.X.dir  := -1;
6134         end else begin
6135           Counter.X.low  := 0;
6136           Counter.X.high := Header.Height-1;
6137           Counter.X.dir  := 1;
6138         end;
6139
6140         // Row direction
6141         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6142           Counter.Y.low  := 0;
6143           Counter.Y.high := Header.Height-1;
6144           Counter.Y.dir  := 1;
6145         end else begin
6146           Counter.Y.low  := Header.Height-1;;
6147           Counter.Y.high := 0;
6148           Counter.Y.dir  := -1;
6149         end;
6150
6151         // Read Image
6152         case Header.ImageType of
6153           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6154             ReadUncompressed;
6155           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6156             ReadCompressed;
6157         end;
6158
6159         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6160         result := true;
6161       except
6162         if Assigned(ImageData) then
6163           FreeMem(ImageData);
6164         raise;
6165       end;
6166     finally
6167       aStream.Position := StartPosition;
6168     end;
6169   end
6170     else aStream.Position := StartPosition;
6171 end;
6172
6173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6174 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6175 var
6176   Header: TTGAHeader;
6177   Size: Integer;
6178   FormatDesc: TFormatDescriptor;
6179 begin
6180   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6181     raise EglBitmapUnsupportedFormat.Create(Format);
6182
6183   //prepare header
6184   FormatDesc := TFormatDescriptor.Get(Format);
6185   FillChar(Header{%H-}, SizeOf(Header), 0);
6186   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6187   Header.Bpp       := FormatDesc.BitsPerPixel;
6188   Header.Width     := Width;
6189   Header.Height    := Height;
6190   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6191   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6192     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6193   else
6194     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6195   aStream.Write(Header, SizeOf(Header));
6196
6197   // write Data
6198   Size := FormatDesc.GetSize(Dimension);
6199   aStream.Write(Data^, Size);
6200 end;
6201
6202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6203 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6205 const
6206   DDS_MAGIC: Cardinal         = $20534444;
6207
6208   // DDS_header.dwFlags
6209   DDSD_CAPS                   = $00000001;
6210   DDSD_HEIGHT                 = $00000002;
6211   DDSD_WIDTH                  = $00000004;
6212   DDSD_PIXELFORMAT            = $00001000;
6213
6214   // DDS_header.sPixelFormat.dwFlags
6215   DDPF_ALPHAPIXELS            = $00000001;
6216   DDPF_ALPHA                  = $00000002;
6217   DDPF_FOURCC                 = $00000004;
6218   DDPF_RGB                    = $00000040;
6219   DDPF_LUMINANCE              = $00020000;
6220
6221   // DDS_header.sCaps.dwCaps1
6222   DDSCAPS_TEXTURE             = $00001000;
6223
6224   // DDS_header.sCaps.dwCaps2
6225   DDSCAPS2_CUBEMAP            = $00000200;
6226
6227   D3DFMT_DXT1                 = $31545844;
6228   D3DFMT_DXT3                 = $33545844;
6229   D3DFMT_DXT5                 = $35545844;
6230
6231 type
6232   TDDSPixelFormat = packed record
6233     dwSize: Cardinal;
6234     dwFlags: Cardinal;
6235     dwFourCC: Cardinal;
6236     dwRGBBitCount: Cardinal;
6237     dwRBitMask: Cardinal;
6238     dwGBitMask: Cardinal;
6239     dwBBitMask: Cardinal;
6240     dwABitMask: Cardinal;
6241   end;
6242
6243   TDDSCaps = packed record
6244     dwCaps1: Cardinal;
6245     dwCaps2: Cardinal;
6246     dwDDSX: Cardinal;
6247     dwReserved: Cardinal;
6248   end;
6249
6250   TDDSHeader = packed record
6251     dwSize: Cardinal;
6252     dwFlags: Cardinal;
6253     dwHeight: Cardinal;
6254     dwWidth: Cardinal;
6255     dwPitchOrLinearSize: Cardinal;
6256     dwDepth: Cardinal;
6257     dwMipMapCount: Cardinal;
6258     dwReserved: array[0..10] of Cardinal;
6259     PixelFormat: TDDSPixelFormat;
6260     Caps: TDDSCaps;
6261     dwReserved2: Cardinal;
6262   end;
6263
6264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6265 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6266 var
6267   Header: TDDSHeader;
6268   Converter: TbmpBitfieldFormat;
6269
6270   function GetDDSFormat: TglBitmapFormat;
6271   var
6272     fd: TFormatDescriptor;
6273     i: Integer;
6274     Mask: TglBitmapRec4ul;
6275     Range: TglBitmapRec4ui;
6276     match: Boolean;
6277   begin
6278     result := tfEmpty;
6279     with Header.PixelFormat do begin
6280       // Compresses
6281       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6282         case Header.PixelFormat.dwFourCC of
6283           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6284           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6285           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6286         end;
6287       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6288         // prepare masks
6289         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6290           Mask.r := dwRBitMask;
6291           Mask.g := dwGBitMask;
6292           Mask.b := dwBBitMask;
6293         end else begin
6294           Mask.r := dwRBitMask;
6295           Mask.g := dwRBitMask;
6296           Mask.b := dwRBitMask;
6297         end;
6298         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6299           Mask.a := dwABitMask
6300         else
6301           Mask.a := 0;;
6302
6303         //find matching format
6304         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6305         result := fd.Format;
6306         if (result <> tfEmpty) then
6307           exit;
6308
6309         //find format with same Range
6310         for i := 0 to 3 do
6311           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6312         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6313           fd := TFormatDescriptor.Get(result);
6314           match := true;
6315           for i := 0 to 3 do
6316             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6317               match := false;
6318               break;
6319             end;
6320           if match then
6321             break;
6322         end;
6323
6324         //no format with same range found -> use default
6325         if (result = tfEmpty) then begin
6326           if (dwABitMask > 0) then
6327             result := tfRGBA8ui1
6328           else
6329             result := tfRGB8ub3;
6330         end;
6331
6332         Converter := TbmpBitfieldFormat.Create;
6333         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6334       end;
6335     end;
6336   end;
6337
6338 var
6339   StreamPos: Int64;
6340   x, y, LineSize, RowSize, Magic: Cardinal;
6341   NewImage, TmpData, RowData, SrcData: System.PByte;
6342   SourceMD, DestMD: Pointer;
6343   Pixel: TglBitmapPixelData;
6344   ddsFormat: TglBitmapFormat;
6345   FormatDesc: TFormatDescriptor;
6346
6347 begin
6348   result    := false;
6349   Converter := nil;
6350   StreamPos := aStream.Position;
6351
6352   // Magic
6353   aStream.Read(Magic{%H-}, sizeof(Magic));
6354   if (Magic <> DDS_MAGIC) then begin
6355     aStream.Position := StreamPos;
6356     exit;
6357   end;
6358
6359   //Header
6360   aStream.Read(Header{%H-}, sizeof(Header));
6361   if (Header.dwSize <> SizeOf(Header)) or
6362      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6363         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6364   begin
6365     aStream.Position := StreamPos;
6366     exit;
6367   end;
6368
6369   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6370     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6371
6372   ddsFormat := GetDDSFormat;
6373   try
6374     if (ddsFormat = tfEmpty) then
6375       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6376
6377     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6378     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6379     GetMem(NewImage, Header.dwHeight * LineSize);
6380     try
6381       TmpData := NewImage;
6382
6383       //Converter needed
6384       if Assigned(Converter) then begin
6385         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6386         GetMem(RowData, RowSize);
6387         SourceMD := Converter.CreateMappingData;
6388         DestMD   := FormatDesc.CreateMappingData;
6389         try
6390           for y := 0 to Header.dwHeight-1 do begin
6391             TmpData := NewImage;
6392             inc(TmpData, y * LineSize);
6393             SrcData := RowData;
6394             aStream.Read(SrcData^, RowSize);
6395             for x := 0 to Header.dwWidth-1 do begin
6396               Converter.Unmap(SrcData, Pixel, SourceMD);
6397               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6398               FormatDesc.Map(Pixel, TmpData, DestMD);
6399             end;
6400           end;
6401         finally
6402           Converter.FreeMappingData(SourceMD);
6403           FormatDesc.FreeMappingData(DestMD);
6404           FreeMem(RowData);
6405         end;
6406       end else
6407
6408       // Compressed
6409       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6410         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6411         for Y := 0 to Header.dwHeight-1 do begin
6412           aStream.Read(TmpData^, RowSize);
6413           Inc(TmpData, LineSize);
6414         end;
6415       end else
6416
6417       // Uncompressed
6418       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6419         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6420         for Y := 0 to Header.dwHeight-1 do begin
6421           aStream.Read(TmpData^, RowSize);
6422           Inc(TmpData, LineSize);
6423         end;
6424       end else
6425         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6426
6427       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6428       result := true;
6429     except
6430       if Assigned(NewImage) then
6431         FreeMem(NewImage);
6432       raise;
6433     end;
6434   finally
6435     FreeAndNil(Converter);
6436   end;
6437 end;
6438
6439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6440 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6441 var
6442   Header: TDDSHeader;
6443   FormatDesc: TFormatDescriptor;
6444 begin
6445   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6446     raise EglBitmapUnsupportedFormat.Create(Format);
6447
6448   FormatDesc := TFormatDescriptor.Get(Format);
6449
6450   // Generell
6451   FillChar(Header{%H-}, SizeOf(Header), 0);
6452   Header.dwSize  := SizeOf(Header);
6453   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6454
6455   Header.dwWidth  := Max(1, Width);
6456   Header.dwHeight := Max(1, Height);
6457
6458   // Caps
6459   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6460
6461   // Pixelformat
6462   Header.PixelFormat.dwSize := sizeof(Header);
6463   if (FormatDesc.IsCompressed) then begin
6464     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6465     case Format of
6466       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6467       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6468       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6469     end;
6470   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6471     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6472     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6473     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6474   end else if FormatDesc.IsGrayscale then begin
6475     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6476     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6477     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6478     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6479   end else begin
6480     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6481     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6482     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6483     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6484     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6485     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6486   end;
6487
6488   if (FormatDesc.HasAlpha) then
6489     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6490
6491   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6492   aStream.Write(Header, SizeOf(Header));
6493   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6494 end;
6495
6496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6497 function TglBitmapData.FlipHorz: Boolean;
6498 var
6499   fd: TglBitmapFormatDescriptor;
6500   Col, RowSize, PixelSize: Integer;
6501   pTempDest, pDest, pSource: PByte;
6502 begin
6503   result    := false;
6504   fd        := FormatDescriptor;
6505   PixelSize := Ceil(fd.BytesPerPixel);
6506   RowSize   := fd.GetSize(Width, 1);
6507   if Assigned(Data) and not fd.IsCompressed then begin
6508     pSource := Data;
6509     GetMem(pDest, RowSize);
6510     try
6511       pTempDest := pDest;
6512       Inc(pTempDest, RowSize);
6513       for Col := 0 to Width-1 do begin
6514         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6515         Move(pSource^, pTempDest^, PixelSize);
6516         Inc(pSource, PixelSize);
6517       end;
6518       SetData(pDest, Format, Width);
6519       result := true;
6520     except
6521       if Assigned(pDest) then
6522         FreeMem(pDest);
6523       raise;
6524     end;
6525   end;
6526 end;
6527
6528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6529 function TglBitmapData.FlipVert: Boolean;
6530 var
6531   fd: TglBitmapFormatDescriptor;
6532   Row, RowSize, PixelSize: Integer;
6533   TempDestData, DestData, SourceData: PByte;
6534 begin
6535   result    := false;
6536   fd        := FormatDescriptor;
6537   PixelSize := Ceil(fd.BytesPerPixel);
6538   RowSize   := fd.GetSize(Width, 1);
6539   if Assigned(Data) then begin
6540     SourceData := Data;
6541     GetMem(DestData, Height * RowSize);
6542     try
6543       TempDestData := DestData;
6544       Inc(TempDestData, Width * (Height -1) * PixelSize);
6545       for Row := 0 to Height -1 do begin
6546         Move(SourceData^, TempDestData^, RowSize);
6547         Dec(TempDestData, RowSize);
6548         Inc(SourceData, RowSize);
6549       end;
6550       SetData(DestData, Format, Width, Height);
6551       result := true;
6552     except
6553       if Assigned(DestData) then
6554         FreeMem(DestData);
6555       raise;
6556     end;
6557   end;
6558 end;
6559
6560 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6561 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6562 var
6563   fs: TFileStream;
6564 begin
6565   if not FileExists(aFilename) then
6566     raise EglBitmap.Create('file does not exist: ' + aFilename);
6567   fs := TFileStream.Create(aFilename, fmOpenRead);
6568   try
6569     fs.Position := 0;
6570     LoadFromStream(fs);
6571     fFilename := aFilename;
6572   finally
6573     fs.Free;
6574   end;
6575 end;
6576
6577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6578 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6579 begin
6580   {$IFDEF GLB_SUPPORT_PNG_READ}
6581   if not LoadPNG(aStream) then
6582   {$ENDIF}
6583   {$IFDEF GLB_SUPPORT_JPEG_READ}
6584   if not LoadJPEG(aStream) then
6585   {$ENDIF}
6586   if not LoadDDS(aStream) then
6587   if not LoadTGA(aStream) then
6588   if not LoadBMP(aStream) then
6589   if not LoadRAW(aStream) then
6590     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6591 end;
6592
6593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6594 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6595   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6596 var
6597   tmpData: PByte;
6598   size: Integer;
6599 begin
6600   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6601   GetMem(tmpData, size);
6602   try
6603     FillChar(tmpData^, size, #$FF);
6604     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6605   except
6606     if Assigned(tmpData) then
6607       FreeMem(tmpData);
6608     raise;
6609   end;
6610   Convert(Self, aFunc, false, aFormat, aArgs);
6611 end;
6612
6613 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6614 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6615 var
6616   rs: TResourceStream;
6617 begin
6618   PrepareResType(aResource, aResType);
6619   rs := TResourceStream.Create(aInstance, aResource, aResType);
6620   try
6621     LoadFromStream(rs);
6622   finally
6623     rs.Free;
6624   end;
6625 end;
6626
6627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6628 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6629 var
6630   rs: TResourceStream;
6631 begin
6632   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6633   try
6634     LoadFromStream(rs);
6635   finally
6636     rs.Free;
6637   end;
6638 end;
6639
6640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6641 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6642 var
6643   fs: TFileStream;
6644 begin
6645   fs := TFileStream.Create(aFileName, fmCreate);
6646   try
6647     fs.Position := 0;
6648     SaveToStream(fs, aFileType);
6649   finally
6650     fs.Free;
6651   end;
6652 end;
6653
6654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6655 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6656 begin
6657   case aFileType of
6658     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6659     ftPNG:  SavePNG(aStream);
6660     {$ENDIF}
6661     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6662     ftJPEG: SaveJPEG(aStream);
6663     {$ENDIF}
6664     ftDDS:  SaveDDS(aStream);
6665     ftTGA:  SaveTGA(aStream);
6666     ftBMP:  SaveBMP(aStream);
6667     ftRAW:  SaveRAW(aStream);
6668   end;
6669 end;
6670
6671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6672 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6673 begin
6674   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6675 end;
6676
6677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6678 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6679   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6680 var
6681   DestData, TmpData, SourceData: pByte;
6682   TempHeight, TempWidth: Integer;
6683   SourceFD, DestFD: TFormatDescriptor;
6684   SourceMD, DestMD: Pointer;
6685
6686   FuncRec: TglBitmapFunctionRec;
6687 begin
6688   Assert(Assigned(Data));
6689   Assert(Assigned(aSource));
6690   Assert(Assigned(aSource.Data));
6691
6692   result := false;
6693   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6694     SourceFD := TFormatDescriptor.Get(aSource.Format);
6695     DestFD   := TFormatDescriptor.Get(aFormat);
6696
6697     if (SourceFD.IsCompressed) then
6698       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6699     if (DestFD.IsCompressed) then
6700       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6701
6702     // inkompatible Formats so CreateTemp
6703     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6704       aCreateTemp := true;
6705
6706     // Values
6707     TempHeight := Max(1, aSource.Height);
6708     TempWidth  := Max(1, aSource.Width);
6709
6710     FuncRec.Sender := Self;
6711     FuncRec.Args   := aArgs;
6712
6713     TmpData := nil;
6714     if aCreateTemp then begin
6715       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6716       DestData := TmpData;
6717     end else
6718       DestData := Data;
6719
6720     try
6721       SourceFD.PreparePixel(FuncRec.Source);
6722       DestFD.PreparePixel  (FuncRec.Dest);
6723
6724       SourceMD := SourceFD.CreateMappingData;
6725       DestMD   := DestFD.CreateMappingData;
6726
6727       FuncRec.Size            := aSource.Dimension;
6728       FuncRec.Position.Fields := FuncRec.Size.Fields;
6729
6730       try
6731         SourceData := aSource.Data;
6732         FuncRec.Position.Y := 0;
6733         while FuncRec.Position.Y < TempHeight do begin
6734           FuncRec.Position.X := 0;
6735           while FuncRec.Position.X < TempWidth do begin
6736             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6737             aFunc(FuncRec);
6738             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6739             inc(FuncRec.Position.X);
6740           end;
6741           inc(FuncRec.Position.Y);
6742         end;
6743
6744         // Updating Image or InternalFormat
6745         if aCreateTemp then
6746           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6747         else if (aFormat <> fFormat) then
6748           Format := aFormat;
6749
6750         result := true;
6751       finally
6752         SourceFD.FreeMappingData(SourceMD);
6753         DestFD.FreeMappingData(DestMD);
6754       end;
6755     except
6756       if aCreateTemp and Assigned(TmpData) then
6757         FreeMem(TmpData);
6758       raise;
6759     end;
6760   end;
6761 end;
6762
6763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6764 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6765 var
6766   SourceFD, DestFD: TFormatDescriptor;
6767   SourcePD, DestPD: TglBitmapPixelData;
6768   ShiftData: TShiftData;
6769
6770   function DataIsIdentical: Boolean;
6771   begin
6772     result := SourceFD.MaskMatch(DestFD.Mask);
6773   end;
6774
6775   function CanCopyDirect: Boolean;
6776   begin
6777     result :=
6778       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6779       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6780       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6781       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6782   end;
6783
6784   function CanShift: Boolean;
6785   begin
6786     result :=
6787       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6788       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6789       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6790       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6791   end;
6792
6793   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6794   begin
6795     result := 0;
6796     while (aSource > aDest) and (aSource > 0) do begin
6797       inc(result);
6798       aSource := aSource shr 1;
6799     end;
6800   end;
6801
6802 begin
6803   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6804     SourceFD := TFormatDescriptor.Get(Format);
6805     DestFD   := TFormatDescriptor.Get(aFormat);
6806
6807     if DataIsIdentical then begin
6808       result := true;
6809       Format := aFormat;
6810       exit;
6811     end;
6812
6813     SourceFD.PreparePixel(SourcePD);
6814     DestFD.PreparePixel  (DestPD);
6815
6816     if CanCopyDirect then
6817       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6818     else if CanShift then begin
6819       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6820       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6821       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6822       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6823       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6824     end else
6825       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6826   end else
6827     result := true;
6828 end;
6829
6830 {$IFDEF GLB_SDL}
6831 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6832 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6833 var
6834   Row, RowSize: Integer;
6835   SourceData, TmpData: PByte;
6836   TempDepth: Integer;
6837   FormatDesc: TFormatDescriptor;
6838
6839   function GetRowPointer(Row: Integer): pByte;
6840   begin
6841     result := aSurface.pixels;
6842     Inc(result, Row * RowSize);
6843   end;
6844
6845 begin
6846   result := false;
6847
6848   FormatDesc := TFormatDescriptor.Get(Format);
6849   if FormatDesc.IsCompressed then
6850     raise EglBitmapUnsupportedFormat.Create(Format);
6851
6852   if Assigned(Data) then begin
6853     case Trunc(FormatDesc.PixelSize) of
6854       1: TempDepth :=  8;
6855       2: TempDepth := 16;
6856       3: TempDepth := 24;
6857       4: TempDepth := 32;
6858     else
6859       raise EglBitmapUnsupportedFormat.Create(Format);
6860     end;
6861
6862     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6863       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6864     SourceData := Data;
6865     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6866
6867     for Row := 0 to FileHeight-1 do begin
6868       TmpData := GetRowPointer(Row);
6869       if Assigned(TmpData) then begin
6870         Move(SourceData^, TmpData^, RowSize);
6871         inc(SourceData, RowSize);
6872       end;
6873     end;
6874     result := true;
6875   end;
6876 end;
6877
6878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6879 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6880 var
6881   pSource, pData, pTempData: PByte;
6882   Row, RowSize, TempWidth, TempHeight: Integer;
6883   IntFormat: TglBitmapFormat;
6884   fd: TFormatDescriptor;
6885   Mask: TglBitmapMask;
6886
6887   function GetRowPointer(Row: Integer): pByte;
6888   begin
6889     result := aSurface^.pixels;
6890     Inc(result, Row * RowSize);
6891   end;
6892
6893 begin
6894   result := false;
6895   if (Assigned(aSurface)) then begin
6896     with aSurface^.format^ do begin
6897       Mask.r := RMask;
6898       Mask.g := GMask;
6899       Mask.b := BMask;
6900       Mask.a := AMask;
6901       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6902       if (IntFormat = tfEmpty) then
6903         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6904     end;
6905
6906     fd := TFormatDescriptor.Get(IntFormat);
6907     TempWidth  := aSurface^.w;
6908     TempHeight := aSurface^.h;
6909     RowSize := fd.GetSize(TempWidth, 1);
6910     GetMem(pData, TempHeight * RowSize);
6911     try
6912       pTempData := pData;
6913       for Row := 0 to TempHeight -1 do begin
6914         pSource := GetRowPointer(Row);
6915         if (Assigned(pSource)) then begin
6916           Move(pSource^, pTempData^, RowSize);
6917           Inc(pTempData, RowSize);
6918         end;
6919       end;
6920       SetData(pData, IntFormat, TempWidth, TempHeight);
6921       result := true;
6922     except
6923       if Assigned(pData) then
6924         FreeMem(pData);
6925       raise;
6926     end;
6927   end;
6928 end;
6929
6930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6931 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6932 var
6933   Row, Col, AlphaInterleave: Integer;
6934   pSource, pDest: PByte;
6935
6936   function GetRowPointer(Row: Integer): pByte;
6937   begin
6938     result := aSurface.pixels;
6939     Inc(result, Row * Width);
6940   end;
6941
6942 begin
6943   result := false;
6944   if Assigned(Data) then begin
6945     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6946       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6947
6948       AlphaInterleave := 0;
6949       case Format of
6950         tfLuminance8Alpha8ub2:
6951           AlphaInterleave := 1;
6952         tfBGRA8ub4, tfRGBA8ub4:
6953           AlphaInterleave := 3;
6954       end;
6955
6956       pSource := Data;
6957       for Row := 0 to Height -1 do begin
6958         pDest := GetRowPointer(Row);
6959         if Assigned(pDest) then begin
6960           for Col := 0 to Width -1 do begin
6961             Inc(pSource, AlphaInterleave);
6962             pDest^ := pSource^;
6963             Inc(pDest);
6964             Inc(pSource);
6965           end;
6966         end;
6967       end;
6968       result := true;
6969     end;
6970   end;
6971 end;
6972
6973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6974 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6975 var
6976   bmp: TglBitmap2D;
6977 begin
6978   bmp := TglBitmap2D.Create;
6979   try
6980     bmp.AssignFromSurface(aSurface);
6981     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
6982   finally
6983     bmp.Free;
6984   end;
6985 end;
6986 {$ENDIF}
6987
6988 {$IFDEF GLB_DELPHI}
6989 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6990 function CreateGrayPalette: HPALETTE;
6991 var
6992   Idx: Integer;
6993   Pal: PLogPalette;
6994 begin
6995   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
6996
6997   Pal.palVersion := $300;
6998   Pal.palNumEntries := 256;
6999
7000   for Idx := 0 to Pal.palNumEntries - 1 do begin
7001     Pal.palPalEntry[Idx].peRed   := Idx;
7002     Pal.palPalEntry[Idx].peGreen := Idx;
7003     Pal.palPalEntry[Idx].peBlue  := Idx;
7004     Pal.palPalEntry[Idx].peFlags := 0;
7005   end;
7006   Result := CreatePalette(Pal^);
7007   FreeMem(Pal);
7008 end;
7009
7010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7011 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7012 var
7013   Row, RowSize: Integer;
7014   pSource, pData: PByte;
7015 begin
7016   result := false;
7017   if Assigned(Data) then begin
7018     if Assigned(aBitmap) then begin
7019       aBitmap.Width  := Width;
7020       aBitmap.Height := Height;
7021
7022       case Format of
7023         tfAlpha8ub1, tfLuminance8ub1: begin
7024           aBitmap.PixelFormat := pf8bit;
7025           aBitmap.Palette     := CreateGrayPalette;
7026         end;
7027         tfRGB5A1us1:
7028           aBitmap.PixelFormat := pf15bit;
7029         tfR5G6B5us1:
7030           aBitmap.PixelFormat := pf16bit;
7031         tfRGB8ub3, tfBGR8ub3:
7032           aBitmap.PixelFormat := pf24bit;
7033         tfRGBA8ub4, tfBGRA8ub4:
7034           aBitmap.PixelFormat := pf32bit;
7035       else
7036         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7037       end;
7038
7039       RowSize := FormatDescriptor.GetSize(Width, 1);
7040       pSource := Data;
7041       for Row := 0 to Height-1 do begin
7042         pData := aBitmap.Scanline[Row];
7043         Move(pSource^, pData^, RowSize);
7044         Inc(pSource, RowSize);
7045         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7046           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7047       end;
7048       result := true;
7049     end;
7050   end;
7051 end;
7052
7053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7054 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7055 var
7056   pSource, pData, pTempData: PByte;
7057   Row, RowSize, TempWidth, TempHeight: Integer;
7058   IntFormat: TglBitmapFormat;
7059 begin
7060   result := false;
7061
7062   if (Assigned(aBitmap)) then begin
7063     case aBitmap.PixelFormat of
7064       pf8bit:
7065         IntFormat := tfLuminance8ub1;
7066       pf15bit:
7067         IntFormat := tfRGB5A1us1;
7068       pf16bit:
7069         IntFormat := tfR5G6B5us1;
7070       pf24bit:
7071         IntFormat := tfBGR8ub3;
7072       pf32bit:
7073         IntFormat := tfBGRA8ub4;
7074     else
7075       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7076     end;
7077
7078     TempWidth  := aBitmap.Width;
7079     TempHeight := aBitmap.Height;
7080     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7081     GetMem(pData, TempHeight * RowSize);
7082     try
7083       pTempData := pData;
7084       for Row := 0 to TempHeight -1 do begin
7085         pSource := aBitmap.Scanline[Row];
7086         if (Assigned(pSource)) then begin
7087           Move(pSource^, pTempData^, RowSize);
7088           Inc(pTempData, RowSize);
7089         end;
7090       end;
7091       SetData(pData, IntFormat, TempWidth, TempHeight);
7092       result := true;
7093     except
7094       if Assigned(pData) then
7095         FreeMem(pData);
7096       raise;
7097     end;
7098   end;
7099 end;
7100
7101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7102 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7103 var
7104   Row, Col, AlphaInterleave: Integer;
7105   pSource, pDest: PByte;
7106 begin
7107   result := false;
7108
7109   if Assigned(Data) then begin
7110     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7111       if Assigned(aBitmap) then begin
7112         aBitmap.PixelFormat := pf8bit;
7113         aBitmap.Palette     := CreateGrayPalette;
7114         aBitmap.Width       := Width;
7115         aBitmap.Height      := Height;
7116
7117         case Format of
7118           tfLuminance8Alpha8ub2:
7119             AlphaInterleave := 1;
7120           tfRGBA8ub4, tfBGRA8ub4:
7121             AlphaInterleave := 3;
7122           else
7123             AlphaInterleave := 0;
7124         end;
7125
7126         // Copy Data
7127         pSource := Data;
7128
7129         for Row := 0 to Height -1 do begin
7130           pDest := aBitmap.Scanline[Row];
7131           if Assigned(pDest) then begin
7132             for Col := 0 to Width -1 do begin
7133               Inc(pSource, AlphaInterleave);
7134               pDest^ := pSource^;
7135               Inc(pDest);
7136               Inc(pSource);
7137             end;
7138           end;
7139         end;
7140         result := true;
7141       end;
7142     end;
7143   end;
7144 end;
7145
7146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7147 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7148 var
7149   data: TglBitmapData;
7150 begin
7151   data := TglBitmapData.Create;
7152   try
7153     data.AssignFromBitmap(aBitmap);
7154     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7155   finally
7156     data.Free;
7157   end;
7158 end;
7159 {$ENDIF}
7160
7161 {$IFDEF GLB_LAZARUS}
7162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7163 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7164 var
7165   rid: TRawImageDescription;
7166   FormatDesc: TFormatDescriptor;
7167 begin
7168   if not Assigned(Data) then
7169     raise EglBitmap.Create('no pixel data assigned. load data before save');
7170
7171   result := false;
7172   if not Assigned(aImage) or (Format = tfEmpty) then
7173     exit;
7174   FormatDesc := TFormatDescriptor.Get(Format);
7175   if FormatDesc.IsCompressed then
7176     exit;
7177
7178   FillChar(rid{%H-}, SizeOf(rid), 0);
7179   if FormatDesc.IsGrayscale then
7180     rid.Format := ricfGray
7181   else
7182     rid.Format := ricfRGBA;
7183
7184   rid.Width        := Width;
7185   rid.Height       := Height;
7186   rid.Depth        := FormatDesc.BitsPerPixel;
7187   rid.BitOrder     := riboBitsInOrder;
7188   rid.ByteOrder    := riboLSBFirst;
7189   rid.LineOrder    := riloTopToBottom;
7190   rid.LineEnd      := rileTight;
7191   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7192   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7193   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7194   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7195   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7196   rid.RedShift     := FormatDesc.Shift.r;
7197   rid.GreenShift   := FormatDesc.Shift.g;
7198   rid.BlueShift    := FormatDesc.Shift.b;
7199   rid.AlphaShift   := FormatDesc.Shift.a;
7200
7201   rid.MaskBitsPerPixel  := 0;
7202   rid.PaletteColorCount := 0;
7203
7204   aImage.DataDescription := rid;
7205   aImage.CreateData;
7206
7207   if not Assigned(aImage.PixelData) then
7208     raise EglBitmap.Create('error while creating LazIntfImage');
7209   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7210
7211   result := true;
7212 end;
7213
7214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7215 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7216 var
7217   f: TglBitmapFormat;
7218   FormatDesc: TFormatDescriptor;
7219   ImageData: PByte;
7220   ImageSize: Integer;
7221   CanCopy: Boolean;
7222   Mask: TglBitmapRec4ul;
7223
7224   procedure CopyConvert;
7225   var
7226     bfFormat: TbmpBitfieldFormat;
7227     pSourceLine, pDestLine: PByte;
7228     pSourceMD, pDestMD: Pointer;
7229     Shift, Prec: TglBitmapRec4ub;
7230     x, y: Integer;
7231     pixel: TglBitmapPixelData;
7232   begin
7233     bfFormat  := TbmpBitfieldFormat.Create;
7234     with aImage.DataDescription do begin
7235       Prec.r := RedPrec;
7236       Prec.g := GreenPrec;
7237       Prec.b := BluePrec;
7238       Prec.a := AlphaPrec;
7239       Shift.r := RedShift;
7240       Shift.g := GreenShift;
7241       Shift.b := BlueShift;
7242       Shift.a := AlphaShift;
7243       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7244     end;
7245     pSourceMD := bfFormat.CreateMappingData;
7246     pDestMD   := FormatDesc.CreateMappingData;
7247     try
7248       for y := 0 to aImage.Height-1 do begin
7249         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7250         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7251         for x := 0 to aImage.Width-1 do begin
7252           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7253           FormatDesc.Map(pixel, pDestLine, pDestMD);
7254         end;
7255       end;
7256     finally
7257       FormatDesc.FreeMappingData(pDestMD);
7258       bfFormat.FreeMappingData(pSourceMD);
7259       bfFormat.Free;
7260     end;
7261   end;
7262
7263 begin
7264   result := false;
7265   if not Assigned(aImage) then
7266     exit;
7267
7268   with aImage.DataDescription do begin
7269     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7270     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7271     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7272     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7273   end;
7274   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7275   f          := FormatDesc.Format;
7276   if (f = tfEmpty) then
7277     exit;
7278
7279   CanCopy :=
7280     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7281     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7282
7283   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7284   ImageData := GetMem(ImageSize);
7285   try
7286     if CanCopy then
7287       Move(aImage.PixelData^, ImageData^, ImageSize)
7288     else
7289       CopyConvert;
7290     SetData(ImageData, f, aImage.Width, aImage.Height);
7291   except
7292     if Assigned(ImageData) then
7293       FreeMem(ImageData);
7294     raise;
7295   end;
7296
7297   result := true;
7298 end;
7299
7300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7301 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7302 var
7303   rid: TRawImageDescription;
7304   FormatDesc: TFormatDescriptor;
7305   Pixel: TglBitmapPixelData;
7306   x, y: Integer;
7307   srcMD: Pointer;
7308   src, dst: PByte;
7309 begin
7310   result := false;
7311   if not Assigned(aImage) or (Format = tfEmpty) then
7312     exit;
7313   FormatDesc := TFormatDescriptor.Get(Format);
7314   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7315     exit;
7316
7317   FillChar(rid{%H-}, SizeOf(rid), 0);
7318   rid.Format       := ricfGray;
7319   rid.Width        := Width;
7320   rid.Height       := Height;
7321   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7322   rid.BitOrder     := riboBitsInOrder;
7323   rid.ByteOrder    := riboLSBFirst;
7324   rid.LineOrder    := riloTopToBottom;
7325   rid.LineEnd      := rileTight;
7326   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7327   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7328   rid.GreenPrec    := 0;
7329   rid.BluePrec     := 0;
7330   rid.AlphaPrec    := 0;
7331   rid.RedShift     := 0;
7332   rid.GreenShift   := 0;
7333   rid.BlueShift    := 0;
7334   rid.AlphaShift   := 0;
7335
7336   rid.MaskBitsPerPixel  := 0;
7337   rid.PaletteColorCount := 0;
7338
7339   aImage.DataDescription := rid;
7340   aImage.CreateData;
7341
7342   srcMD := FormatDesc.CreateMappingData;
7343   try
7344     FormatDesc.PreparePixel(Pixel);
7345     src := Data;
7346     dst := aImage.PixelData;
7347     for y := 0 to Height-1 do
7348       for x := 0 to Width-1 do begin
7349         FormatDesc.Unmap(src, Pixel, srcMD);
7350         case rid.BitsPerPixel of
7351            8: begin
7352             dst^ := Pixel.Data.a;
7353             inc(dst);
7354           end;
7355           16: begin
7356             PWord(dst)^ := Pixel.Data.a;
7357             inc(dst, 2);
7358           end;
7359           24: begin
7360             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7361             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7362             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7363             inc(dst, 3);
7364           end;
7365           32: begin
7366             PCardinal(dst)^ := Pixel.Data.a;
7367             inc(dst, 4);
7368           end;
7369         else
7370           raise EglBitmapUnsupportedFormat.Create(Format);
7371         end;
7372       end;
7373   finally
7374     FormatDesc.FreeMappingData(srcMD);
7375   end;
7376   result := true;
7377 end;
7378
7379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7380 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7381 var
7382   data: TglBitmapData;
7383 begin
7384   data := TglBitmapData.Create;
7385   try
7386     data.AssignFromLazIntfImage(aImage);
7387     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7388   finally
7389     data.Free;
7390   end;
7391 end;
7392 {$ENDIF}
7393
7394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7395 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7396   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7397 var
7398   rs: TResourceStream;
7399 begin
7400   PrepareResType(aResource, aResType);
7401   rs := TResourceStream.Create(aInstance, aResource, aResType);
7402   try
7403     result := AddAlphaFromStream(rs, aFunc, aArgs);
7404   finally
7405     rs.Free;
7406   end;
7407 end;
7408
7409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7410 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7411   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7412 var
7413   rs: TResourceStream;
7414 begin
7415   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7416   try
7417     result := AddAlphaFromStream(rs, aFunc, aArgs);
7418   finally
7419     rs.Free;
7420   end;
7421 end;
7422
7423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7424 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7425 begin
7426   if TFormatDescriptor.Get(Format).IsCompressed then
7427     raise EglBitmapUnsupportedFormat.Create(Format);
7428   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7429 end;
7430
7431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7432 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7433 var
7434   FS: TFileStream;
7435 begin
7436   FS := TFileStream.Create(aFileName, fmOpenRead);
7437   try
7438     result := AddAlphaFromStream(FS, aFunc, aArgs);
7439   finally
7440     FS.Free;
7441   end;
7442 end;
7443
7444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7445 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7446 var
7447   data: TglBitmapData;
7448 begin
7449   data := TglBitmapData.Create(aStream);
7450   try
7451     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7452   finally
7453     data.Free;
7454   end;
7455 end;
7456
7457 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7458 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7459 var
7460   DestData, DestData2, SourceData: pByte;
7461   TempHeight, TempWidth: Integer;
7462   SourceFD, DestFD: TFormatDescriptor;
7463   SourceMD, DestMD, DestMD2: Pointer;
7464
7465   FuncRec: TglBitmapFunctionRec;
7466 begin
7467   result := false;
7468
7469   Assert(Assigned(Data));
7470   Assert(Assigned(aDataObj));
7471   Assert(Assigned(aDataObj.Data));
7472
7473   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7474     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7475
7476     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7477     DestFD   := TFormatDescriptor.Get(Format);
7478
7479     if not Assigned(aFunc) then begin
7480       aFunc        := glBitmapAlphaFunc;
7481       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7482     end else
7483       FuncRec.Args := aArgs;
7484
7485     // Values
7486     TempWidth  := aDataObj.Width;
7487     TempHeight := aDataObj.Height;
7488     if (TempWidth <= 0) or (TempHeight <= 0) then
7489       exit;
7490
7491     FuncRec.Sender          := Self;
7492     FuncRec.Size            := Dimension;
7493     FuncRec.Position.Fields := FuncRec.Size.Fields;
7494
7495     DestData   := Data;
7496     DestData2  := Data;
7497     SourceData := aDataObj.Data;
7498
7499     // Mapping
7500     SourceFD.PreparePixel(FuncRec.Source);
7501     DestFD.PreparePixel  (FuncRec.Dest);
7502
7503     SourceMD := SourceFD.CreateMappingData;
7504     DestMD   := DestFD.CreateMappingData;
7505     DestMD2  := DestFD.CreateMappingData;
7506     try
7507       FuncRec.Position.Y := 0;
7508       while FuncRec.Position.Y < TempHeight do begin
7509         FuncRec.Position.X := 0;
7510         while FuncRec.Position.X < TempWidth do begin
7511           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7512           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7513           aFunc(FuncRec);
7514           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7515           inc(FuncRec.Position.X);
7516         end;
7517         inc(FuncRec.Position.Y);
7518       end;
7519     finally
7520       SourceFD.FreeMappingData(SourceMD);
7521       DestFD.FreeMappingData(DestMD);
7522       DestFD.FreeMappingData(DestMD2);
7523     end;
7524   end;
7525 end;
7526
7527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7528 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7529 begin
7530   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7531 end;
7532
7533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7534 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7535 var
7536   PixelData: TglBitmapPixelData;
7537 begin
7538   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7539   result := AddAlphaFromColorKeyFloat(
7540     aRed   / PixelData.Range.r,
7541     aGreen / PixelData.Range.g,
7542     aBlue  / PixelData.Range.b,
7543     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7544 end;
7545
7546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7547 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7548 var
7549   values: array[0..2] of Single;
7550   tmp: Cardinal;
7551   i: Integer;
7552   PixelData: TglBitmapPixelData;
7553 begin
7554   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7555   with PixelData do begin
7556     values[0] := aRed;
7557     values[1] := aGreen;
7558     values[2] := aBlue;
7559
7560     for i := 0 to 2 do begin
7561       tmp          := Trunc(Range.arr[i] * aDeviation);
7562       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7563       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7564     end;
7565     Data.a  := 0;
7566     Range.a := 0;
7567   end;
7568   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7569 end;
7570
7571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7572 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7573 begin
7574   result := AddAlphaFromValueFloat(aAlpha / $FF);
7575 end;
7576
7577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7578 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7579 var
7580   PixelData: TglBitmapPixelData;
7581 begin
7582   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7583   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7584 end;
7585
7586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7587 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7588 var
7589   PixelData: TglBitmapPixelData;
7590 begin
7591   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7592   with PixelData do
7593     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7594   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7595 end;
7596
7597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7598 function TglBitmapData.RemoveAlpha: Boolean;
7599 var
7600   FormatDesc: TFormatDescriptor;
7601 begin
7602   result := false;
7603   FormatDesc := TFormatDescriptor.Get(Format);
7604   if Assigned(Data) then begin
7605     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7606       raise EglBitmapUnsupportedFormat.Create(Format);
7607     result := ConvertTo(FormatDesc.WithoutAlpha);
7608   end;
7609 end;
7610
7611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7612 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7613   const aAlpha: Byte);
7614 begin
7615   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7616 end;
7617
7618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7619 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7620 var
7621   PixelData: TglBitmapPixelData;
7622 begin
7623   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7624   FillWithColorFloat(
7625     aRed   / PixelData.Range.r,
7626     aGreen / PixelData.Range.g,
7627     aBlue  / PixelData.Range.b,
7628     aAlpha / PixelData.Range.a);
7629 end;
7630
7631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7632 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7633 var
7634   PixelData: TglBitmapPixelData;
7635 begin
7636   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7637   with PixelData do begin
7638     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7639     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7640     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7641     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7642   end;
7643   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7644 end;
7645
7646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7647 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7648 begin
7649   if (Data <> aData) then begin
7650     if (Assigned(Data)) then
7651       FreeMem(Data);
7652     fData := aData;
7653   end;
7654
7655   if Assigned(fData) then begin
7656     FillChar(fDimension, SizeOf(fDimension), 0);
7657     if aWidth <> -1 then begin
7658       fDimension.Fields := fDimension.Fields + [ffX];
7659       fDimension.X := aWidth;
7660     end;
7661
7662     if aHeight <> -1 then begin
7663       fDimension.Fields := fDimension.Fields + [ffY];
7664       fDimension.Y := aHeight;
7665     end;
7666
7667     fFormat := aFormat;
7668   end else
7669     fFormat := tfEmpty;
7670
7671   UpdateScanlines;
7672 end;
7673
7674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7675 function TglBitmapData.Clone: TglBitmapData;
7676 var
7677   Temp: TglBitmapData;
7678   TempPtr: PByte;
7679   Size: Integer;
7680 begin
7681   result := nil;
7682   Temp := (ClassType.Create as TglBitmapData);
7683   try
7684     // copy texture data if assigned
7685     if Assigned(Data) then begin
7686       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7687       GetMem(TempPtr, Size);
7688       try
7689         Move(Data^, TempPtr^, Size);
7690         Temp.SetData(TempPtr, Format, Width, Height);
7691       except
7692         if Assigned(TempPtr) then
7693           FreeMem(TempPtr);
7694         raise;
7695       end;
7696     end else begin
7697       TempPtr := nil;
7698       Temp.SetData(TempPtr, Format, Width, Height);
7699     end;
7700
7701           // copy properties
7702     Temp.fFormat := Format;
7703     result := Temp;
7704   except
7705     FreeAndNil(Temp);
7706     raise;
7707   end;
7708 end;
7709
7710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7711 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7712 var
7713   mask: PtrInt;
7714 begin
7715   mask :=
7716      (Byte(aRed)   and 1)        or
7717     ((Byte(aGreen) and 1) shl 1) or
7718     ((Byte(aBlue)  and 1) shl 2) or
7719     ((Byte(aAlpha) and 1) shl 3);
7720   if (mask > 0) then
7721     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7722 end;
7723
7724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7725 type
7726   TMatrixItem = record
7727     X, Y: Integer;
7728     W: Single;
7729   end;
7730
7731   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7732   TglBitmapToNormalMapRec = Record
7733     Scale: Single;
7734     Heights: array of Single;
7735     MatrixU : array of TMatrixItem;
7736     MatrixV : array of TMatrixItem;
7737   end;
7738
7739 const
7740   ONE_OVER_255 = 1 / 255;
7741
7742   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7743 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7744 var
7745   Val: Single;
7746 begin
7747   with FuncRec do begin
7748     Val :=
7749       Source.Data.r * LUMINANCE_WEIGHT_R +
7750       Source.Data.g * LUMINANCE_WEIGHT_G +
7751       Source.Data.b * LUMINANCE_WEIGHT_B;
7752     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7753   end;
7754 end;
7755
7756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7757 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7758 begin
7759   with FuncRec do
7760     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7761 end;
7762
7763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7764 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7765 type
7766   TVec = Array[0..2] of Single;
7767 var
7768   Idx: Integer;
7769   du, dv: Double;
7770   Len: Single;
7771   Vec: TVec;
7772
7773   function GetHeight(X, Y: Integer): Single;
7774   begin
7775     with FuncRec do begin
7776       X := Max(0, Min(Size.X -1, X));
7777       Y := Max(0, Min(Size.Y -1, Y));
7778       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7779     end;
7780   end;
7781
7782 begin
7783   with FuncRec do begin
7784     with PglBitmapToNormalMapRec(Args)^ do begin
7785       du := 0;
7786       for Idx := Low(MatrixU) to High(MatrixU) do
7787         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7788
7789       dv := 0;
7790       for Idx := Low(MatrixU) to High(MatrixU) do
7791         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7792
7793       Vec[0] := -du * Scale;
7794       Vec[1] := -dv * Scale;
7795       Vec[2] := 1;
7796     end;
7797
7798     // Normalize
7799     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7800     if Len <> 0 then begin
7801       Vec[0] := Vec[0] * Len;
7802       Vec[1] := Vec[1] * Len;
7803       Vec[2] := Vec[2] * Len;
7804     end;
7805
7806     // Farbe zuweisem
7807     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7808     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7809     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7810   end;
7811 end;
7812
7813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7814 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7815 var
7816   Rec: TglBitmapToNormalMapRec;
7817
7818   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7819   begin
7820     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7821       Matrix[Index].X := X;
7822       Matrix[Index].Y := Y;
7823       Matrix[Index].W := W;
7824     end;
7825   end;
7826
7827 begin
7828   if TFormatDescriptor.Get(Format).IsCompressed then
7829     raise EglBitmapUnsupportedFormat.Create(Format);
7830
7831   if aScale > 100 then
7832     Rec.Scale := 100
7833   else if aScale < -100 then
7834     Rec.Scale := -100
7835   else
7836     Rec.Scale := aScale;
7837
7838   SetLength(Rec.Heights, Width * Height);
7839   try
7840     case aFunc of
7841       nm4Samples: begin
7842         SetLength(Rec.MatrixU, 2);
7843         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7844         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7845
7846         SetLength(Rec.MatrixV, 2);
7847         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7848         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7849       end;
7850
7851       nmSobel: begin
7852         SetLength(Rec.MatrixU, 6);
7853         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7854         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7855         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7856         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7857         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7858         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7859
7860         SetLength(Rec.MatrixV, 6);
7861         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7862         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7863         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7864         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7865         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7866         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7867       end;
7868
7869       nm3x3: begin
7870         SetLength(Rec.MatrixU, 6);
7871         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7872         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7873         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7874         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7875         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7876         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7877
7878         SetLength(Rec.MatrixV, 6);
7879         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7880         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7881         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7882         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7883         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7884         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7885       end;
7886
7887       nm5x5: begin
7888         SetLength(Rec.MatrixU, 20);
7889         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7890         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7891         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7892         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7893         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7894         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7895         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7896         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7897         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7898         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7899         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7900         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7901         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7902         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7903         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7904         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7905         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7906         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7907         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7908         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7909
7910         SetLength(Rec.MatrixV, 20);
7911         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7912         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7913         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7914         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7915         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7916         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7917         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7918         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7919         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7920         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7921         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7922         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7923         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7924         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7925         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7926         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7927         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7928         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7929         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7930         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7931       end;
7932     end;
7933
7934     // Daten Sammeln
7935     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7936       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7937     else
7938       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7939     Convert(glBitmapToNormalMapFunc, false, @Rec);
7940   finally
7941     SetLength(Rec.Heights, 0);
7942   end;
7943 end;
7944
7945 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7946 constructor TglBitmapData.Create;
7947 begin
7948   inherited Create;
7949   fFormat := glBitmapDefaultFormat;
7950 end;
7951
7952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7953 constructor TglBitmapData.Create(const aFileName: String);
7954 begin
7955   Create;
7956   LoadFromFile(aFileName);
7957 end;
7958
7959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7960 constructor TglBitmapData.Create(const aStream: TStream);
7961 begin
7962   Create;
7963   LoadFromStream(aStream);
7964 end;
7965
7966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7967 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7968 var
7969   ImageSize: Integer;
7970 begin
7971   Create;
7972   if not Assigned(aData) then begin
7973     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7974     GetMem(aData, ImageSize);
7975     try
7976       FillChar(aData^, ImageSize, #$FF);
7977       SetData(aData, aFormat, aSize.X, aSize.Y);
7978     except
7979       if Assigned(aData) then
7980         FreeMem(aData);
7981       raise;
7982     end;
7983   end else begin
7984     SetData(aData, aFormat, aSize.X, aSize.Y);
7985   end;
7986 end;
7987
7988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7989 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
7990 begin
7991   Create;
7992   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
7993 end;
7994
7995 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7996 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
7997 begin
7998   Create;
7999   LoadFromResource(aInstance, aResource, aResType);
8000 end;
8001
8002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8003 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8004 begin
8005   Create;
8006   LoadFromResourceID(aInstance, aResourceID, aResType);
8007 end;
8008
8009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8010 destructor TglBitmapData.Destroy;
8011 begin
8012   SetData(nil, tfEmpty);
8013   inherited Destroy;
8014 end;
8015
8016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8017 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8019 function TglBitmap.GetWidth: Integer;
8020 begin
8021   if (ffX in fDimension.Fields) then
8022     result := fDimension.X
8023   else
8024     result := -1;
8025 end;
8026
8027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8028 function TglBitmap.GetHeight: Integer;
8029 begin
8030   if (ffY in fDimension.Fields) then
8031     result := fDimension.Y
8032   else
8033     result := -1;
8034 end;
8035
8036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8037 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8038 begin
8039   if fCustomData = aValue then
8040     exit;
8041   fCustomData := aValue;
8042 end;
8043
8044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8045 procedure TglBitmap.SetCustomName(const aValue: String);
8046 begin
8047   if fCustomName = aValue then
8048     exit;
8049   fCustomName := aValue;
8050 end;
8051
8052 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8053 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8054 begin
8055   if fCustomNameW = aValue then
8056     exit;
8057   fCustomNameW := aValue;
8058 end;
8059
8060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8061 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8062 begin
8063   if fDeleteTextureOnFree = aValue then
8064     exit;
8065   fDeleteTextureOnFree := aValue;
8066 end;
8067
8068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8069 procedure TglBitmap.SetID(const aValue: Cardinal);
8070 begin
8071   if fID = aValue then
8072     exit;
8073   fID := aValue;
8074 end;
8075
8076 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8077 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8078 begin
8079   if fMipMap = aValue then
8080     exit;
8081   fMipMap := aValue;
8082 end;
8083
8084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8085 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8086 begin
8087   if fTarget = aValue then
8088     exit;
8089   fTarget := aValue;
8090 end;
8091
8092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8093 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8094 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8095 var
8096   MaxAnisotropic: Integer;
8097 {$IFEND}
8098 begin
8099   fAnisotropic := aValue;
8100   if (ID > 0) then begin
8101 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8102     if GL_EXT_texture_filter_anisotropic then begin
8103       if fAnisotropic > 0 then begin
8104         Bind(false);
8105         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8106         if aValue > MaxAnisotropic then
8107           fAnisotropic := MaxAnisotropic;
8108         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8109       end;
8110     end else begin
8111       fAnisotropic := 0;
8112     end;
8113 {$ELSE}
8114     fAnisotropic := 0;
8115 {$IFEND}
8116   end;
8117 end;
8118
8119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8120 procedure TglBitmap.CreateID;
8121 begin
8122   if (ID <> 0) then
8123     glDeleteTextures(1, @fID);
8124   glGenTextures(1, @fID);
8125   Bind(false);
8126 end;
8127
8128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8129 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8130 begin
8131   // Set Up Parameters
8132   SetWrap(fWrapS, fWrapT, fWrapR);
8133   SetFilter(fFilterMin, fFilterMag);
8134   SetAnisotropic(fAnisotropic);
8135
8136 {$IFNDEF OPENGL_ES}
8137   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8138   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8139     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8140 {$ENDIF}
8141
8142 {$IFNDEF OPENGL_ES}
8143   // Mip Maps Generation Mode
8144   aBuildWithGlu := false;
8145   if (MipMap = mmMipmap) then begin
8146     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8147       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
8148     else
8149       aBuildWithGlu := true;
8150   end else if (MipMap = mmMipmapGlu) then
8151     aBuildWithGlu := true;
8152 {$ELSE}
8153   if (MipMap = mmMipmap) then
8154     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
8155 {$ENDIF}
8156 end;
8157
8158 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8159 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8161 procedure TglBitmap.AfterConstruction;
8162 begin
8163   inherited AfterConstruction;
8164
8165   fID         := 0;
8166   fTarget     := 0;
8167 {$IFNDEF OPENGL_ES}
8168   fIsResident := false;
8169 {$ENDIF}
8170
8171   fMipMap              := glBitmapDefaultMipmap;
8172   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8173
8174   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8175   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8176 {$IFNDEF OPENGL_ES}
8177   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8178 {$ENDIF}
8179 end;
8180
8181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8182 procedure TglBitmap.BeforeDestruction;
8183 begin
8184   if (fID > 0) and fDeleteTextureOnFree then
8185     glDeleteTextures(1, @fID);
8186   inherited BeforeDestruction;
8187 end;
8188
8189 {$IFNDEF OPENGL_ES}
8190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8191 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8192 begin
8193   fBorderColor[0] := aRed;
8194   fBorderColor[1] := aGreen;
8195   fBorderColor[2] := aBlue;
8196   fBorderColor[3] := aAlpha;
8197   if (ID > 0) then begin
8198     Bind(false);
8199     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8200   end;
8201 end;
8202 {$ENDIF}
8203
8204 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8205 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8206 begin
8207   //check MIN filter
8208   case aMin of
8209     GL_NEAREST:
8210       fFilterMin := GL_NEAREST;
8211     GL_LINEAR:
8212       fFilterMin := GL_LINEAR;
8213     GL_NEAREST_MIPMAP_NEAREST:
8214       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8215     GL_LINEAR_MIPMAP_NEAREST:
8216       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8217     GL_NEAREST_MIPMAP_LINEAR:
8218       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8219     GL_LINEAR_MIPMAP_LINEAR:
8220       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8221     else
8222       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8223   end;
8224
8225   //check MAG filter
8226   case aMag of
8227     GL_NEAREST:
8228       fFilterMag := GL_NEAREST;
8229     GL_LINEAR:
8230       fFilterMag := GL_LINEAR;
8231     else
8232       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8233   end;
8234
8235   //apply filter
8236   if (ID > 0) then begin
8237     Bind(false);
8238     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8239
8240     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8241       case fFilterMin of
8242         GL_NEAREST, GL_LINEAR:
8243           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8244         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8245           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8246         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8247           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8248       end;
8249     end else
8250       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8251   end;
8252 end;
8253
8254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8255 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8256
8257   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8258   begin
8259     case aValue of
8260 {$IFNDEF OPENGL_ES}
8261       GL_CLAMP:
8262         aTarget := GL_CLAMP;
8263 {$ENDIF}
8264
8265       GL_REPEAT:
8266         aTarget := GL_REPEAT;
8267
8268       GL_CLAMP_TO_EDGE: begin
8269 {$IFNDEF OPENGL_ES}
8270         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8271           aTarget := GL_CLAMP
8272         else
8273 {$ENDIF}
8274           aTarget := GL_CLAMP_TO_EDGE;
8275       end;
8276
8277 {$IFNDEF OPENGL_ES}
8278       GL_CLAMP_TO_BORDER: begin
8279         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8280           aTarget := GL_CLAMP_TO_BORDER
8281         else
8282           aTarget := GL_CLAMP;
8283       end;
8284 {$ENDIF}
8285
8286 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8287       GL_MIRRORED_REPEAT: begin
8288   {$IFNDEF OPENGL_ES}
8289         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8290   {$ELSE}
8291         if GL_VERSION_2_0 then
8292   {$ENDIF}
8293           aTarget := GL_MIRRORED_REPEAT
8294         else
8295           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8296       end;
8297 {$IFEND}
8298     else
8299       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8300     end;
8301   end;
8302
8303 begin
8304   CheckAndSetWrap(S, fWrapS);
8305   CheckAndSetWrap(T, fWrapT);
8306   CheckAndSetWrap(R, fWrapR);
8307
8308   if (ID > 0) then begin
8309     Bind(false);
8310     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8311     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8312 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8313     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8314     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8315 {$IFEND}
8316   end;
8317 end;
8318
8319 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8321 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8322
8323   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8324   begin
8325     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8326        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8327       fSwizzle[aIndex] := aValue
8328     else
8329       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8330   end;
8331
8332 begin
8333 {$IFNDEF OPENGL_ES}
8334   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8335     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8336 {$ELSE}
8337   if not GL_VERSION_3_0 then
8338     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8339 {$ENDIF}
8340   CheckAndSetValue(r, 0);
8341   CheckAndSetValue(g, 1);
8342   CheckAndSetValue(b, 2);
8343   CheckAndSetValue(a, 3);
8344
8345   if (ID > 0) then begin
8346     Bind(false);
8347 {$IFNDEF OPENGL_ES}
8348     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8349 {$ELSE}
8350     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8351     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8352     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8353     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8354 {$ENDIF}
8355   end;
8356 end;
8357 {$IFEND}
8358
8359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8360 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
8361 begin
8362   if aEnableTextureUnit then
8363     glEnable(Target);
8364   if (ID > 0) then
8365     glBindTexture(Target, ID);
8366 end;
8367
8368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8369 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
8370 begin
8371   if aDisableTextureUnit then
8372     glDisable(Target);
8373   glBindTexture(Target, 0);
8374 end;
8375
8376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8377 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8378 var
8379   w, h: Integer;
8380 begin
8381   w := aDataObj.Width;
8382   h := aDataObj.Height;
8383   fDimension.Fields := [];
8384   if (w > 0) then
8385     fDimension.Fields := fDimension.Fields + [ffX];
8386   if (h > 0) then
8387     fDimension.Fields := fDimension.Fields + [ffY];
8388   fDimension.X := w;
8389   fDimension.Y := h;
8390 end;
8391
8392 {$IFNDEF OPENGL_ES}
8393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8394 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8395 var
8396   Temp: PByte;
8397   TempWidth, TempHeight: Integer;
8398   TempIntFormat: GLint;
8399   IntFormat: TglBitmapFormat;
8400   FormatDesc: TFormatDescriptor;
8401 begin
8402   result := false;
8403   Bind;
8404
8405   // Request Data
8406   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8407   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8408   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8409
8410   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8411   IntFormat  := FormatDesc.Format;
8412
8413   // Getting data from OpenGL
8414   FormatDesc := TFormatDescriptor.Get(IntFormat);
8415   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8416   try
8417     if FormatDesc.IsCompressed then begin
8418       if not Assigned(glGetCompressedTexImage) then
8419         raise EglBitmap.Create('compressed formats not supported by video adapter');
8420       glGetCompressedTexImage(Target, 0, Temp)
8421     end else
8422       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8423     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8424     result := true;
8425   except
8426     if Assigned(Temp) then
8427       FreeMem(Temp);
8428     raise;
8429   end;
8430 end;
8431 {$ENDIF}
8432
8433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8434 constructor TglBitmap.Create;
8435 begin
8436   if (ClassType = TglBitmap) then
8437     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8438   inherited Create;
8439 end;
8440
8441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8442 constructor TglBitmap.Create(const aData: TglBitmapData);
8443 begin
8444   Create;
8445   UploadData(aData);
8446 end;
8447
8448 {$IFNDEF OPENGL_ES}
8449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8450 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8452 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8453 var
8454   fd: TglBitmapFormatDescriptor;
8455 begin
8456   // Upload data
8457   fd := aDataObj.FormatDescriptor;
8458   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8459     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8460
8461   if fd.IsCompressed then begin
8462     if not Assigned(glCompressedTexImage1D) then
8463       raise EglBitmap.Create('compressed formats not supported by video adapter');
8464     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8465   end else if aBuildWithGlu then
8466     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8467   else
8468     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8469 end;
8470
8471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8472 procedure TglBitmap1D.AfterConstruction;
8473 begin
8474   inherited;
8475   Target := GL_TEXTURE_1D;
8476 end;
8477
8478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8479 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8480 var
8481   BuildWithGlu, TexRec: Boolean;
8482   TexSize: Integer;
8483 begin
8484   if not Assigned(aDataObj) then
8485     exit;
8486
8487   // Check Texture Size
8488   if (aCheckSize) then begin
8489     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8490
8491     if (aDataObj.Width > TexSize) then
8492       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8493
8494     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8495               (Target = GL_TEXTURE_RECTANGLE);
8496     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8497       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8498   end;
8499
8500   if (fID = 0) then
8501     CreateID;
8502   SetupParameters(BuildWithGlu);
8503   UploadDataIntern(aDataObj, BuildWithGlu);
8504   glAreTexturesResident(1, @fID, @fIsResident);
8505
8506   inherited UploadData(aDataObj, aCheckSize);
8507 end;
8508 {$ENDIF}
8509
8510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8511 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8513 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
8514 var
8515   fd: TglBitmapFormatDescriptor;
8516 begin
8517   fd := aDataObj.FormatDescriptor;
8518   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8519     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8520
8521   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8522
8523   if fd.IsCompressed then begin
8524     if not Assigned(glCompressedTexImage2D) then
8525       raise EglBitmap.Create('compressed formats not supported by video adapter');
8526     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8527 {$IFNDEF OPENGL_ES}
8528   end else if aBuildWithGlu then begin
8529     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8530 {$ENDIF}
8531   end else begin
8532     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8533   end;
8534 end;
8535
8536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8537 procedure TglBitmap2D.AfterConstruction;
8538 begin
8539   inherited;
8540   Target := GL_TEXTURE_2D;
8541 end;
8542
8543 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8544 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8545 var
8546   {$IFNDEF OPENGL_ES}
8547   BuildWithGlu, TexRec: Boolean;
8548   {$ENDIF}
8549   PotTex: Boolean;
8550   TexSize: Integer;
8551 begin
8552   if not Assigned(aDataObj) then
8553     exit;
8554
8555   // Check Texture Size
8556   if (aCheckSize) then begin
8557     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8558
8559     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8560       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8561
8562     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8563 {$IF NOT DEFINED(OPENGL_ES)}
8564     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8565     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8566       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8567 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8568     if not PotTex and not GL_OES_texture_npot then
8569       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8570 {$ELSE}
8571     if not PotTex then
8572       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8573 {$IFEND}
8574   end;
8575
8576   if (fID = 0) then
8577     CreateID;
8578   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8579   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8580 {$IFNDEF OPENGL_ES}
8581   glAreTexturesResident(1, @fID, @fIsResident);
8582 {$ENDIF}
8583
8584   inherited UploadData(aDataObj, aCheckSize);
8585 end;
8586
8587 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8588 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8589 var
8590   Temp: pByte;
8591   Size, w, h: Integer;
8592   FormatDesc: TFormatDescriptor;
8593 begin
8594   FormatDesc := TFormatDescriptor.Get(aFormat);
8595   if FormatDesc.IsCompressed then
8596     raise EglBitmapUnsupportedFormat.Create(aFormat);
8597
8598   w    := aRight  - aLeft;
8599   h    := aBottom - aTop;
8600   Size := FormatDesc.GetSize(w, h);
8601   GetMem(Temp, Size);
8602   try
8603     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8604     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8605     aDataObj.SetData(Temp, aFormat, w, h);
8606     aDataObj.FlipVert;
8607   except
8608     if Assigned(Temp) then
8609       FreeMem(Temp);
8610     raise;
8611   end;
8612 end;
8613
8614 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8616 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8618 procedure TglBitmapCubeMap.AfterConstruction;
8619 begin
8620   inherited;
8621
8622 {$IFNDEF OPENGL_ES}
8623   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8624     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8625 {$ELSE}
8626   if not (GL_VERSION_2_0) then
8627     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8628 {$ENDIF}
8629
8630   SetWrap;
8631   Target   := GL_TEXTURE_CUBE_MAP;
8632 {$IFNDEF OPENGL_ES}
8633   fGenMode := GL_REFLECTION_MAP;
8634 {$ENDIF}
8635 end;
8636
8637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8638 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8639 begin
8640   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8641 end;
8642
8643 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8644 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8645 var
8646   {$IFNDEF OPENGL_ES}
8647   BuildWithGlu: Boolean;
8648   {$ENDIF}
8649   TexSize: Integer;
8650 begin
8651   if (aCheckSize) then begin
8652     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8653
8654     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8655       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8656
8657 {$IF NOT DEFINED(OPENGL_ES)}
8658     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8659       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8660 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8661     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8662       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8663 {$ELSE}
8664     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8665       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8666 {$IFEND}
8667   end;
8668
8669   if (fID = 0) then
8670     CreateID;
8671   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8672   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8673
8674   inherited UploadData(aDataObj, aCheckSize);
8675 end;
8676
8677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8678 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8679 begin
8680   inherited Bind (aEnableTextureUnit);
8681 {$IFNDEF OPENGL_ES}
8682   if aEnableTexCoordsGen then begin
8683     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8684     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8685     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8686     glEnable(GL_TEXTURE_GEN_S);
8687     glEnable(GL_TEXTURE_GEN_T);
8688     glEnable(GL_TEXTURE_GEN_R);
8689   end;
8690 {$ENDIF}
8691 end;
8692
8693 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8694 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8695 begin
8696   inherited Unbind(aDisableTextureUnit);
8697 {$IFNDEF OPENGL_ES}
8698   if aDisableTexCoordsGen then begin
8699     glDisable(GL_TEXTURE_GEN_S);
8700     glDisable(GL_TEXTURE_GEN_T);
8701     glDisable(GL_TEXTURE_GEN_R);
8702   end;
8703 {$ENDIF}
8704 end;
8705 {$IFEND}
8706
8707 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8709 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8711 type
8712   TVec = Array[0..2] of Single;
8713   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8714
8715   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8716   TglBitmapNormalMapRec = record
8717     HalfSize : Integer;
8718     Func: TglBitmapNormalMapGetVectorFunc;
8719   end;
8720
8721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8722 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8723 begin
8724   aVec[0] := aHalfSize;
8725   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8726   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8727 end;
8728
8729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8730 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8731 begin
8732   aVec[0] := - aHalfSize;
8733   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8734   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8735 end;
8736
8737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8738 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8739 begin
8740   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8741   aVec[1] := aHalfSize;
8742   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8743 end;
8744
8745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8746 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8747 begin
8748   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8749   aVec[1] := - aHalfSize;
8750   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8751 end;
8752
8753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8754 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8755 begin
8756   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8757   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8758   aVec[2] := aHalfSize;
8759 end;
8760
8761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8762 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8763 begin
8764   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8765   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8766   aVec[2] := - aHalfSize;
8767 end;
8768
8769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8770 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8771 var
8772   i: Integer;
8773   Vec: TVec;
8774   Len: Single;
8775 begin
8776   with FuncRec do begin
8777     with PglBitmapNormalMapRec(Args)^ do begin
8778       Func(Vec, Position, HalfSize);
8779
8780       // Normalize
8781       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8782       if Len <> 0 then begin
8783         Vec[0] := Vec[0] * Len;
8784         Vec[1] := Vec[1] * Len;
8785         Vec[2] := Vec[2] * Len;
8786       end;
8787
8788       // Scale Vector and AddVectro
8789       Vec[0] := Vec[0] * 0.5 + 0.5;
8790       Vec[1] := Vec[1] * 0.5 + 0.5;
8791       Vec[2] := Vec[2] * 0.5 + 0.5;
8792     end;
8793
8794     // Set Color
8795     for i := 0 to 2 do
8796       Dest.Data.arr[i] := Round(Vec[i] * 255);
8797   end;
8798 end;
8799
8800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8801 procedure TglBitmapNormalMap.AfterConstruction;
8802 begin
8803   inherited;
8804 {$IFNDEF OPENGL_ES}
8805   fGenMode := GL_NORMAL_MAP;
8806 {$ENDIF}
8807 end;
8808
8809 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8810 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8811 var
8812   Rec: TglBitmapNormalMapRec;
8813   SizeRec: TglBitmapSize;
8814   DataObj: TglBitmapData;
8815 begin
8816   Rec.HalfSize := aSize div 2;
8817
8818   SizeRec.Fields := [ffX, ffY];
8819   SizeRec.X := aSize;
8820   SizeRec.Y := aSize;
8821
8822   DataObj := TglBitmapData.Create;
8823   try
8824     // Positive X
8825     Rec.Func := glBitmapNormalMapPosX;
8826     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8827     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8828
8829     // Negative X
8830     Rec.Func := glBitmapNormalMapNegX;
8831     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8832     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8833
8834     // Positive Y
8835     Rec.Func := glBitmapNormalMapPosY;
8836     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8837     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8838
8839     // Negative Y
8840     Rec.Func := glBitmapNormalMapNegY;
8841     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8842     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8843
8844     // Positive Z
8845     Rec.Func := glBitmapNormalMapPosZ;
8846     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8847     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8848
8849     // Negative Z
8850     Rec.Func := glBitmapNormalMapNegZ;
8851     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8852     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8853   finally
8854     FreeAndNil(DataObj);
8855   end;
8856 end;
8857 {$IFEND}
8858
8859 initialization
8860   glBitmapSetDefaultFormat (tfEmpty);
8861   glBitmapSetDefaultMipmap (mmMipmap);
8862   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8863   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8864 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8865   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8866 {$IFEND}
8867
8868   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8869   glBitmapSetDefaultDeleteTextureOnFree    (true);
8870
8871   TFormatDescriptor.Init;
8872
8873 finalization
8874   TFormatDescriptor.Finalize;
8875
8876 end.