uglcBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit uglcBitmap;
  26
  27 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 interface
 183
 184 uses
 185   {$IFDEF OPENGL_ES}            dglOpenGLES,
 186   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 187
 188   {$IF DEFINED(GLB_WIN) AND
 189        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 190
 191   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 192   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 193   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 194
 195   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 196   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 197   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 198   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 199   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 200
 201   Classes, SysUtils;
 202
 203 type
 204 {$IFNDEF fpc}
 205   QWord   = System.UInt64;
 206   PQWord  = ^QWord;
 207
 208   PtrInt  = Longint;
 209   PtrUInt = DWord;
 210 {$ENDIF}
 211
 212
 213   { type that describes the format of the data stored in a texture.
 214     the name of formats is composed of the following constituents:
 215     - multiple channels:
 216        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 217        - width of the chanel in bit       (4, 8, 16, ...)
 218     - data type                           (e.g. ub, us, ui)
 219     - number of elements of data types }
 220   TglBitmapFormat = (
 221     tfEmpty = 0,
 222
 223     tfAlpha4ub1,                //< 1 x unsigned byte
 224     tfAlpha8ub1,                //< 1 x unsigned byte
 225     tfAlpha16us1,               //< 1 x unsigned short
 226
 227     tfLuminance4ub1,            //< 1 x unsigned byte
 228     tfLuminance8ub1,            //< 1 x unsigned byte
 229     tfLuminance16us1,           //< 1 x unsigned short
 230
 231     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 232     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 233     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 235     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 236
 237     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 238     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 239     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 240     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 241     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 242     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 243     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 244     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 245     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 246     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 247     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 248     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 249
 250     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 251     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 252     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 253     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 254     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 255     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 256     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 257     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 258     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 259     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 260
 261     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 262     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 263     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 264     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 265     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 266     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 267     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 268     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 269     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 270     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 271     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 272
 273     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 274     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 275     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 276     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 277     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 278     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 279     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 280     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 281     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 282     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 283
 284     tfDepth16us1,               //< 1 x unsigned short (depth)
 285     tfDepth24ui1,               //< 1 x unsigned int (depth)
 286     tfDepth32ui1,               //< 1 x unsigned int (depth)
 287
 288     tfS3tcDtx1RGBA,
 289     tfS3tcDtx3RGBA,
 290     tfS3tcDtx5RGBA
 291   );
 292
 293   { type to define suitable file formats }
 294   TglBitmapFileType = (
 295      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 296      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 297      ftDDS,                                             //< Direct Draw Surface file (DDS)
 298      ftTGA,                                             //< Targa Image File (TGA)
 299      ftBMP,                                             //< Windows Bitmap File (BMP)
 300      ftRAW);                                            //< glBitmap RAW file format
 301    TglBitmapFileTypes = set of TglBitmapFileType;
 302
 303   { possible mipmap types }
 304   TglBitmapMipMap = (
 305      mmNone,                //< no mipmaps
 306      mmMipmap,              //< normal mipmaps
 307      mmMipmapGlu);          //< mipmaps generated with glu functions
 308
 309   { possible normal map functions }
 310    TglBitmapNormalMapFunc = (
 311      nm4Samples,
 312      nmSobel,
 313      nm3x3,
 314      nm5x5);
 315
 316  ////////////////////////////////////////////////////////////////////////////////////////////////////
 317    EglBitmap                  = class(Exception);   //< glBitmap exception
 318    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 319    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 320    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 321    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 322    public
 323      constructor Create(const aFormat: TglBitmapFormat); overload;
 324      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 325    end;
 326
 327 ////////////////////////////////////////////////////////////////////////////////////////////////////
 328   { record that stores 4 unsigned integer values }
 329   TglBitmapRec4ui = packed record
 330   case Integer of
 331     0: (r, g, b, a: Cardinal);
 332     1: (arr: array[0..3] of Cardinal);
 333   end;
 334
 335   { record that stores 4 unsigned byte values }
 336   TglBitmapRec4ub = packed record
 337   case Integer of
 338     0: (r, g, b, a: Byte);
 339     1: (arr: array[0..3] of Byte);
 340   end;
 341
 342   { record that stores 4 unsigned long integer values }
 343   TglBitmapRec4ul = packed record
 344   case Integer of
 345     0: (r, g, b, a: QWord);
 346     1: (arr: array[0..3] of QWord);
 347   end;
 348
 349   { structure to store pixel data in }
 350   TglBitmapPixelData = packed record
 351     Data:   TglBitmapRec4ui;  //< color data for each color channel
 352     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 353     Format: TglBitmapFormat;  //< format of the pixel
 354   end;
 355   PglBitmapPixelData = ^TglBitmapPixelData;
 356
 357   TglBitmapSizeFields = set of (ffX, ffY);
 358   TglBitmapSize = packed record
 359     Fields: TglBitmapSizeFields;
 360     X: Word;
 361     Y: Word;
 362   end;
 363   TglBitmapPixelPosition = TglBitmapSize;
 364
 365   { describes the properties of a given texture data format }
 366   TglBitmapFormatDescriptor = class(TObject)
 367   private
 368     // cached properties
 369     fBytesPerPixel: Single;   //< number of bytes for each pixel
 370     fChannelCount: Integer;   //< number of color channels
 371     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 372     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 373
 374     { @return @true if the format has a red color channel, @false otherwise }
 375     function GetHasRed: Boolean;
 376
 377     { @return @true if the format has a green color channel, @false otherwise }
 378     function GetHasGreen: Boolean;
 379
 380     { @return @true if the format has a blue color channel, @false otherwise }
 381     function GetHasBlue: Boolean;
 382
 383     { @return @true if the format has a alpha color channel, @false otherwise }
 384     function GetHasAlpha: Boolean;
 385
 386     { @return @true if the format has any color color channel, @false otherwise }
 387     function GetHasColor: Boolean;
 388
 389     { @return @true if the format is a grayscale format, @false otherwise }
 390     function GetIsGrayscale: Boolean;
 391
 392     { @return @true if the format is supported by OpenGL, @false otherwise }
 393     function GetHasOpenGLSupport: Boolean;
 394
 395   protected
 396     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 397     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 398     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 399     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 400     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 401     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 402
 403     fBitsPerPixel: Integer;           //< number of bits per pixel
 404     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 405
 406     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 407     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 408
 409     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 410     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 411     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 412
 413     { set values for this format descriptor }
 414     procedure SetValues; virtual;
 415
 416     { calculate cached values }
 417     procedure CalcValues;
 418   public
 419     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 420     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 421     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 422     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 423     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 424
 425     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 426     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 427     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 428     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 429
 430     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 431     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 432     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 433     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 434     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 435
 436     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 437     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 438     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 439
 440     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 441     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 442     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 443     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 444     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 445     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 446
 447     property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
 448
 449     function GetSize(const aSize: TglBitmapSize): Integer;     overload; virtual;
 450     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
 451
 452     { constructor }
 453     constructor Create;
 454   public
 455     { get the format descriptor by a given OpenGL internal format
 456         @param aInternalFormat  OpenGL internal format to get format descriptor for
 457         @returns                suitable format descriptor or tfEmpty-Descriptor }
 458     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 459   end;
 460
 461 ////////////////////////////////////////////////////////////////////////////////////////////////////
 462   TglBitmapData = class;
 463
 464   { structure to store data for converting in }
 465   TglBitmapFunctionRec = record
 466     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 467     Size:     TglBitmapSize;          //< size of the texture
 468     Position: TglBitmapPixelPosition; //< position of the currently pixel
 469     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 470     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 471     Args:     Pointer;                //< user defined args that was passed to the convert function
 472   end;
 473
 474   { callback to use for converting texture data }
 475   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 476
 477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 478   { class to store texture data in. used to load, save and
 479     manipulate data before assigned to texture object
 480     all operations on a data object can be done from a background thread }
 481   TglBitmapData = class
 482   private { fields }
 483
 484     fData: PByte;               //< texture data
 485     fDimension: TglBitmapSize;  //< pixel size of the data
 486     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 487     fFilename: String;          //< file the data was load from
 488
 489     fScanlines:    array of PByte;  //< pointer to begin of each line
 490     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 491
 492   private { getter / setter }
 493
 494     { @returns the format descriptor suitable to the texture data format }
 495     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 496
 497     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 498     function GetWidth: Integer;
 499
 500     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 501     function GetHeight: Integer;
 502
 503     { get scanline at index aIndex
 504         @returns Pointer to start of line or @nil }
 505     function GetScanlines(const aIndex: Integer): PByte;
 506
 507     { set new value for the data format. only possible if new format has the same pixel size.
 508       if you want to convert the texture data, see ConvertTo function }
 509     procedure SetFormat(const aValue: TglBitmapFormat);
 510
 511   private { internal misc }
 512
 513     { splits a resource identifier into the resource and it's type
 514         @param aResource  resource identifier to split and store name in
 515         @param aResType   type of the resource }
 516     procedure PrepareResType(var aResource: String; var aResType: PChar);
 517
 518     { updates scanlines array }
 519     procedure UpdateScanlines;
 520
 521   private { internal load and save }
 522 {$IFDEF GLB_SUPPORT_PNG_READ}
 523     { try to load a PNG from a stream
 524         @param aStream  stream to load PNG from
 525         @returns        @true on success, @false otherwise }
 526     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 527 {$ENDIF}
 528
 529 {$ifdef GLB_SUPPORT_PNG_WRITE}
 530     { save texture data as PNG to stream
 531         @param aStream stream to save data to}
 532     procedure SavePNG(const aStream: TStream); virtual;
 533 {$ENDIF}
 534
 535 {$IFDEF GLB_SUPPORT_JPEG_READ}
 536     { try to load a JPEG from a stream
 537         @param aStream  stream to load JPEG from
 538         @returns        @true on success, @false otherwise }
 539     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 540 {$ENDIF}
 541
 542 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 543     { save texture data as JPEG to stream
 544         @param aStream stream to save data to}
 545     procedure SaveJPEG(const aStream: TStream); virtual;
 546 {$ENDIF}
 547
 548     { try to load a RAW image from a stream
 549         @param aStream  stream to load RAW image from
 550         @returns        @true on success, @false otherwise }
 551     function LoadRAW(const aStream: TStream): Boolean;
 552
 553     { save texture data as RAW image to stream
 554         @param aStream stream to save data to}
 555     procedure SaveRAW(const aStream: TStream);
 556
 557     { try to load a BMP from a stream
 558         @param aStream  stream to load BMP from
 559         @returns        @true on success, @false otherwise }
 560     function LoadBMP(const aStream: TStream): Boolean;
 561
 562     { save texture data as BMP to stream
 563         @param aStream stream to save data to}
 564     procedure SaveBMP(const aStream: TStream);
 565
 566     { try to load a TGA from a stream
 567         @param aStream  stream to load TGA from
 568         @returns        @true on success, @false otherwise }
 569     function LoadTGA(const aStream: TStream): Boolean;
 570
 571     { save texture data as TGA to stream
 572         @param aStream stream to save data to}
 573     procedure SaveTGA(const aStream: TStream);
 574
 575     { try to load a DDS from a stream
 576         @param aStream  stream to load DDS from
 577         @returns        @true on success, @false otherwise }
 578     function LoadDDS(const aStream: TStream): Boolean;
 579
 580     { save texture data as DDS to stream
 581         @param aStream stream to save data to}
 582     procedure SaveDDS(const aStream: TStream);
 583
 584   public { properties }
 585     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 586     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 587     property Filename:  String          read fFilename;                 //< file the data was loaded from
 588     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 589     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 590     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 591     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 592
 593     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 594
 595   public { flip }
 596
 597     { flip texture horizontal
 598         @returns @true in success, @false otherwise }
 599     function FlipHorz: Boolean; virtual;
 600
 601     { flip texture vertical
 602         @returns @true in success, @false otherwise }
 603     function FlipVert: Boolean; virtual;
 604
 605   public { load }
 606
 607     { load a texture from a file
 608         @param aFilename file to load texuture from }
 609     procedure LoadFromFile(const aFilename: String);
 610
 611     { load a texture from a stream
 612         @param aStream  stream to load texture from }
 613     procedure LoadFromStream(const aStream: TStream); virtual;
 614
 615     { use a function to generate texture data
 616         @param aSize    size of the texture
 617         @param aFormat  format of the texture data
 618         @param aFunc    callback to use for generation
 619         @param aArgs    user defined paramaters (use at will) }
 620     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 621
 622     { load a texture from a resource
 623         @param aInstance  resource handle
 624         @param aResource  resource indentifier
 625         @param aResType   resource type (if known) }
 626     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 627
 628     { load a texture from a resource id
 629         @param aInstance  resource handle
 630         @param aResource  resource ID
 631         @param aResType   resource type }
 632     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 633
 634   public { save }
 635
 636     { save texture data to a file
 637         @param aFilename  filename to store texture in
 638         @param aFileType  file type to store data into }
 639     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 640
 641     { save texture data to a stream
 642         @param aFilename  filename to store texture in
 643         @param aFileType  file type to store data into }
 644     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 645
 646   public { convert }
 647
 648     { convert texture data using a user defined callback
 649         @param aFunc        callback to use for converting
 650         @param aCreateTemp  create a temporary buffer to use for converting
 651         @param aArgs        user defined paramters (use at will)
 652         @returns            @true if converting was successful, @false otherwise }
 653     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 654
 655     { convert texture data using a user defined callback
 656         @param aSource      glBitmap to read data from
 657         @param aFunc        callback to use for converting
 658         @param aCreateTemp  create a temporary buffer to use for converting
 659         @param aFormat      format of the new data
 660         @param aArgs        user defined paramters (use at will)
 661         @returns            @true if converting was successful, @false otherwise }
 662     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 663       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 664
 665     { convert texture data using a specific format
 666         @param aFormat  new format of texture data
 667         @returns        @true if converting was successful, @false otherwise }
 668     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 669
 670 {$IFDEF GLB_SDL}
 671   public { SDL }
 672
 673     { assign texture data to SDL surface
 674         @param aSurface SDL surface to write data to
 675         @returns        @true on success, @false otherwise }
 676     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 677
 678     { assign texture data from SDL surface
 679         @param aSurface SDL surface to read data from
 680         @returns        @true on success, @false otherwise }
 681     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 682
 683     { assign alpha channel data to SDL surface
 684         @param aSurface SDL surface to write alpha channel data to
 685         @returns        @true on success, @false otherwise }
 686     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 687
 688     { assign alpha channel data from SDL surface
 689         @param aSurface SDL surface to read data from
 690         @param aFunc    callback to use for converting
 691         @param aArgs    user defined parameters (use at will)
 692         @returns        @true on success, @false otherwise }
 693     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 694 {$ENDIF}
 695
 696 {$IFDEF GLB_DELPHI}
 697   public { Delphi }
 698
 699     { assign texture data to TBitmap object
 700         @param aBitmap  TBitmap to write data to
 701         @returns        @true on success, @false otherwise }
 702     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 703
 704     { assign texture data from TBitmap object
 705         @param aBitmap  TBitmap to read data from
 706         @returns        @true on success, @false otherwise }
 707     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 708
 709     { assign alpha channel data to TBitmap object
 710         @param aBitmap  TBitmap to write data to
 711         @returns        @true on success, @false otherwise }
 712     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 713
 714     { assign alpha channel data from TBitmap object
 715         @param aBitmap  TBitmap to read data from
 716         @param aFunc    callback to use for converting
 717         @param aArgs    user defined parameters (use at will)
 718         @returns        @true on success, @false otherwise }
 719     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 720 {$ENDIF}
 721
 722 {$IFDEF GLB_LAZARUS}
 723   public { Lazarus }
 724
 725     { assign texture data to TLazIntfImage object
 726         @param aImage   TLazIntfImage to write data to
 727         @returns        @true on success, @false otherwise }
 728     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 729
 730     { assign texture data from TLazIntfImage object
 731         @param aImage   TLazIntfImage to read data from
 732         @returns        @true on success, @false otherwise }
 733     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 734
 735     { assign alpha channel data to TLazIntfImage object
 736         @param aImage   TLazIntfImage to write data to
 737         @returns        @true on success, @false otherwise }
 738     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 739
 740     { assign alpha channel data from TLazIntfImage object
 741         @param aImage   TLazIntfImage to read data from
 742         @param aFunc    callback to use for converting
 743         @param aArgs    user defined parameters (use at will)
 744         @returns        @true on success, @false otherwise }
 745     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 746 {$ENDIF}
 747
 748   public { Alpha }
 749     { load alpha channel data from resource
 750         @param aInstance  resource handle
 751         @param aResource  resource ID
 752         @param aResType   resource type
 753         @param aFunc      callback to use for converting
 754         @param aArgs      user defined parameters (use at will)
 755         @returns          @true on success, @false otherwise }
 756     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 757
 758     { load alpha channel data from resource ID
 759         @param aInstance    resource handle
 760         @param aResourceID  resource ID
 761         @param aResType     resource type
 762         @param aFunc        callback to use for converting
 763         @param aArgs        user defined parameters (use at will)
 764         @returns            @true on success, @false otherwise }
 765     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 766
 767     { add alpha channel data from function
 768         @param aFunc  callback to get data from
 769         @param aArgs  user defined parameters (use at will)
 770         @returns      @true on success, @false otherwise }
 771     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 772
 773     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 774         @param aFilename  file to load alpha channel data from
 775         @param aFunc      callback to use for converting
 776         @param aArgs     SetFormat user defined parameters (use at will)
 777         @returns          @true on success, @false otherwise }
 778     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 779
 780     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 781         @param aStream  stream to load alpha channel data from
 782         @param aFunc    callback to use for converting
 783         @param aArgs    user defined parameters (use at will)
 784         @returns        @true on success, @false otherwise }
 785     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 786
 787     { add alpha channel data from existing glBitmap object
 788         @param aBitmap  TglBitmap to copy alpha channel data from
 789         @param aFunc    callback to use for converting
 790         @param aArgs    user defined parameters (use at will)
 791         @returns        @true on success, @false otherwise }
 792     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 793
 794     { add alpha to pixel if the pixels color is greter than the given color value
 795         @param aRed         red threshold (0-255)
 796         @param aGreen       green threshold (0-255)
 797         @param aBlue        blue threshold (0-255)
 798         @param aDeviatation accepted deviatation (0-255)
 799         @returns            @true on success, @false otherwise }
 800     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 801
 802     { add alpha to pixel if the pixels color is greter than the given color value
 803         @param aRed         red threshold (0-Range.r)
 804         @param aGreen       green threshold (0-Range.g)
 805         @param aBlue        blue threshold (0-Range.b)
 806         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 807         @returns            @true on success, @false otherwise }
 808     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 809
 810     { add alpha to pixel if the pixels color is greter than the given color value
 811         @param aRed         red threshold (0.0-1.0)
 812         @param aGreen       green threshold (0.0-1.0)
 813         @param aBlue        blue threshold (0.0-1.0)
 814         @param aDeviatation accepted deviatation (0.0-1.0)
 815         @returns            @true on success, @false otherwise }
 816     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 817
 818     { add a constand alpha value to all pixels
 819         @param aAlpha alpha value to add (0-255)
 820         @returns      @true on success, @false otherwise }
 821     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 822
 823     { add a constand alpha value to all pixels
 824         @param aAlpha alpha value to add (0-max(Range.rgb))
 825         @returns      @true on success, @false otherwise }
 826     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 827
 828     { add a constand alpha value to all pixels
 829         @param aAlpha alpha value to add (0.0-1.0)
 830         @returns      @true on success, @false otherwise }
 831     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 832
 833     { remove alpha channel
 834         @returns  @true on success, @false otherwise }
 835     function RemoveAlpha: Boolean; virtual;
 836
 837   public { fill }
 838     { fill complete texture with one color
 839         @param aRed   red color for border (0-255)
 840         @param aGreen green color for border (0-255)
 841         @param aBlue  blue color for border (0-255)
 842         @param aAlpha alpha color for border (0-255) }
 843     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 844
 845     { fill complete texture with one color
 846         @param aRed   red color for border (0-Range.r)
 847         @param aGreen green color for border (0-Range.g)
 848         @param aBlue  blue color for border (0-Range.b)
 849         @param aAlpha alpha color for border (0-Range.a) }
 850     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 851
 852     { fill complete texture with one color
 853         @param aRed   red color for border (0.0-1.0)
 854         @param aGreen green color for border (0.0-1.0)
 855         @param aBlue  blue color for border (0.0-1.0)
 856         @param aAlpha alpha color for border (0.0-1.0) }
 857     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 858
 859   public { Misc }
 860
 861     { set data pointer of texture data
 862         @param aData    pointer to new texture data
 863         @param aFormat  format of the data stored at aData
 864         @param aWidth   width of the texture data
 865         @param aHeight  height of the texture data }
 866     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 867       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 868
 869       { create a clone of the current object
 870         @returns clone of this object}
 871     function Clone: TglBitmapData;
 872
 873     { invert color data (bitwise not)
 874         @param aRed     invert red channel
 875         @param aGreen   invert green channel
 876         @param aBlue    invert blue channel
 877         @param aAlpha   invert alpha channel }
 878     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 879
 880     { create normal map from texture data
 881         @param aFunc      normal map function to generate normalmap with
 882         @param aScale     scale of the normale stored in the normal map
 883         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 884     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 885       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 886
 887   public { constructor }
 888
 889     { constructor - creates a texutre data object }
 890     constructor Create; overload;
 891
 892     { constructor - creates a texture data object and loads it from a file
 893         @param aFilename file to load texture from }
 894     constructor Create(const aFileName: String); overload;
 895
 896     { constructor - creates a texture data object and loads it from a stream
 897         @param aStream stream to load texture from }
 898     constructor Create(const aStream: TStream); overload;
 899
 900     { constructor - creates a texture data object with the given size, format and data
 901         @param aSize    size of the texture
 902         @param aFormat  format of the given data
 903         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 904     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 905
 906     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 907         @param aSize    size of the texture
 908         @param aFormat  format of the given data
 909         @param aFunc    callback to use for generating the data
 910         @param aArgs    user defined parameters (use at will) }
 911     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 912
 913     { constructor - creates a texture data object and loads it from a resource
 914         @param aInstance  resource handle
 915         @param aResource  resource indentifier
 916         @param aResType   resource type (if known) }
 917     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 918
 919     { constructor - creates a texture data object and loads it from a resource
 920         @param aInstance    resource handle
 921         @param aResourceID  resource ID
 922         @param aResType     resource type (if known) }
 923     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 924
 925     { destructor }
 926     destructor Destroy; override;
 927
 928   end;
 929
 930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 931   { base class for all glBitmap classes. used to manage OpenGL texture objects
 932     all operations on a bitmap object must be done from the render thread }
 933   TglBitmap = class
 934   protected
 935     fID: GLuint;                          //< name of the OpenGL texture object
 936     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 937     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 938
 939     // texture properties
 940     fFilterMin: GLenum;                   //< min filter to apply to the texture
 941     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 942     fWrapS: GLenum;                       //< texture wrapping for x axis
 943     fWrapT: GLenum;                       //< texture wrapping for y axis
 944     fWrapR: GLenum;                       //< texture wrapping for z axis
 945     fAnisotropic: Integer;                //< anisotropic level
 946     fBorderColor: array[0..3] of Single;  //< color of the texture border
 947
 948 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 949     //Swizzle
 950     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 951 {$IFEND}
 952 {$IFNDEF OPENGL_ES}
 953     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 954 {$ENDIF}
 955
 956     fDimension: TglBitmapSize;            //< size of this texture
 957     fMipMap: TglBitmapMipMap;             //< mipmap type
 958
 959     // CustomData
 960     fCustomData: Pointer;                 //< user defined data
 961     fCustomName: String;                  //< user defined name
 962     fCustomNameW: WideString;             //< user defined name
 963   protected
 964     { @returns the actual width of the texture }
 965     function GetWidth:  Integer; virtual;
 966
 967     { @returns the actual height of the texture }
 968     function GetHeight: Integer; virtual;
 969
 970   protected
 971     { set a new value for fCustomData }
 972     procedure SetCustomData(const aValue: Pointer);
 973
 974     { set a new value for fCustomName }
 975     procedure SetCustomName(const aValue: String);
 976
 977     { set a new value for fCustomNameW }
 978     procedure SetCustomNameW(const aValue: WideString);
 979
 980     { set new value for fDeleteTextureOnFree }
 981     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 982
 983     { set name of OpenGL texture object }
 984     procedure SetID(const aValue: Cardinal);
 985
 986     { set new value for fMipMap }
 987     procedure SetMipMap(const aValue: TglBitmapMipMap);
 988
 989     { set new value for target }
 990     procedure SetTarget(const aValue: Cardinal);
 991
 992     { set new value for fAnisotrophic }
 993     procedure SetAnisotropic(const aValue: Integer);
 994
 995   protected
 996     { create OpenGL texture object (delete exisiting object if exists) }
 997     procedure CreateID;
 998
 999     { setup texture parameters }
1000     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1001
1002   protected
1003     property Width:  Integer read GetWidth;   //< the actual width of the texture
1004     property Height: Integer read GetHeight;  //< the actual height of the texture
1005
1006   public
1007     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1008     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1009     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1010
1011     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1012     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1013
1014     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1015     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1016     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1017
1018     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1019 {$IFNDEF OPENGL_ES}
1020     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1021 {$ENDIF}
1022
1023     { this method is called after the constructor and sets the default values of this object }
1024     procedure AfterConstruction; override;
1025
1026     { this method is called before the destructor and does some cleanup }
1027     procedure BeforeDestruction; override;
1028
1029   public
1030 {$IFNDEF OPENGL_ES}
1031     { set the new value for texture border color
1032         @param aRed   red color for border (0.0-1.0)
1033         @param aGreen green color for border (0.0-1.0)
1034         @param aBlue  blue color for border (0.0-1.0)
1035         @param aAlpha alpha color for border (0.0-1.0) }
1036     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1037 {$ENDIF}
1038
1039   public
1040     { set new texture filer
1041         @param aMin   min filter
1042         @param aMag   mag filter }
1043     procedure SetFilter(const aMin, aMag: GLenum);
1044
1045     { set new texture wrapping
1046         @param S  texture wrapping for x axis
1047         @param T  texture wrapping for y axis
1048         @param R  texture wrapping for z axis }
1049     procedure SetWrap(
1050       const S: GLenum = GL_CLAMP_TO_EDGE;
1051       const T: GLenum = GL_CLAMP_TO_EDGE;
1052       const R: GLenum = GL_CLAMP_TO_EDGE);
1053
1054 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1055     { set new swizzle
1056         @param r  swizzle for red channel
1057         @param g  swizzle for green channel
1058         @param b  swizzle for blue channel
1059         @param a  swizzle for alpha channel }
1060     procedure SetSwizzle(const r, g, b, a: GLenum);
1061 {$IFEND}
1062
1063   public
1064     { bind texture
1065         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1066     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean = true{$ENDIF}); virtual;
1067
1068     { bind texture
1069         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1070     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean = true{$ENDIF}); virtual;
1071
1072     { upload texture data from given data object to video card
1073         @param aData        texture data object that contains the actual data
1074         @param aCheckSize   check size before upload and throw exception if something is wrong }
1075     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1076
1077 {$IFNDEF OPENGL_ES}
1078     { download texture data from video card and store it into given data object
1079         @returns @true when download was successfull, @false otherwise }
1080     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1081 {$ENDIF}
1082   public
1083     { constructor - creates an empty texture }
1084     constructor Create; overload;
1085
1086     { constructor - creates an texture object and uploads the given data }
1087     constructor Create(const aData: TglBitmapData); overload;
1088
1089   end;
1090
1091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1092 {$IF NOT DEFINED(OPENGL_ES)}
1093   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1094     all operations on a bitmap object must be done from the render thread }
1095   TglBitmap1D = class(TglBitmap)
1096   protected
1097
1098     { upload the texture data to video card
1099         @param aDataObj       texture data object that contains the actual data
1100         @param aBuildWithGlu  use glu functions to build mipmaps }
1101     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1102
1103   public
1104     property Width; //< actual with of the texture
1105
1106     { this method is called after constructor and initializes the object }
1107     procedure AfterConstruction; override;
1108
1109     { upload texture data from given data object to video card
1110         @param aData        texture data object that contains the actual data
1111         @param aCheckSize   check size before upload and throw exception if something is wrong }
1112     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1113
1114   end;
1115 {$IFEND}
1116
1117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1118   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1119     all operations on a bitmap object must be done from the render thread }
1120   TglBitmap2D = class(TglBitmap)
1121   protected
1122
1123     { upload the texture data to video card
1124         @param aDataObj       texture data object that contains the actual data
1125         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1126         @param aBuildWithGlu  use glu functions to build mipmaps }
1127     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1128       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1129
1130   public
1131     property Width;   //< actual width of the texture
1132     property Height;  //< actual height of the texture
1133
1134     { this method is called after constructor and initializes the object }
1135     procedure AfterConstruction; override;
1136
1137     { upload texture data from given data object to video card
1138         @param aData        texture data object that contains the actual data
1139         @param aCheckSize   check size before upload and throw exception if something is wrong }
1140     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1141
1142   public
1143
1144     { copy a part of the frame buffer to the texture
1145         @param aTop     topmost pixel to copy
1146         @param aLeft    leftmost pixel to copy
1147         @param aRight   rightmost pixel to copy
1148         @param aBottom  bottommost pixel to copy
1149         @param aFormat  format to store data in
1150         @param aDataObj texture data object to store the data in }
1151     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1152
1153   end;
1154
1155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1156 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1157   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1158     all operations on a bitmap object must be done from the render thread }
1159   TglBitmapCubeMap = class(TglBitmap2D)
1160   protected
1161   {$IFNDEF OPENGL_ES}
1162     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1163   {$ENDIF}
1164
1165   public
1166     { this method is called after constructor and initializes the object }
1167     procedure AfterConstruction; override;
1168
1169     { upload texture data from given data object to video card
1170         @param aData        texture data object that contains the actual data
1171         @param aCheckSize   check size before upload and throw exception if something is wrong }
1172     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1173
1174     { upload texture data from given data object to video card
1175         @param aData        texture data object that contains the actual data
1176         @param aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1177         @param aCheckSize   check size before upload and throw exception if something is wrong }
1178     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1179
1180     { bind texture
1181         @param aEnableTexCoordsGen  enable cube map generator
1182         @param aEnableTextureUnit   enable texture unit }
1183     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
1184
1185     { unbind texture
1186         @param aDisableTexCoordsGen   disable cube map generator
1187         @param aDisableTextureUnit    disable texture unit }
1188     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
1189   end;
1190 {$IFEND}
1191
1192 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1194   { wrapper class for cube normal maps
1195     all operations on a bitmap object must be done from the render thread }
1196   TglBitmapNormalMap = class(TglBitmapCubeMap)
1197   public
1198     { this method is called after constructor and initializes the object }
1199     procedure AfterConstruction; override;
1200
1201     { create cube normal map from texture data and upload it to video card
1202         @param aSize        size of each cube map texture
1203         @param aCheckSize   check size before upload and throw exception if something is wrong }
1204     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1205   end;
1206 {$IFEND}
1207
1208   TglcBitmapFormat    = TglBitmapFormat;
1209   TglcBitmap2D        = TglBitmap2D;
1210   TglcBitmapData      = TglBitmapData;
1211 {$IF NOT DEFINED(OPENGL_ES)}
1212   TglcBitmap1D        = TglBitmap1D;
1213   TglcBitmapCubeMap   = TglBitmapCubeMap;
1214   TglcBitmapNormalMap = TglBitmapNormalMap;
1215 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
1216   TglcBitmapCubeMap   = TglBitmapCubeMap;
1217   TglcBitmapNormalMap = TglBitmapNormalMap;
1218 {$IFEND}
1219
1220 const
1221   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1222
1223 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1224 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1225 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1226 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1227 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1228 procedure glBitmapSetDefaultWrap(
1229   const S: Cardinal = GL_CLAMP_TO_EDGE;
1230   const T: Cardinal = GL_CLAMP_TO_EDGE;
1231   const R: Cardinal = GL_CLAMP_TO_EDGE);
1232
1233 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1234 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1235 {$IFEND}
1236
1237 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1238 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1239 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1240 function glBitmapGetDefaultFormat: TglBitmapFormat;
1241 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1242 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1243 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1244 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1245 {$IFEND}
1246
1247 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1248 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1249 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1250 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1251 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1252 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1253 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1254
1255 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1256
1257 {$IFDEF GLB_DELPHI}
1258 function CreateGrayPalette: HPALETTE;
1259 {$ENDIF}
1260
1261 implementation
1262
1263 uses
1264   Math, syncobjs, typinfo
1265   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1266
1267
1268 var
1269   glBitmapDefaultDeleteTextureOnFree: Boolean;
1270   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1271   glBitmapDefaultFormat: TglBitmapFormat;
1272   glBitmapDefaultMipmap: TglBitmapMipMap;
1273   glBitmapDefaultFilterMin: Cardinal;
1274   glBitmapDefaultFilterMag: Cardinal;
1275   glBitmapDefaultWrapS: Cardinal;
1276   glBitmapDefaultWrapT: Cardinal;
1277   glBitmapDefaultWrapR: Cardinal;
1278   glDefaultSwizzle: array[0..3] of GLenum;
1279
1280 ////////////////////////////////////////////////////////////////////////////////////////////////////
1281 type
1282   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1283   public
1284     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1285     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1286
1287     function CreateMappingData: Pointer; virtual;
1288     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1289
1290     function IsEmpty: Boolean; virtual;
1291     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1292
1293     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1294
1295     constructor Create; virtual;
1296   public
1297     class procedure Init;
1298     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1299     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1300     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1301     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1302     class procedure Clear;
1303     class procedure Finalize;
1304   end;
1305   TFormatDescriptorClass = class of TFormatDescriptor;
1306
1307   TfdEmpty = class(TFormatDescriptor);
1308
1309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1310   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1311     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1312     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1313   end;
1314
1315   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1316     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318   end;
1319
1320   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1321     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1322     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1323   end;
1324
1325   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1326     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1327     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1328   end;
1329
1330   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333   end;
1334
1335   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
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   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
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   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1351   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354   end;
1355
1356   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1357     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1358     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1359   end;
1360
1361   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1362     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1363     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1364   end;
1365
1366   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369   end;
1370
1371   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374   end;
1375
1376   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379   end;
1380
1381   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1382     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1383     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1384   end;
1385
1386   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1387     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1388     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1389   end;
1390
1391   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
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   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
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   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1402     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1403     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1404   end;
1405
1406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1407   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1408     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1409     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1410   end;
1411
1412   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1413     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1414     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1415   end;
1416
1417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1418   TfdAlpha4ub1 = class(TfdAlphaUB1)
1419     procedure SetValues; override;
1420   end;
1421
1422   TfdAlpha8ub1 = class(TfdAlphaUB1)
1423     procedure SetValues; override;
1424   end;
1425
1426   TfdAlpha16us1 = class(TfdAlphaUS1)
1427     procedure SetValues; override;
1428   end;
1429
1430   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1431     procedure SetValues; override;
1432   end;
1433
1434   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1435     procedure SetValues; override;
1436   end;
1437
1438   TfdLuminance16us1 = class(TfdLuminanceUS1)
1439     procedure SetValues; override;
1440   end;
1441
1442   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1443     procedure SetValues; override;
1444   end;
1445
1446   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1447     procedure SetValues; override;
1448   end;
1449
1450   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1451     procedure SetValues; override;
1452   end;
1453
1454   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1455     procedure SetValues; override;
1456   end;
1457
1458   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1459     procedure SetValues; override;
1460   end;
1461
1462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1463   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1464     procedure SetValues; override;
1465   end;
1466
1467   TfdRGBX4us1 = class(TfdUniversalUS1)
1468     procedure SetValues; override;
1469   end;
1470
1471   TfdXRGB4us1 = class(TfdUniversalUS1)
1472     procedure SetValues; override;
1473   end;
1474
1475   TfdR5G6B5us1 = class(TfdUniversalUS1)
1476     procedure SetValues; override;
1477   end;
1478
1479   TfdRGB5X1us1 = class(TfdUniversalUS1)
1480     procedure SetValues; override;
1481   end;
1482
1483   TfdX1RGB5us1 = class(TfdUniversalUS1)
1484     procedure SetValues; override;
1485   end;
1486
1487   TfdRGB8ub3 = class(TfdRGBub3)
1488     procedure SetValues; override;
1489   end;
1490
1491   TfdRGBX8ui1 = class(TfdUniversalUI1)
1492     procedure SetValues; override;
1493   end;
1494
1495   TfdXRGB8ui1 = class(TfdUniversalUI1)
1496     procedure SetValues; override;
1497   end;
1498
1499   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1500     procedure SetValues; override;
1501   end;
1502
1503   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1504     procedure SetValues; override;
1505   end;
1506
1507   TfdRGB16us3 = class(TfdRGBus3)
1508     procedure SetValues; override;
1509   end;
1510
1511   TfdRGBA4us1 = class(TfdUniversalUS1)
1512     procedure SetValues; override;
1513   end;
1514
1515   TfdARGB4us1 = class(TfdUniversalUS1)
1516     procedure SetValues; override;
1517   end;
1518
1519   TfdRGB5A1us1 = class(TfdUniversalUS1)
1520     procedure SetValues; override;
1521   end;
1522
1523   TfdA1RGB5us1 = class(TfdUniversalUS1)
1524     procedure SetValues; override;
1525   end;
1526
1527   TfdRGBA8ui1 = class(TfdUniversalUI1)
1528     procedure SetValues; override;
1529   end;
1530
1531   TfdARGB8ui1 = class(TfdUniversalUI1)
1532     procedure SetValues; override;
1533   end;
1534
1535   TfdRGBA8ub4 = class(TfdRGBAub4)
1536     procedure SetValues; override;
1537   end;
1538
1539   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1540     procedure SetValues; override;
1541   end;
1542
1543   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1544     procedure SetValues; override;
1545   end;
1546
1547   TfdRGBA16us4 = class(TfdRGBAus4)
1548     procedure SetValues; override;
1549   end;
1550
1551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1552   TfdBGRX4us1 = class(TfdUniversalUS1)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdXBGR4us1 = class(TfdUniversalUS1)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdB5G6R5us1 = class(TfdUniversalUS1)
1561     procedure SetValues; override;
1562   end;
1563
1564   TfdBGR5X1us1 = class(TfdUniversalUS1)
1565     procedure SetValues; override;
1566   end;
1567
1568   TfdX1BGR5us1 = class(TfdUniversalUS1)
1569     procedure SetValues; override;
1570   end;
1571
1572   TfdBGR8ub3 = class(TfdBGRub3)
1573     procedure SetValues; override;
1574   end;
1575
1576   TfdBGRX8ui1 = class(TfdUniversalUI1)
1577     procedure SetValues; override;
1578   end;
1579
1580   TfdXBGR8ui1 = class(TfdUniversalUI1)
1581     procedure SetValues; override;
1582   end;
1583
1584   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1585     procedure SetValues; override;
1586   end;
1587
1588   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1589     procedure SetValues; override;
1590   end;
1591
1592   TfdBGR16us3 = class(TfdBGRus3)
1593     procedure SetValues; override;
1594   end;
1595
1596   TfdBGRA4us1 = class(TfdUniversalUS1)
1597     procedure SetValues; override;
1598   end;
1599
1600   TfdABGR4us1 = class(TfdUniversalUS1)
1601     procedure SetValues; override;
1602   end;
1603
1604   TfdBGR5A1us1 = class(TfdUniversalUS1)
1605     procedure SetValues; override;
1606   end;
1607
1608   TfdA1BGR5us1 = class(TfdUniversalUS1)
1609     procedure SetValues; override;
1610   end;
1611
1612   TfdBGRA8ui1 = class(TfdUniversalUI1)
1613     procedure SetValues; override;
1614   end;
1615
1616   TfdABGR8ui1 = class(TfdUniversalUI1)
1617     procedure SetValues; override;
1618   end;
1619
1620   TfdBGRA8ub4 = class(TfdBGRAub4)
1621     procedure SetValues; override;
1622   end;
1623
1624   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1625     procedure SetValues; override;
1626   end;
1627
1628   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1629     procedure SetValues; override;
1630   end;
1631
1632   TfdBGRA16us4 = class(TfdBGRAus4)
1633     procedure SetValues; override;
1634   end;
1635
1636   TfdDepth16us1 = class(TfdDepthUS1)
1637     procedure SetValues; override;
1638   end;
1639
1640   TfdDepth24ui1 = class(TfdDepthUI1)
1641     procedure SetValues; override;
1642   end;
1643
1644   TfdDepth32ui1 = class(TfdDepthUI1)
1645     procedure SetValues; override;
1646   end;
1647
1648   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1649     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1650     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1651     procedure SetValues; override;
1652   end;
1653
1654   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
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     procedure SetValues; override;
1658   end;
1659
1660   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1661     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1662     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1663     procedure SetValues; override;
1664   end;
1665
1666 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1667   TbmpBitfieldFormat = class(TFormatDescriptor)
1668   public
1669     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1670     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1671     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1672     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1673   end;
1674
1675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1676   TbmpColorTableEnty = packed record
1677     b, g, r, a: Byte;
1678   end;
1679   TbmpColorTable = array of TbmpColorTableEnty;
1680   TbmpColorTableFormat = class(TFormatDescriptor)
1681   private
1682     fColorTable: TbmpColorTable;
1683   protected
1684     procedure SetValues; override;
1685   public
1686     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1687
1688     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1689     procedure CalcValues;
1690     procedure CreateColorTable;
1691
1692     function CreateMappingData: Pointer; override;
1693     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1694     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1695     destructor Destroy; override;
1696   end;
1697
1698 const
1699   LUMINANCE_WEIGHT_R = 0.30;
1700   LUMINANCE_WEIGHT_G = 0.59;
1701   LUMINANCE_WEIGHT_B = 0.11;
1702
1703   ALPHA_WEIGHT_R = 0.30;
1704   ALPHA_WEIGHT_G = 0.59;
1705   ALPHA_WEIGHT_B = 0.11;
1706
1707   DEPTH_WEIGHT_R = 0.333333333;
1708   DEPTH_WEIGHT_G = 0.333333333;
1709   DEPTH_WEIGHT_B = 0.333333333;
1710
1711   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1712     TfdEmpty,
1713
1714     TfdAlpha4ub1,
1715     TfdAlpha8ub1,
1716     TfdAlpha16us1,
1717
1718     TfdLuminance4ub1,
1719     TfdLuminance8ub1,
1720     TfdLuminance16us1,
1721
1722     TfdLuminance4Alpha4ub2,
1723     TfdLuminance6Alpha2ub2,
1724     TfdLuminance8Alpha8ub2,
1725     TfdLuminance12Alpha4us2,
1726     TfdLuminance16Alpha16us2,
1727
1728     TfdR3G3B2ub1,
1729     TfdRGBX4us1,
1730     TfdXRGB4us1,
1731     TfdR5G6B5us1,
1732     TfdRGB5X1us1,
1733     TfdX1RGB5us1,
1734     TfdRGB8ub3,
1735     TfdRGBX8ui1,
1736     TfdXRGB8ui1,
1737     TfdRGB10X2ui1,
1738     TfdX2RGB10ui1,
1739     TfdRGB16us3,
1740
1741     TfdRGBA4us1,
1742     TfdARGB4us1,
1743     TfdRGB5A1us1,
1744     TfdA1RGB5us1,
1745     TfdRGBA8ui1,
1746     TfdARGB8ui1,
1747     TfdRGBA8ub4,
1748     TfdRGB10A2ui1,
1749     TfdA2RGB10ui1,
1750     TfdRGBA16us4,
1751
1752     TfdBGRX4us1,
1753     TfdXBGR4us1,
1754     TfdB5G6R5us1,
1755     TfdBGR5X1us1,
1756     TfdX1BGR5us1,
1757     TfdBGR8ub3,
1758     TfdBGRX8ui1,
1759     TfdXBGR8ui1,
1760     TfdBGR10X2ui1,
1761     TfdX2BGR10ui1,
1762     TfdBGR16us3,
1763
1764     TfdBGRA4us1,
1765     TfdABGR4us1,
1766     TfdBGR5A1us1,
1767     TfdA1BGR5us1,
1768     TfdBGRA8ui1,
1769     TfdABGR8ui1,
1770     TfdBGRA8ub4,
1771     TfdBGR10A2ui1,
1772     TfdA2BGR10ui1,
1773     TfdBGRA16us4,
1774
1775     TfdDepth16us1,
1776     TfdDepth24ui1,
1777     TfdDepth32ui1,
1778
1779     TfdS3tcDtx1RGBA,
1780     TfdS3tcDtx3RGBA,
1781     TfdS3tcDtx5RGBA
1782   );
1783
1784 var
1785   FormatDescriptorCS: TCriticalSection;
1786   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1787
1788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1789 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1790 begin
1791   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1792 end;
1793
1794 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1795 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1796 begin
1797   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1798 end;
1799
1800 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1801 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1802 begin
1803   result.Fields := [];
1804   if (X >= 0) then
1805     result.Fields := result.Fields + [ffX];
1806   if (Y >= 0) then
1807     result.Fields := result.Fields + [ffY];
1808   result.X := Max(0, X);
1809   result.Y := Max(0, Y);
1810 end;
1811
1812 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1813 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1814 begin
1815   result := glBitmapSize(X, Y);
1816 end;
1817
1818 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1819 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1820 begin
1821   result.r := r;
1822   result.g := g;
1823   result.b := b;
1824   result.a := a;
1825 end;
1826
1827 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1828 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1829 begin
1830   result.r := r;
1831   result.g := g;
1832   result.b := b;
1833   result.a := a;
1834 end;
1835
1836 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1837 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1838 begin
1839   result.r := r;
1840   result.g := g;
1841   result.b := b;
1842   result.a := a;
1843 end;
1844
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1847 var
1848   i: Integer;
1849 begin
1850   result := false;
1851   for i := 0 to high(r1.arr) do
1852     if (r1.arr[i] <> r2.arr[i]) then
1853       exit;
1854   result := true;
1855 end;
1856
1857 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1858 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1859 var
1860   i: Integer;
1861 begin
1862   result := false;
1863   for i := 0 to high(r1.arr) do
1864     if (r1.arr[i] <> r2.arr[i]) then
1865       exit;
1866   result := true;
1867 end;
1868
1869 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1870 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1871 var
1872   desc: TFormatDescriptor;
1873   p, tmp: PByte;
1874   x, y, i: Integer;
1875   md: Pointer;
1876   px: TglBitmapPixelData;
1877 begin
1878   result := nil;
1879   desc := TFormatDescriptor.Get(aFormat);
1880   if (desc.IsCompressed) or (desc.glFormat = 0) then
1881     exit;
1882
1883   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1884   md := desc.CreateMappingData;
1885   try
1886     tmp := p;
1887     desc.PreparePixel(px);
1888     for y := 0 to 4 do
1889       for x := 0 to 4 do begin
1890         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1891         for i := 0 to 3 do begin
1892           if ((y < 3) and (y = i)) or
1893              ((y = 3) and (i < 3)) or
1894              ((y = 4) and (i = 3))
1895           then
1896             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1897           else if ((y < 4) and (i = 3)) or
1898                   ((y = 4) and (i < 3))
1899           then
1900             px.Data.arr[i] := px.Range.arr[i]
1901           else
1902             px.Data.arr[i] := 0; //px.Range.arr[i];
1903         end;
1904         desc.Map(px, tmp, md);
1905       end;
1906   finally
1907     desc.FreeMappingData(md);
1908   end;
1909
1910   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1911 end;
1912
1913 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1914 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1915 begin
1916   result.r := r;
1917   result.g := g;
1918   result.b := b;
1919   result.a := a;
1920 end;
1921
1922 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1923 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1924 begin
1925   result := [];
1926
1927   if (aFormat in [
1928         //8bpp
1929         tfAlpha4ub1, tfAlpha8ub1,
1930         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1931
1932         //16bpp
1933         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1934         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1935         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1936
1937         //24bpp
1938         tfBGR8ub3, tfRGB8ub3,
1939
1940         //32bpp
1941         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1942         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1943   then
1944     result := result + [ ftBMP ];
1945
1946   if (aFormat in [
1947         //8bbp
1948         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1949
1950         //16bbp
1951         tfAlpha16us1, tfLuminance16us1,
1952         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1953         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1954
1955         //24bbp
1956         tfBGR8ub3,
1957
1958         //32bbp
1959         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1960         tfDepth24ui1, tfDepth32ui1])
1961   then
1962     result := result + [ftTGA];
1963
1964   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1965     result := result + [ftDDS];
1966
1967 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1968   if aFormat in [
1969       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1970       tfRGB8ub3, tfRGBA8ui1,
1971       tfBGR8ub3, tfBGRA8ui1] then
1972     result := result + [ftPNG];
1973 {$ENDIF}
1974
1975 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1976   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1977     result := result + [ftJPEG];
1978 {$ENDIF}
1979 end;
1980
1981 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1982 function IsPowerOfTwo(aNumber: Integer): Boolean;
1983 begin
1984   while (aNumber and 1) = 0 do
1985     aNumber := aNumber shr 1;
1986   result := aNumber = 1;
1987 end;
1988
1989 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1990 function GetTopMostBit(aBitSet: QWord): Integer;
1991 begin
1992   result := 0;
1993   while aBitSet > 0 do begin
1994     inc(result);
1995     aBitSet := aBitSet shr 1;
1996   end;
1997 end;
1998
1999 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2000 function CountSetBits(aBitSet: QWord): Integer;
2001 begin
2002   result := 0;
2003   while aBitSet > 0 do begin
2004     if (aBitSet and 1) = 1 then
2005       inc(result);
2006     aBitSet := aBitSet shr 1;
2007   end;
2008 end;
2009
2010 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2011 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2012 begin
2013   result := Trunc(
2014     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2015     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2016     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2017 end;
2018
2019 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2020 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2021 begin
2022   result := Trunc(
2023     DEPTH_WEIGHT_R * aPixel.Data.r +
2024     DEPTH_WEIGHT_G * aPixel.Data.g +
2025     DEPTH_WEIGHT_B * aPixel.Data.b);
2026 end;
2027
2028 {$IFDEF GLB_SDL_IMAGE}
2029 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2030 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2031 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2032 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2033 begin
2034   result := TStream(context^.unknown.data1).Seek(offset, whence);
2035 end;
2036
2037 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2038 begin
2039   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2040 end;
2041
2042 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2043 begin
2044   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2045 end;
2046
2047 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2048 begin
2049   result := 0;
2050 end;
2051
2052 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2053 begin
2054   result := SDL_AllocRW;
2055
2056   if result = nil then
2057     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2058
2059   result^.seek := glBitmapRWseek;
2060   result^.read := glBitmapRWread;
2061   result^.write := glBitmapRWwrite;
2062   result^.close := glBitmapRWclose;
2063   result^.unknown.data1 := Stream;
2064 end;
2065 {$ENDIF}
2066
2067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2069 begin
2070   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2071 end;
2072
2073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2074 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2075 begin
2076   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2077 end;
2078
2079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2080 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2081 begin
2082   glBitmapDefaultMipmap := aValue;
2083 end;
2084
2085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2086 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2087 begin
2088   glBitmapDefaultFormat := aFormat;
2089 end;
2090
2091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2092 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2093 begin
2094   glBitmapDefaultFilterMin := aMin;
2095   glBitmapDefaultFilterMag := aMag;
2096 end;
2097
2098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2099 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2100 begin
2101   glBitmapDefaultWrapS := S;
2102   glBitmapDefaultWrapT := T;
2103   glBitmapDefaultWrapR := R;
2104 end;
2105
2106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2107 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2108 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2109 begin
2110   glDefaultSwizzle[0] := r;
2111   glDefaultSwizzle[1] := g;
2112   glDefaultSwizzle[2] := b;
2113   glDefaultSwizzle[3] := a;
2114 end;
2115 {$IFEND}
2116
2117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2118 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2119 begin
2120   result := glBitmapDefaultDeleteTextureOnFree;
2121 end;
2122
2123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2124 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2125 begin
2126   result := glBitmapDefaultFreeDataAfterGenTextures;
2127 end;
2128
2129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2131 begin
2132   result := glBitmapDefaultMipmap;
2133 end;
2134
2135 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2136 function glBitmapGetDefaultFormat: TglBitmapFormat;
2137 begin
2138   result := glBitmapDefaultFormat;
2139 end;
2140
2141 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2142 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2143 begin
2144   aMin := glBitmapDefaultFilterMin;
2145   aMag := glBitmapDefaultFilterMag;
2146 end;
2147
2148 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2149 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2150 begin
2151   S := glBitmapDefaultWrapS;
2152   T := glBitmapDefaultWrapT;
2153   R := glBitmapDefaultWrapR;
2154 end;
2155
2156 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2158 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2159 begin
2160   r := glDefaultSwizzle[0];
2161   g := glDefaultSwizzle[1];
2162   b := glDefaultSwizzle[2];
2163   a := glDefaultSwizzle[3];
2164 end;
2165 {$IFEND}
2166
2167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2168 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 function TFormatDescriptor.CreateMappingData: Pointer;
2171 begin
2172   result := nil;
2173 end;
2174
2175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2176 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2177 begin
2178   //DUMMY
2179 end;
2180
2181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2182 function TFormatDescriptor.IsEmpty: Boolean;
2183 begin
2184   result := (fFormat = tfEmpty);
2185 end;
2186
2187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2189 var
2190   i: Integer;
2191   m: TglBitmapRec4ul;
2192 begin
2193   result := false;
2194   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2195     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2196   m := Mask;
2197   for i := 0 to 3 do
2198     if (aMask.arr[i] <> m.arr[i]) then
2199       exit;
2200   result := true;
2201 end;
2202
2203 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2204 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2205 begin
2206   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2207   aPixel.Data   := Range;
2208   aPixel.Format := fFormat;
2209   aPixel.Range  := Range;
2210 end;
2211
2212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2213 constructor TFormatDescriptor.Create;
2214 begin
2215   inherited Create;
2216 end;
2217
2218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2219 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2221 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2222 begin
2223   aData^ := aPixel.Data.a;
2224   inc(aData);
2225 end;
2226
2227 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2228 begin
2229   aPixel.Data.r := 0;
2230   aPixel.Data.g := 0;
2231   aPixel.Data.b := 0;
2232   aPixel.Data.a := aData^;
2233   inc(aData);
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2240 begin
2241   aData^ := LuminanceWeight(aPixel);
2242   inc(aData);
2243 end;
2244
2245 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2246 begin
2247   aPixel.Data.r := aData^;
2248   aPixel.Data.g := aData^;
2249   aPixel.Data.b := aData^;
2250   aPixel.Data.a := 0;
2251   inc(aData);
2252 end;
2253
2254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2255 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2257 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2258 var
2259   i: Integer;
2260 begin
2261   aData^ := 0;
2262   for i := 0 to 3 do
2263     if (Range.arr[i] > 0) then
2264       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2265   inc(aData);
2266 end;
2267
2268 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2269 var
2270   i: Integer;
2271 begin
2272   for i := 0 to 3 do
2273     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2274   inc(aData);
2275 end;
2276
2277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2278 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2280 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2281 begin
2282   inherited Map(aPixel, aData, aMapData);
2283   aData^ := aPixel.Data.a;
2284   inc(aData);
2285 end;
2286
2287 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2288 begin
2289   inherited Unmap(aData, aPixel, aMapData);
2290   aPixel.Data.a := aData^;
2291   inc(aData);
2292 end;
2293
2294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2295 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2298 begin
2299   aData^ := aPixel.Data.r;
2300   inc(aData);
2301   aData^ := aPixel.Data.g;
2302   inc(aData);
2303   aData^ := aPixel.Data.b;
2304   inc(aData);
2305 end;
2306
2307 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2308 begin
2309   aPixel.Data.r := aData^;
2310   inc(aData);
2311   aPixel.Data.g := aData^;
2312   inc(aData);
2313   aPixel.Data.b := aData^;
2314   inc(aData);
2315   aPixel.Data.a := 0;
2316 end;
2317
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2322 begin
2323   aData^ := aPixel.Data.b;
2324   inc(aData);
2325   aData^ := aPixel.Data.g;
2326   inc(aData);
2327   aData^ := aPixel.Data.r;
2328   inc(aData);
2329 end;
2330
2331 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2332 begin
2333   aPixel.Data.b := aData^;
2334   inc(aData);
2335   aPixel.Data.g := aData^;
2336   inc(aData);
2337   aPixel.Data.r := aData^;
2338   inc(aData);
2339   aPixel.Data.a := 0;
2340 end;
2341
2342 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2343 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2346 begin
2347   inherited Map(aPixel, aData, aMapData);
2348   aData^ := aPixel.Data.a;
2349   inc(aData);
2350 end;
2351
2352 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2353 begin
2354   inherited Unmap(aData, aPixel, aMapData);
2355   aPixel.Data.a := aData^;
2356   inc(aData);
2357 end;
2358
2359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2360 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2362 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2363 begin
2364   inherited Map(aPixel, aData, aMapData);
2365   aData^ := aPixel.Data.a;
2366   inc(aData);
2367 end;
2368
2369 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2370 begin
2371   inherited Unmap(aData, aPixel, aMapData);
2372   aPixel.Data.a := aData^;
2373   inc(aData);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2379 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2380 begin
2381   PWord(aData)^ := aPixel.Data.a;
2382   inc(aData, 2);
2383 end;
2384
2385 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2386 begin
2387   aPixel.Data.r := 0;
2388   aPixel.Data.g := 0;
2389   aPixel.Data.b := 0;
2390   aPixel.Data.a := PWord(aData)^;
2391   inc(aData, 2);
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2397 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2398 begin
2399   PWord(aData)^ := LuminanceWeight(aPixel);
2400   inc(aData, 2);
2401 end;
2402
2403 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2404 begin
2405   aPixel.Data.r := PWord(aData)^;
2406   aPixel.Data.g := PWord(aData)^;
2407   aPixel.Data.b := PWord(aData)^;
2408   aPixel.Data.a := 0;
2409   inc(aData, 2);
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2415 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2416 var
2417   i: Integer;
2418 begin
2419   PWord(aData)^ := 0;
2420   for i := 0 to 3 do
2421     if (Range.arr[i] > 0) then
2422       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2423   inc(aData, 2);
2424 end;
2425
2426 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2427 var
2428   i: Integer;
2429 begin
2430   for i := 0 to 3 do
2431     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2432   inc(aData, 2);
2433 end;
2434
2435 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2436 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2438 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2439 begin
2440   PWord(aData)^ := DepthWeight(aPixel);
2441   inc(aData, 2);
2442 end;
2443
2444 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2445 begin
2446   aPixel.Data.r := PWord(aData)^;
2447   aPixel.Data.g := PWord(aData)^;
2448   aPixel.Data.b := PWord(aData)^;
2449   aPixel.Data.a := PWord(aData)^;;
2450   inc(aData, 2);
2451 end;
2452
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2457 begin
2458   inherited Map(aPixel, aData, aMapData);
2459   PWord(aData)^ := aPixel.Data.a;
2460   inc(aData, 2);
2461 end;
2462
2463 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2464 begin
2465   inherited Unmap(aData, aPixel, aMapData);
2466   aPixel.Data.a := PWord(aData)^;
2467   inc(aData, 2);
2468 end;
2469
2470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2471 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2474 begin
2475   PWord(aData)^ := aPixel.Data.r;
2476   inc(aData, 2);
2477   PWord(aData)^ := aPixel.Data.g;
2478   inc(aData, 2);
2479   PWord(aData)^ := aPixel.Data.b;
2480   inc(aData, 2);
2481 end;
2482
2483 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2484 begin
2485   aPixel.Data.r := PWord(aData)^;
2486   inc(aData, 2);
2487   aPixel.Data.g := PWord(aData)^;
2488   inc(aData, 2);
2489   aPixel.Data.b := PWord(aData)^;
2490   inc(aData, 2);
2491   aPixel.Data.a := 0;
2492 end;
2493
2494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2495 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2497 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2498 begin
2499   PWord(aData)^ := aPixel.Data.b;
2500   inc(aData, 2);
2501   PWord(aData)^ := aPixel.Data.g;
2502   inc(aData, 2);
2503   PWord(aData)^ := aPixel.Data.r;
2504   inc(aData, 2);
2505 end;
2506
2507 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2508 begin
2509   aPixel.Data.b := PWord(aData)^;
2510   inc(aData, 2);
2511   aPixel.Data.g := PWord(aData)^;
2512   inc(aData, 2);
2513   aPixel.Data.r := PWord(aData)^;
2514   inc(aData, 2);
2515   aPixel.Data.a := 0;
2516 end;
2517
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2522 begin
2523   inherited Map(aPixel, aData, aMapData);
2524   PWord(aData)^ := aPixel.Data.a;
2525   inc(aData, 2);
2526 end;
2527
2528 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2529 begin
2530   inherited Unmap(aData, aPixel, aMapData);
2531   aPixel.Data.a := PWord(aData)^;
2532   inc(aData, 2);
2533 end;
2534
2535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2536 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2538 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2539 begin
2540   PWord(aData)^ := aPixel.Data.a;
2541   inc(aData, 2);
2542   inherited Map(aPixel, aData, aMapData);
2543 end;
2544
2545 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2546 begin
2547   aPixel.Data.a := PWord(aData)^;
2548   inc(aData, 2);
2549   inherited Unmap(aData, aPixel, aMapData);
2550 end;
2551
2552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2553 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2556 begin
2557   inherited Map(aPixel, aData, aMapData);
2558   PWord(aData)^ := aPixel.Data.a;
2559   inc(aData, 2);
2560 end;
2561
2562 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2563 begin
2564   inherited Unmap(aData, aPixel, aMapData);
2565   aPixel.Data.a := PWord(aData)^;
2566   inc(aData, 2);
2567 end;
2568
2569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2570 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2572 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2573 begin
2574   PWord(aData)^ := aPixel.Data.a;
2575   inc(aData, 2);
2576   inherited Map(aPixel, aData, aMapData);
2577 end;
2578
2579 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2580 begin
2581   aPixel.Data.a := PWord(aData)^;
2582   inc(aData, 2);
2583   inherited Unmap(aData, aPixel, aMapData);
2584 end;
2585
2586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2587 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2589 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2590 var
2591   i: Integer;
2592 begin
2593   PCardinal(aData)^ := 0;
2594   for i := 0 to 3 do
2595     if (Range.arr[i] > 0) then
2596       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2597   inc(aData, 4);
2598 end;
2599
2600 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2601 var
2602   i: Integer;
2603 begin
2604   for i := 0 to 3 do
2605     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2606   inc(aData, 2);
2607 end;
2608
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2613 begin
2614   PCardinal(aData)^ := DepthWeight(aPixel);
2615   inc(aData, 4);
2616 end;
2617
2618 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2619 begin
2620   aPixel.Data.r := PCardinal(aData)^;
2621   aPixel.Data.g := PCardinal(aData)^;
2622   aPixel.Data.b := PCardinal(aData)^;
2623   aPixel.Data.a := PCardinal(aData)^;
2624   inc(aData, 4);
2625 end;
2626
2627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2630 procedure TfdAlpha4ub1.SetValues;
2631 begin
2632   inherited SetValues;
2633   fBitsPerPixel     := 8;
2634   fFormat           := tfAlpha4ub1;
2635   fWithAlpha        := tfAlpha4ub1;
2636   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2637   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2638 {$IFNDEF OPENGL_ES}
2639   fOpenGLFormat     := tfAlpha4ub1;
2640   fglFormat         := GL_ALPHA;
2641   fglInternalFormat := GL_ALPHA4;
2642   fglDataFormat     := GL_UNSIGNED_BYTE;
2643 {$ELSE}
2644   fOpenGLFormat     := tfAlpha8ub1;
2645 {$ENDIF}
2646 end;
2647
2648 procedure TfdAlpha8ub1.SetValues;
2649 begin
2650   inherited SetValues;
2651   fBitsPerPixel     := 8;
2652   fFormat           := tfAlpha8ub1;
2653   fWithAlpha        := tfAlpha8ub1;
2654   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2655   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2656   fOpenGLFormat     := tfAlpha8ub1;
2657   fglFormat         := GL_ALPHA;
2658   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2659   fglDataFormat     := GL_UNSIGNED_BYTE;
2660 end;
2661
2662 procedure TfdAlpha16us1.SetValues;
2663 begin
2664   inherited SetValues;
2665   fBitsPerPixel     := 16;
2666   fFormat           := tfAlpha16us1;
2667   fWithAlpha        := tfAlpha16us1;
2668   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2669   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2670 {$IFNDEF OPENGL_ES}
2671   fOpenGLFormat     := tfAlpha16us1;
2672   fglFormat         := GL_ALPHA;
2673   fglInternalFormat := GL_ALPHA16;
2674   fglDataFormat     := GL_UNSIGNED_SHORT;
2675 {$ELSE}
2676   fOpenGLFormat     := tfAlpha8ub1;
2677 {$ENDIF}
2678 end;
2679
2680 procedure TfdLuminance4ub1.SetValues;
2681 begin
2682   inherited SetValues;
2683   fBitsPerPixel     := 8;
2684   fFormat           := tfLuminance4ub1;
2685   fWithAlpha        := tfLuminance4Alpha4ub2;
2686   fWithoutAlpha     := tfLuminance4ub1;
2687   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2688   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2689 {$IFNDEF OPENGL_ES}
2690   fOpenGLFormat     := tfLuminance4ub1;
2691   fglFormat         := GL_LUMINANCE;
2692   fglInternalFormat := GL_LUMINANCE4;
2693   fglDataFormat     := GL_UNSIGNED_BYTE;
2694 {$ELSE}
2695   fOpenGLFormat     := tfLuminance8ub1;
2696 {$ENDIF}
2697 end;
2698
2699 procedure TfdLuminance8ub1.SetValues;
2700 begin
2701   inherited SetValues;
2702   fBitsPerPixel     := 8;
2703   fFormat           := tfLuminance8ub1;
2704   fWithAlpha        := tfLuminance8Alpha8ub2;
2705   fWithoutAlpha     := tfLuminance8ub1;
2706   fOpenGLFormat     := tfLuminance8ub1;
2707   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2708   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2709   fglFormat         := GL_LUMINANCE;
2710   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2711   fglDataFormat     := GL_UNSIGNED_BYTE;
2712 end;
2713
2714 procedure TfdLuminance16us1.SetValues;
2715 begin
2716   inherited SetValues;
2717   fBitsPerPixel     := 16;
2718   fFormat           := tfLuminance16us1;
2719   fWithAlpha        := tfLuminance16Alpha16us2;
2720   fWithoutAlpha     := tfLuminance16us1;
2721   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2722   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2723 {$IFNDEF OPENGL_ES}
2724   fOpenGLFormat     := tfLuminance16us1;
2725   fglFormat         := GL_LUMINANCE;
2726   fglInternalFormat := GL_LUMINANCE16;
2727   fglDataFormat     := GL_UNSIGNED_SHORT;
2728 {$ELSE}
2729   fOpenGLFormat     := tfLuminance8ub1;
2730 {$ENDIF}
2731 end;
2732
2733 procedure TfdLuminance4Alpha4ub2.SetValues;
2734 begin
2735   inherited SetValues;
2736   fBitsPerPixel     := 16;
2737   fFormat           := tfLuminance4Alpha4ub2;
2738   fWithAlpha        := tfLuminance4Alpha4ub2;
2739   fWithoutAlpha     := tfLuminance4ub1;
2740   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2741   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2742 {$IFNDEF OPENGL_ES}
2743   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2744   fglFormat         := GL_LUMINANCE_ALPHA;
2745   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2746   fglDataFormat     := GL_UNSIGNED_BYTE;
2747 {$ELSE}
2748   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2749 {$ENDIF}
2750 end;
2751
2752 procedure TfdLuminance6Alpha2ub2.SetValues;
2753 begin
2754   inherited SetValues;
2755   fBitsPerPixel     := 16;
2756   fFormat           := tfLuminance6Alpha2ub2;
2757   fWithAlpha        := tfLuminance6Alpha2ub2;
2758   fWithoutAlpha     := tfLuminance8ub1;
2759   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2760   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2761 {$IFNDEF OPENGL_ES}
2762   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2763   fglFormat         := GL_LUMINANCE_ALPHA;
2764   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2765   fglDataFormat     := GL_UNSIGNED_BYTE;
2766 {$ELSE}
2767   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2768 {$ENDIF}
2769 end;
2770
2771 procedure TfdLuminance8Alpha8ub2.SetValues;
2772 begin
2773   inherited SetValues;
2774   fBitsPerPixel     := 16;
2775   fFormat           := tfLuminance8Alpha8ub2;
2776   fWithAlpha        := tfLuminance8Alpha8ub2;
2777   fWithoutAlpha     := tfLuminance8ub1;
2778   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2779   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2780   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2781   fglFormat         := GL_LUMINANCE_ALPHA;
2782   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2783   fglDataFormat     := GL_UNSIGNED_BYTE;
2784 end;
2785
2786 procedure TfdLuminance12Alpha4us2.SetValues;
2787 begin
2788   inherited SetValues;
2789   fBitsPerPixel     := 32;
2790   fFormat           := tfLuminance12Alpha4us2;
2791   fWithAlpha        := tfLuminance12Alpha4us2;
2792   fWithoutAlpha     := tfLuminance16us1;
2793   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2794   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2795 {$IFNDEF OPENGL_ES}
2796   fOpenGLFormat     := tfLuminance12Alpha4us2;
2797   fglFormat         := GL_LUMINANCE_ALPHA;
2798   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2799   fglDataFormat     := GL_UNSIGNED_SHORT;
2800 {$ELSE}
2801   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2802 {$ENDIF}
2803 end;
2804
2805 procedure TfdLuminance16Alpha16us2.SetValues;
2806 begin
2807   inherited SetValues;
2808   fBitsPerPixel     := 32;
2809   fFormat           := tfLuminance16Alpha16us2;
2810   fWithAlpha        := tfLuminance16Alpha16us2;
2811   fWithoutAlpha     := tfLuminance16us1;
2812   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2813   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2814 {$IFNDEF OPENGL_ES}
2815   fOpenGLFormat     := tfLuminance16Alpha16us2;
2816   fglFormat         := GL_LUMINANCE_ALPHA;
2817   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2818   fglDataFormat     := GL_UNSIGNED_SHORT;
2819 {$ELSE}
2820   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2821 {$ENDIF}
2822 end;
2823
2824 procedure TfdR3G3B2ub1.SetValues;
2825 begin
2826   inherited SetValues;
2827   fBitsPerPixel     := 8;
2828   fFormat           := tfR3G3B2ub1;
2829   fWithAlpha        := tfRGBA4us1;
2830   fWithoutAlpha     := tfR3G3B2ub1;
2831   fRGBInverted      := tfEmpty;
2832   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2833   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2834 {$IFNDEF OPENGL_ES}
2835   fOpenGLFormat     := tfR3G3B2ub1;
2836   fglFormat         := GL_RGB;
2837   fglInternalFormat := GL_R3_G3_B2;
2838   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2839 {$ELSE}
2840   fOpenGLFormat     := tfR5G6B5us1;
2841 {$ENDIF}
2842 end;
2843
2844 procedure TfdRGBX4us1.SetValues;
2845 begin
2846   inherited SetValues;
2847   fBitsPerPixel     := 16;
2848   fFormat           := tfRGBX4us1;
2849   fWithAlpha        := tfRGBA4us1;
2850   fWithoutAlpha     := tfRGBX4us1;
2851   fRGBInverted      := tfBGRX4us1;
2852   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2853   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2854 {$IFNDEF OPENGL_ES}
2855   fOpenGLFormat     := tfRGBX4us1;
2856   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2857   fglInternalFormat := GL_RGB4;
2858   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2859 {$ELSE}
2860   fOpenGLFormat     := tfR5G6B5us1;
2861 {$ENDIF}
2862 end;
2863
2864 procedure TfdXRGB4us1.SetValues;
2865 begin
2866   inherited SetValues;
2867   fBitsPerPixel     := 16;
2868   fFormat           := tfXRGB4us1;
2869   fWithAlpha        := tfARGB4us1;
2870   fWithoutAlpha     := tfXRGB4us1;
2871   fRGBInverted      := tfXBGR4us1;
2872   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2873   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2874 {$IFNDEF OPENGL_ES}
2875   fOpenGLFormat     := tfXRGB4us1;
2876   fglFormat         := GL_BGRA;
2877   fglInternalFormat := GL_RGB4;
2878   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2879 {$ELSE}
2880   fOpenGLFormat     := tfR5G6B5us1;
2881 {$ENDIF}
2882 end;
2883
2884 procedure TfdR5G6B5us1.SetValues;
2885 begin
2886   inherited SetValues;
2887   fBitsPerPixel     := 16;
2888   fFormat           := tfR5G6B5us1;
2889   fWithAlpha        := tfRGB5A1us1;
2890   fWithoutAlpha     := tfR5G6B5us1;
2891   fRGBInverted      := tfB5G6R5us1;
2892   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2893   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2894 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2895   fOpenGLFormat     := tfR5G6B5us1;
2896   fglFormat         := GL_RGB;
2897   fglInternalFormat := GL_RGB565;
2898   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2899 {$ELSE}
2900   fOpenGLFormat     := tfRGB8ub3;
2901 {$IFEND}
2902 end;
2903
2904 procedure TfdRGB5X1us1.SetValues;
2905 begin
2906   inherited SetValues;
2907   fBitsPerPixel     := 16;
2908   fFormat           := tfRGB5X1us1;
2909   fWithAlpha        := tfRGB5A1us1;
2910   fWithoutAlpha     := tfRGB5X1us1;
2911   fRGBInverted      := tfBGR5X1us1;
2912   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2913   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2914 {$IFNDEF OPENGL_ES}
2915   fOpenGLFormat     := tfRGB5X1us1;
2916   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2917   fglInternalFormat := GL_RGB5;
2918   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2919 {$ELSE}
2920   fOpenGLFormat     := tfR5G6B5us1;
2921 {$ENDIF}
2922 end;
2923
2924 procedure TfdX1RGB5us1.SetValues;
2925 begin
2926   inherited SetValues;
2927   fBitsPerPixel     := 16;
2928   fFormat           := tfX1RGB5us1;
2929   fWithAlpha        := tfA1RGB5us1;
2930   fWithoutAlpha     := tfX1RGB5us1;
2931   fRGBInverted      := tfX1BGR5us1;
2932   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2933   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2934 {$IFNDEF OPENGL_ES}
2935   fOpenGLFormat     := tfX1RGB5us1;
2936   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2937   fglInternalFormat := GL_RGB5;
2938   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2939 {$ELSE}
2940   fOpenGLFormat     := tfR5G6B5us1;
2941 {$ENDIF}
2942 end;
2943
2944 procedure TfdRGB8ub3.SetValues;
2945 begin
2946   inherited SetValues;
2947   fBitsPerPixel     := 24;
2948   fFormat           := tfRGB8ub3;
2949   fWithAlpha        := tfRGBA8ub4;
2950   fWithoutAlpha     := tfRGB8ub3;
2951   fRGBInverted      := tfBGR8ub3;
2952   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2953   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2954   fOpenGLFormat     := tfRGB8ub3;
2955   fglFormat         := GL_RGB;
2956   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2957   fglDataFormat     := GL_UNSIGNED_BYTE;
2958 end;
2959
2960 procedure TfdRGBX8ui1.SetValues;
2961 begin
2962   inherited SetValues;
2963   fBitsPerPixel     := 32;
2964   fFormat           := tfRGBX8ui1;
2965   fWithAlpha        := tfRGBA8ui1;
2966   fWithoutAlpha     := tfRGBX8ui1;
2967   fRGBInverted      := tfBGRX8ui1;
2968   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2969   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2970 {$IFNDEF OPENGL_ES}
2971   fOpenGLFormat     := tfRGBX8ui1;
2972   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2973   fglInternalFormat := GL_RGB8;
2974   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2975 {$ELSE}
2976   fOpenGLFormat     := tfRGB8ub3;
2977 {$ENDIF}
2978 end;
2979
2980 procedure TfdXRGB8ui1.SetValues;
2981 begin
2982   inherited SetValues;
2983   fBitsPerPixel     := 32;
2984   fFormat           := tfXRGB8ui1;
2985   fWithAlpha        := tfXRGB8ui1;
2986   fWithoutAlpha     := tfXRGB8ui1;
2987   fOpenGLFormat     := tfXRGB8ui1;
2988   fRGBInverted      := tfXBGR8ui1;
2989   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2990   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2991 {$IFNDEF OPENGL_ES}
2992   fOpenGLFormat     := tfXRGB8ui1;
2993   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2994   fglInternalFormat := GL_RGB8;
2995   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2996 {$ELSE}
2997   fOpenGLFormat     := tfRGB8ub3;
2998 {$ENDIF}
2999 end;
3000
3001 procedure TfdRGB10X2ui1.SetValues;
3002 begin
3003   inherited SetValues;
3004   fBitsPerPixel     := 32;
3005   fFormat           := tfRGB10X2ui1;
3006   fWithAlpha        := tfRGB10A2ui1;
3007   fWithoutAlpha     := tfRGB10X2ui1;
3008   fRGBInverted      := tfBGR10X2ui1;
3009   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3010   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3011 {$IFNDEF OPENGL_ES}
3012   fOpenGLFormat     := tfRGB10X2ui1;
3013   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3014   fglInternalFormat := GL_RGB10;
3015   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3016 {$ELSE}
3017   fOpenGLFormat     := tfRGB16us3;
3018 {$ENDIF}
3019 end;
3020
3021 procedure TfdX2RGB10ui1.SetValues;
3022 begin
3023   inherited SetValues;
3024   fBitsPerPixel     := 32;
3025   fFormat           := tfX2RGB10ui1;
3026   fWithAlpha        := tfA2RGB10ui1;
3027   fWithoutAlpha     := tfX2RGB10ui1;
3028   fRGBInverted      := tfX2BGR10ui1;
3029   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3030   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3031 {$IFNDEF OPENGL_ES}
3032   fOpenGLFormat     := tfX2RGB10ui1;
3033   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3034   fglInternalFormat := GL_RGB10;
3035   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3036 {$ELSE}
3037   fOpenGLFormat     := tfRGB16us3;
3038 {$ENDIF}
3039 end;
3040
3041 procedure TfdRGB16us3.SetValues;
3042 begin
3043   inherited SetValues;
3044   fBitsPerPixel     := 48;
3045   fFormat           := tfRGB16us3;
3046   fWithAlpha        := tfRGBA16us4;
3047   fWithoutAlpha     := tfRGB16us3;
3048   fRGBInverted      := tfBGR16us3;
3049   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3050   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3051 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3052   fOpenGLFormat     := tfRGB16us3;
3053   fglFormat         := GL_RGB;
3054   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3055   fglDataFormat     := GL_UNSIGNED_SHORT;
3056 {$ELSE}
3057   fOpenGLFormat     := tfRGB8ub3;
3058 {$IFEND}
3059 end;
3060
3061 procedure TfdRGBA4us1.SetValues;
3062 begin
3063   inherited SetValues;
3064   fBitsPerPixel     := 16;
3065   fFormat           := tfRGBA4us1;
3066   fWithAlpha        := tfRGBA4us1;
3067   fWithoutAlpha     := tfRGBX4us1;
3068   fOpenGLFormat     := tfRGBA4us1;
3069   fRGBInverted      := tfBGRA4us1;
3070   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3071   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3072   fglFormat         := GL_RGBA;
3073   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3074   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3075 end;
3076
3077 procedure TfdARGB4us1.SetValues;
3078 begin
3079   inherited SetValues;
3080   fBitsPerPixel     := 16;
3081   fFormat           := tfARGB4us1;
3082   fWithAlpha        := tfARGB4us1;
3083   fWithoutAlpha     := tfXRGB4us1;
3084   fRGBInverted      := tfABGR4us1;
3085   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3086   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3087 {$IFNDEF OPENGL_ES}
3088   fOpenGLFormat     := tfARGB4us1;
3089   fglFormat         := GL_BGRA;
3090   fglInternalFormat := GL_RGBA4;
3091   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3092 {$ELSE}
3093   fOpenGLFormat     := tfRGBA4us1;
3094 {$ENDIF}
3095 end;
3096
3097 procedure TfdRGB5A1us1.SetValues;
3098 begin
3099   inherited SetValues;
3100   fBitsPerPixel     := 16;
3101   fFormat           := tfRGB5A1us1;
3102   fWithAlpha        := tfRGB5A1us1;
3103   fWithoutAlpha     := tfRGB5X1us1;
3104   fOpenGLFormat     := tfRGB5A1us1;
3105   fRGBInverted      := tfBGR5A1us1;
3106   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3107   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3108   fglFormat         := GL_RGBA;
3109   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3110   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3111 end;
3112
3113 procedure TfdA1RGB5us1.SetValues;
3114 begin
3115   inherited SetValues;
3116   fBitsPerPixel     := 16;
3117   fFormat           := tfA1RGB5us1;
3118   fWithAlpha        := tfA1RGB5us1;
3119   fWithoutAlpha     := tfX1RGB5us1;
3120   fRGBInverted      := tfA1BGR5us1;
3121   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3122   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3123 {$IFNDEF OPENGL_ES}
3124   fOpenGLFormat     := tfA1RGB5us1;
3125   fglFormat         := GL_BGRA;
3126   fglInternalFormat := GL_RGB5_A1;
3127   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3128 {$ELSE}
3129   fOpenGLFormat     := tfRGB5A1us1;
3130 {$ENDIF}
3131 end;
3132
3133 procedure TfdRGBA8ui1.SetValues;
3134 begin
3135   inherited SetValues;
3136   fBitsPerPixel     := 32;
3137   fFormat           := tfRGBA8ui1;
3138   fWithAlpha        := tfRGBA8ui1;
3139   fWithoutAlpha     := tfRGBX8ui1;
3140   fRGBInverted      := tfBGRA8ui1;
3141   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3142   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3143 {$IFNDEF OPENGL_ES}
3144   fOpenGLFormat     := tfRGBA8ui1;
3145   fglFormat         := GL_RGBA;
3146   fglInternalFormat := GL_RGBA8;
3147   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3148 {$ELSE}
3149   fOpenGLFormat     := tfRGBA8ub4;
3150 {$ENDIF}
3151 end;
3152
3153 procedure TfdARGB8ui1.SetValues;
3154 begin
3155   inherited SetValues;
3156   fBitsPerPixel     := 32;
3157   fFormat           := tfARGB8ui1;
3158   fWithAlpha        := tfARGB8ui1;
3159   fWithoutAlpha     := tfXRGB8ui1;
3160   fRGBInverted      := tfABGR8ui1;
3161   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3162   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3163 {$IFNDEF OPENGL_ES}
3164   fOpenGLFormat     := tfARGB8ui1;
3165   fglFormat         := GL_BGRA;
3166   fglInternalFormat := GL_RGBA8;
3167   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3168 {$ELSE}
3169   fOpenGLFormat     := tfRGBA8ub4;
3170 {$ENDIF}
3171 end;
3172
3173 procedure TfdRGBA8ub4.SetValues;
3174 begin
3175   inherited SetValues;
3176   fBitsPerPixel     := 32;
3177   fFormat           := tfRGBA8ub4;
3178   fWithAlpha        := tfRGBA8ub4;
3179   fWithoutAlpha     := tfRGB8ub3;
3180   fOpenGLFormat     := tfRGBA8ub4;
3181   fRGBInverted      := tfBGRA8ub4;
3182   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3183   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3184   fglFormat         := GL_RGBA;
3185   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3186   fglDataFormat     := GL_UNSIGNED_BYTE;
3187 end;
3188
3189 procedure TfdRGB10A2ui1.SetValues;
3190 begin
3191   inherited SetValues;
3192   fBitsPerPixel     := 32;
3193   fFormat           := tfRGB10A2ui1;
3194   fWithAlpha        := tfRGB10A2ui1;
3195   fWithoutAlpha     := tfRGB10X2ui1;
3196   fRGBInverted      := tfBGR10A2ui1;
3197   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3198   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3199 {$IFNDEF OPENGL_ES}
3200   fOpenGLFormat     := tfRGB10A2ui1;
3201   fglFormat         := GL_RGBA;
3202   fglInternalFormat := GL_RGB10_A2;
3203   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3204 {$ELSE}
3205   fOpenGLFormat     := tfA2RGB10ui1;
3206 {$ENDIF}
3207 end;
3208
3209 procedure TfdA2RGB10ui1.SetValues;
3210 begin
3211   inherited SetValues;
3212   fBitsPerPixel     := 32;
3213   fFormat           := tfA2RGB10ui1;
3214   fWithAlpha        := tfA2RGB10ui1;
3215   fWithoutAlpha     := tfX2RGB10ui1;
3216   fRGBInverted      := tfA2BGR10ui1;
3217   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3218   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3219 {$IF NOT DEFINED(OPENGL_ES)}
3220   fOpenGLFormat     := tfA2RGB10ui1;
3221   fglFormat         := GL_BGRA;
3222   fglInternalFormat := GL_RGB10_A2;
3223   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3224 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3225   fOpenGLFormat     := tfA2RGB10ui1;
3226   fglFormat         := GL_RGBA;
3227   fglInternalFormat := GL_RGB10_A2;
3228   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3229 {$ELSE}
3230   fOpenGLFormat     := tfRGBA8ui1;
3231 {$IFEND}
3232 end;
3233
3234 procedure TfdRGBA16us4.SetValues;
3235 begin
3236   inherited SetValues;
3237   fBitsPerPixel     := 64;
3238   fFormat           := tfRGBA16us4;
3239   fWithAlpha        := tfRGBA16us4;
3240   fWithoutAlpha     := tfRGB16us3;
3241   fRGBInverted      := tfBGRA16us4;
3242   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3243   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3244 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3245   fOpenGLFormat     := tfRGBA16us4;
3246   fglFormat         := GL_RGBA;
3247   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3248   fglDataFormat     := GL_UNSIGNED_SHORT;
3249 {$ELSE}
3250   fOpenGLFormat     := tfRGBA8ub4;
3251 {$IFEND}
3252 end;
3253
3254 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3257 procedure TfdBGRX4us1.SetValues;
3258 begin
3259   inherited SetValues;
3260   fBitsPerPixel     := 16;
3261   fFormat           := tfBGRX4us1;
3262   fWithAlpha        := tfBGRA4us1;
3263   fWithoutAlpha     := tfBGRX4us1;
3264   fRGBInverted      := tfRGBX4us1;
3265   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3266   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3267 {$IFNDEF OPENGL_ES}
3268   fOpenGLFormat     := tfBGRX4us1;
3269   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3270   fglInternalFormat := GL_RGB4;
3271   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3272 {$ELSE}
3273   fOpenGLFormat     := tfR5G6B5us1;
3274 {$ENDIF}
3275 end;
3276
3277 procedure TfdXBGR4us1.SetValues;
3278 begin
3279   inherited SetValues;
3280   fBitsPerPixel     := 16;
3281   fFormat           := tfXBGR4us1;
3282   fWithAlpha        := tfABGR4us1;
3283   fWithoutAlpha     := tfXBGR4us1;
3284   fRGBInverted      := tfXRGB4us1;
3285   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3286   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3287 {$IFNDEF OPENGL_ES}
3288   fOpenGLFormat     := tfXBGR4us1;
3289   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3290   fglInternalFormat := GL_RGB4;
3291   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3292 {$ELSE}
3293   fOpenGLFormat     := tfR5G6B5us1;
3294 {$ENDIF}
3295 end;
3296
3297 procedure TfdB5G6R5us1.SetValues;
3298 begin
3299   inherited SetValues;
3300   fBitsPerPixel     := 16;
3301   fFormat           := tfB5G6R5us1;
3302   fWithAlpha        := tfBGR5A1us1;
3303   fWithoutAlpha     := tfB5G6R5us1;
3304   fRGBInverted      := tfR5G6B5us1;
3305   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3306   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3307 {$IFNDEF OPENGL_ES}
3308   fOpenGLFormat     := tfB5G6R5us1;
3309   fglFormat         := GL_RGB;
3310   fglInternalFormat := GL_RGB565;
3311   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3312 {$ELSE}
3313   fOpenGLFormat     := tfR5G6B5us1;
3314 {$ENDIF}
3315 end;
3316
3317 procedure TfdBGR5X1us1.SetValues;
3318 begin
3319   inherited SetValues;
3320   fBitsPerPixel     := 16;
3321   fFormat           := tfBGR5X1us1;
3322   fWithAlpha        := tfBGR5A1us1;
3323   fWithoutAlpha     := tfBGR5X1us1;
3324   fRGBInverted      := tfRGB5X1us1;
3325   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3326   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3327 {$IFNDEF OPENGL_ES}
3328   fOpenGLFormat     := tfBGR5X1us1;
3329   fglFormat         := GL_BGRA;
3330   fglInternalFormat := GL_RGB5;
3331   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3332 {$ELSE}
3333   fOpenGLFormat     := tfR5G6B5us1;
3334 {$ENDIF}
3335 end;
3336
3337 procedure TfdX1BGR5us1.SetValues;
3338 begin
3339   inherited SetValues;
3340   fBitsPerPixel     := 16;
3341   fFormat           := tfX1BGR5us1;
3342   fWithAlpha        := tfA1BGR5us1;
3343   fWithoutAlpha     := tfX1BGR5us1;
3344   fRGBInverted      := tfX1RGB5us1;
3345   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3346   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3347 {$IFNDEF OPENGL_ES}
3348   fOpenGLFormat     := tfX1BGR5us1;
3349   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3350   fglInternalFormat := GL_RGB5;
3351   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3352 {$ELSE}
3353   fOpenGLFormat     := tfR5G6B5us1;
3354 {$ENDIF}
3355 end;
3356
3357 procedure TfdBGR8ub3.SetValues;
3358 begin
3359   inherited SetValues;
3360   fBitsPerPixel     := 24;
3361   fFormat           := tfBGR8ub3;
3362   fWithAlpha        := tfBGRA8ub4;
3363   fWithoutAlpha     := tfBGR8ub3;
3364   fRGBInverted      := tfRGB8ub3;
3365   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3366   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3367 {$IFNDEF OPENGL_ES}
3368   fOpenGLFormat     := tfBGR8ub3;
3369   fglFormat         := GL_BGR;
3370   fglInternalFormat := GL_RGB8;
3371   fglDataFormat     := GL_UNSIGNED_BYTE;
3372 {$ELSE}
3373   fOpenGLFormat     := tfRGB8ub3;
3374 {$ENDIF}
3375 end;
3376
3377 procedure TfdBGRX8ui1.SetValues;
3378 begin
3379   inherited SetValues;
3380   fBitsPerPixel     := 32;
3381   fFormat           := tfBGRX8ui1;
3382   fWithAlpha        := tfBGRA8ui1;
3383   fWithoutAlpha     := tfBGRX8ui1;
3384   fRGBInverted      := tfRGBX8ui1;
3385   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3386   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3387 {$IFNDEF OPENGL_ES}
3388   fOpenGLFormat     := tfBGRX8ui1;
3389   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3390   fglInternalFormat := GL_RGB8;
3391   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3392 {$ELSE}
3393   fOpenGLFormat     := tfRGB8ub3;
3394 {$ENDIF}
3395 end;
3396
3397 procedure TfdXBGR8ui1.SetValues;
3398 begin
3399   inherited SetValues;
3400   fBitsPerPixel     := 32;
3401   fFormat           := tfXBGR8ui1;
3402   fWithAlpha        := tfABGR8ui1;
3403   fWithoutAlpha     := tfXBGR8ui1;
3404   fRGBInverted      := tfXRGB8ui1;
3405   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3406   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3407 {$IFNDEF OPENGL_ES}
3408   fOpenGLFormat     := tfXBGR8ui1;
3409   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3410   fglInternalFormat := GL_RGB8;
3411   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3412 {$ELSE}
3413   fOpenGLFormat     := tfRGB8ub3;
3414 {$ENDIF}
3415 end;
3416
3417 procedure TfdBGR10X2ui1.SetValues;
3418 begin
3419   inherited SetValues;
3420   fBitsPerPixel     := 32;
3421   fFormat           := tfBGR10X2ui1;
3422   fWithAlpha        := tfBGR10A2ui1;
3423   fWithoutAlpha     := tfBGR10X2ui1;
3424   fRGBInverted      := tfRGB10X2ui1;
3425   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3426   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3427 {$IFNDEF OPENGL_ES}
3428   fOpenGLFormat     := tfBGR10X2ui1;
3429   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3430   fglInternalFormat := GL_RGB10;
3431   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3432 {$ELSE}
3433   fOpenGLFormat     := tfRGB16us3;
3434 {$ENDIF}
3435 end;
3436
3437 procedure TfdX2BGR10ui1.SetValues;
3438 begin
3439   inherited SetValues;
3440   fBitsPerPixel     := 32;
3441   fFormat           := tfX2BGR10ui1;
3442   fWithAlpha        := tfA2BGR10ui1;
3443   fWithoutAlpha     := tfX2BGR10ui1;
3444   fRGBInverted      := tfX2RGB10ui1;
3445   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3446   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3447 {$IFNDEF OPENGL_ES}
3448   fOpenGLFormat     := tfX2BGR10ui1;
3449   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3450   fglInternalFormat := GL_RGB10;
3451   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3452 {$ELSE}
3453   fOpenGLFormat     := tfRGB16us3;
3454 {$ENDIF}
3455 end;
3456
3457 procedure TfdBGR16us3.SetValues;
3458 begin
3459   inherited SetValues;
3460   fBitsPerPixel     := 48;
3461   fFormat           := tfBGR16us3;
3462   fWithAlpha        := tfBGRA16us4;
3463   fWithoutAlpha     := tfBGR16us3;
3464   fRGBInverted      := tfRGB16us3;
3465   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3466   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3467 {$IFNDEF OPENGL_ES}
3468   fOpenGLFormat     := tfBGR16us3;
3469   fglFormat         := GL_BGR;
3470   fglInternalFormat := GL_RGB16;
3471   fglDataFormat     := GL_UNSIGNED_SHORT;
3472 {$ELSE}
3473   fOpenGLFormat     := tfRGB16us3;
3474 {$ENDIF}
3475 end;
3476
3477 procedure TfdBGRA4us1.SetValues;
3478 begin
3479   inherited SetValues;
3480   fBitsPerPixel     := 16;
3481   fFormat           := tfBGRA4us1;
3482   fWithAlpha        := tfBGRA4us1;
3483   fWithoutAlpha     := tfBGRX4us1;
3484   fRGBInverted      := tfRGBA4us1;
3485   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3486   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3487 {$IFNDEF OPENGL_ES}
3488   fOpenGLFormat     := tfBGRA4us1;
3489   fglFormat         := GL_BGRA;
3490   fglInternalFormat := GL_RGBA4;
3491   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3492 {$ELSE}
3493   fOpenGLFormat     := tfRGBA4us1;
3494 {$ENDIF}
3495 end;
3496
3497 procedure TfdABGR4us1.SetValues;
3498 begin
3499   inherited SetValues;
3500   fBitsPerPixel     := 16;
3501   fFormat           := tfABGR4us1;
3502   fWithAlpha        := tfABGR4us1;
3503   fWithoutAlpha     := tfXBGR4us1;
3504   fRGBInverted      := tfARGB4us1;
3505   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3506   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3507 {$IFNDEF OPENGL_ES}
3508   fOpenGLFormat     := tfABGR4us1;
3509   fglFormat         := GL_RGBA;
3510   fglInternalFormat := GL_RGBA4;
3511   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3512 {$ELSE}
3513   fOpenGLFormat     := tfRGBA4us1;
3514 {$ENDIF}
3515 end;
3516
3517 procedure TfdBGR5A1us1.SetValues;
3518 begin
3519   inherited SetValues;
3520   fBitsPerPixel     := 16;
3521   fFormat           := tfBGR5A1us1;
3522   fWithAlpha        := tfBGR5A1us1;
3523   fWithoutAlpha     := tfBGR5X1us1;
3524   fRGBInverted      := tfRGB5A1us1;
3525   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3526   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3527 {$IFNDEF OPENGL_ES}
3528   fOpenGLFormat     := tfBGR5A1us1;
3529   fglFormat         := GL_BGRA;
3530   fglInternalFormat := GL_RGB5_A1;
3531   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3532 {$ELSE}
3533   fOpenGLFormat     := tfRGB5A1us1;
3534 {$ENDIF}
3535 end;
3536
3537 procedure TfdA1BGR5us1.SetValues;
3538 begin
3539   inherited SetValues;
3540   fBitsPerPixel     := 16;
3541   fFormat           := tfA1BGR5us1;
3542   fWithAlpha        := tfA1BGR5us1;
3543   fWithoutAlpha     := tfX1BGR5us1;
3544   fRGBInverted      := tfA1RGB5us1;
3545   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3546   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3547 {$IFNDEF OPENGL_ES}
3548   fOpenGLFormat     := tfA1BGR5us1;
3549   fglFormat         := GL_RGBA;
3550   fglInternalFormat := GL_RGB5_A1;
3551   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3552 {$ELSE}
3553   fOpenGLFormat     := tfRGB5A1us1;
3554 {$ENDIF}
3555 end;
3556
3557 procedure TfdBGRA8ui1.SetValues;
3558 begin
3559   inherited SetValues;
3560   fBitsPerPixel     := 32;
3561   fFormat           := tfBGRA8ui1;
3562   fWithAlpha        := tfBGRA8ui1;
3563   fWithoutAlpha     := tfBGRX8ui1;
3564   fRGBInverted      := tfRGBA8ui1;
3565   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3566   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3567 {$IFNDEF OPENGL_ES}
3568   fOpenGLFormat     := tfBGRA8ui1;
3569   fglFormat         := GL_BGRA;
3570   fglInternalFormat := GL_RGBA8;
3571   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3572 {$ELSE}
3573   fOpenGLFormat     := tfRGBA8ub4;
3574 {$ENDIF}
3575 end;
3576
3577 procedure TfdABGR8ui1.SetValues;
3578 begin
3579   inherited SetValues;
3580   fBitsPerPixel     := 32;
3581   fFormat           := tfABGR8ui1;
3582   fWithAlpha        := tfABGR8ui1;
3583   fWithoutAlpha     := tfXBGR8ui1;
3584   fRGBInverted      := tfARGB8ui1;
3585   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3586   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3587 {$IFNDEF OPENGL_ES}
3588   fOpenGLFormat     := tfABGR8ui1;
3589   fglFormat         := GL_RGBA;
3590   fglInternalFormat := GL_RGBA8;
3591   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3592 {$ELSE}
3593   fOpenGLFormat     := tfRGBA8ub4
3594 {$ENDIF}
3595 end;
3596
3597 procedure TfdBGRA8ub4.SetValues;
3598 begin
3599   inherited SetValues;
3600   fBitsPerPixel     := 32;
3601   fFormat           := tfBGRA8ub4;
3602   fWithAlpha        := tfBGRA8ub4;
3603   fWithoutAlpha     := tfBGR8ub3;
3604   fRGBInverted      := tfRGBA8ub4;
3605   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3606   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3607 {$IFNDEF OPENGL_ES}
3608   fOpenGLFormat     := tfBGRA8ub4;
3609   fglFormat         := GL_BGRA;
3610   fglInternalFormat := GL_RGBA8;
3611   fglDataFormat     := GL_UNSIGNED_BYTE;
3612 {$ELSE}
3613   fOpenGLFormat     := tfRGBA8ub4;
3614 {$ENDIF}
3615 end;
3616
3617 procedure TfdBGR10A2ui1.SetValues;
3618 begin
3619   inherited SetValues;
3620   fBitsPerPixel     := 32;
3621   fFormat           := tfBGR10A2ui1;
3622   fWithAlpha        := tfBGR10A2ui1;
3623   fWithoutAlpha     := tfBGR10X2ui1;
3624   fRGBInverted      := tfRGB10A2ui1;
3625   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3626   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3627 {$IFNDEF OPENGL_ES}
3628   fOpenGLFormat     := tfBGR10A2ui1;
3629   fglFormat         := GL_BGRA;
3630   fglInternalFormat := GL_RGB10_A2;
3631   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3632 {$ELSE}
3633   fOpenGLFormat     := tfA2RGB10ui1;
3634 {$ENDIF}
3635 end;
3636
3637 procedure TfdA2BGR10ui1.SetValues;
3638 begin
3639   inherited SetValues;
3640   fBitsPerPixel     := 32;
3641   fFormat           := tfA2BGR10ui1;
3642   fWithAlpha        := tfA2BGR10ui1;
3643   fWithoutAlpha     := tfX2BGR10ui1;
3644   fRGBInverted      := tfA2RGB10ui1;
3645   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3646   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3647 {$IFNDEF OPENGL_ES}
3648   fOpenGLFormat     := tfA2BGR10ui1;
3649   fglFormat         := GL_RGBA;
3650   fglInternalFormat := GL_RGB10_A2;
3651   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3652 {$ELSE}
3653   fOpenGLFormat     := tfA2RGB10ui1;
3654 {$ENDIF}
3655 end;
3656
3657 procedure TfdBGRA16us4.SetValues;
3658 begin
3659   inherited SetValues;
3660   fBitsPerPixel     := 64;
3661   fFormat           := tfBGRA16us4;
3662   fWithAlpha        := tfBGRA16us4;
3663   fWithoutAlpha     := tfBGR16us3;
3664   fRGBInverted      := tfRGBA16us4;
3665   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3666   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3667 {$IFNDEF OPENGL_ES}
3668   fOpenGLFormat     := tfBGRA16us4;
3669   fglFormat         := GL_BGRA;
3670   fglInternalFormat := GL_RGBA16;
3671   fglDataFormat     := GL_UNSIGNED_SHORT;
3672 {$ELSE}
3673   fOpenGLFormat     := tfRGBA16us4;
3674 {$ENDIF}
3675 end;
3676
3677 procedure TfdDepth16us1.SetValues;
3678 begin
3679   inherited SetValues;
3680   fBitsPerPixel     := 16;
3681   fFormat           := tfDepth16us1;
3682   fWithoutAlpha     := tfDepth16us1;
3683   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3684   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3685 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3686   fOpenGLFormat     := tfDepth16us1;
3687   fglFormat         := GL_DEPTH_COMPONENT;
3688   fglInternalFormat := GL_DEPTH_COMPONENT16;
3689   fglDataFormat     := GL_UNSIGNED_SHORT;
3690 {$IFEND}
3691 end;
3692
3693 procedure TfdDepth24ui1.SetValues;
3694 begin
3695   inherited SetValues;
3696   fBitsPerPixel     := 32;
3697   fFormat           := tfDepth24ui1;
3698   fWithoutAlpha     := tfDepth24ui1;
3699   fOpenGLFormat     := tfDepth24ui1;
3700   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3701   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3702 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3703   fOpenGLFormat     := tfDepth24ui1;
3704   fglFormat         := GL_DEPTH_COMPONENT;
3705   fglInternalFormat := GL_DEPTH_COMPONENT24;
3706   fglDataFormat     := GL_UNSIGNED_INT;
3707 {$IFEND}
3708 end;
3709
3710 procedure TfdDepth32ui1.SetValues;
3711 begin
3712   inherited SetValues;
3713   fBitsPerPixel     := 32;
3714   fFormat           := tfDepth32ui1;
3715   fWithoutAlpha     := tfDepth32ui1;
3716   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3717   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3718 {$IF NOT DEFINED(OPENGL_ES)}
3719   fOpenGLFormat     := tfDepth32ui1;
3720   fglFormat         := GL_DEPTH_COMPONENT;
3721   fglInternalFormat := GL_DEPTH_COMPONENT32;
3722   fglDataFormat     := GL_UNSIGNED_INT;
3723 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3724   fOpenGLFormat     := tfDepth24ui1;
3725 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3726   fOpenGLFormat     := tfDepth16us1;
3727 {$IFEND}
3728 end;
3729
3730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3733 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3734 begin
3735   raise EglBitmap.Create('mapping for compressed formats is not supported');
3736 end;
3737
3738 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3739 begin
3740   raise EglBitmap.Create('mapping for compressed formats is not supported');
3741 end;
3742
3743 procedure TfdS3tcDtx1RGBA.SetValues;
3744 begin
3745   inherited SetValues;
3746   fFormat           := tfS3tcDtx1RGBA;
3747   fWithAlpha        := tfS3tcDtx1RGBA;
3748   fUncompressed     := tfRGB5A1us1;
3749   fBitsPerPixel     := 4;
3750   fIsCompressed     := true;
3751 {$IFNDEF OPENGL_ES}
3752   fOpenGLFormat     := tfS3tcDtx1RGBA;
3753   fglFormat         := GL_COMPRESSED_RGBA;
3754   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3755   fglDataFormat     := GL_UNSIGNED_BYTE;
3756 {$ELSE}
3757   fOpenGLFormat     := fUncompressed;
3758 {$ENDIF}
3759 end;
3760
3761 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3762 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3764 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3765 begin
3766   raise EglBitmap.Create('mapping for compressed formats is not supported');
3767 end;
3768
3769 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3770 begin
3771   raise EglBitmap.Create('mapping for compressed formats is not supported');
3772 end;
3773
3774 procedure TfdS3tcDtx3RGBA.SetValues;
3775 begin
3776   inherited SetValues;
3777   fFormat           := tfS3tcDtx3RGBA;
3778   fWithAlpha        := tfS3tcDtx3RGBA;
3779   fUncompressed     := tfRGBA8ub4;
3780   fBitsPerPixel     := 8;
3781   fIsCompressed     := true;
3782 {$IFNDEF OPENGL_ES}
3783   fOpenGLFormat     := tfS3tcDtx3RGBA;
3784   fglFormat         := GL_COMPRESSED_RGBA;
3785   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3786   fglDataFormat     := GL_UNSIGNED_BYTE;
3787 {$ELSE}
3788   fOpenGLFormat     := fUncompressed;
3789 {$ENDIF}
3790 end;
3791
3792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3793 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3796 begin
3797   raise EglBitmap.Create('mapping for compressed formats is not supported');
3798 end;
3799
3800 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3801 begin
3802   raise EglBitmap.Create('mapping for compressed formats is not supported');
3803 end;
3804
3805 procedure TfdS3tcDtx5RGBA.SetValues;
3806 begin
3807   inherited SetValues;
3808   fFormat           := tfS3tcDtx3RGBA;
3809   fWithAlpha        := tfS3tcDtx3RGBA;
3810   fUncompressed     := tfRGBA8ub4;
3811   fBitsPerPixel     := 8;
3812   fIsCompressed     := true;
3813 {$IFNDEF OPENGL_ES}
3814   fOpenGLFormat     := tfS3tcDtx3RGBA;
3815   fglFormat         := GL_COMPRESSED_RGBA;
3816   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3817   fglDataFormat     := GL_UNSIGNED_BYTE;
3818 {$ELSE}
3819   fOpenGLFormat     := fUncompressed;
3820 {$ENDIF}
3821 end;
3822
3823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3824 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3826 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3827 begin
3828   result := (fPrecision.r > 0);
3829 end;
3830
3831 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3832 begin
3833   result := (fPrecision.g > 0);
3834 end;
3835
3836 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3837 begin
3838   result := (fPrecision.b > 0);
3839 end;
3840
3841 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3842 begin
3843   result := (fPrecision.a > 0);
3844 end;
3845
3846 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3847 begin
3848   result := HasRed or HasGreen or HasBlue;
3849 end;
3850
3851 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3852 begin
3853   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3854 end;
3855
3856 function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
3857 begin
3858   result := (OpenGLFormat = Format);
3859 end;
3860
3861 procedure TglBitmapFormatDescriptor.SetValues;
3862 begin
3863   fFormat       := tfEmpty;
3864   fWithAlpha    := tfEmpty;
3865   fWithoutAlpha := tfEmpty;
3866   fOpenGLFormat := tfEmpty;
3867   fRGBInverted  := tfEmpty;
3868   fUncompressed := tfEmpty;
3869
3870   fBitsPerPixel := 0;
3871   fIsCompressed := false;
3872
3873   fglFormat         := 0;
3874   fglInternalFormat := 0;
3875   fglDataFormat     := 0;
3876
3877   FillChar(fPrecision, 0, SizeOf(fPrecision));
3878   FillChar(fShift,     0, SizeOf(fShift));
3879 end;
3880
3881 procedure TglBitmapFormatDescriptor.CalcValues;
3882 var
3883   i: Integer;
3884 begin
3885   fBytesPerPixel := fBitsPerPixel / 8;
3886   fChannelCount  := 0;
3887   for i := 0 to 3 do begin
3888     if (fPrecision.arr[i] > 0) then
3889       inc(fChannelCount);
3890     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3891     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3892   end;
3893 end;
3894
3895 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3896 var
3897   w, h: Integer;
3898 begin
3899   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3900     w := Max(1, aSize.X);
3901     h := Max(1, aSize.Y);
3902     result := GetSize(w, h);
3903   end else
3904     result := 0;
3905 end;
3906
3907 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3908 begin
3909   result := 0;
3910   if (aWidth <= 0) or (aHeight <= 0) then
3911     exit;
3912   result := Ceil(aWidth * aHeight * BytesPerPixel);
3913 end;
3914
3915 constructor TglBitmapFormatDescriptor.Create;
3916 begin
3917   inherited Create;
3918   SetValues;
3919   CalcValues;
3920 end;
3921
3922 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3923 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3924 var
3925   f: TglBitmapFormat;
3926 begin
3927   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3928     result := TFormatDescriptor.Get(f);
3929     if (result.glInternalFormat = aInternalFormat) then
3930       exit;
3931   end;
3932   result := TFormatDescriptor.Get(tfEmpty);
3933 end;
3934
3935 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3936 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3938 class procedure TFormatDescriptor.Init;
3939 begin
3940   if not Assigned(FormatDescriptorCS) then
3941     FormatDescriptorCS := TCriticalSection.Create;
3942 end;
3943
3944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3945 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3946 begin
3947   FormatDescriptorCS.Enter;
3948   try
3949     result := FormatDescriptors[aFormat];
3950     if not Assigned(result) then begin
3951       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3952       FormatDescriptors[aFormat] := result;
3953     end;
3954   finally
3955     FormatDescriptorCS.Leave;
3956   end;
3957 end;
3958
3959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3960 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3961 begin
3962   result := Get(Get(aFormat).WithAlpha);
3963 end;
3964
3965 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3966 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3967 var
3968   ft: TglBitmapFormat;
3969 begin
3970   // find matching format with OpenGL support
3971   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3972     result := Get(ft);
3973     if (result.MaskMatch(aMask))      and
3974        (result.glFormat <> 0)         and
3975        (result.glInternalFormat <> 0) and
3976        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3977     then
3978       exit;
3979   end;
3980
3981   // find matching format without OpenGL Support
3982   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3983     result := Get(ft);
3984     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3985       exit;
3986   end;
3987
3988   result := TFormatDescriptor.Get(tfEmpty);
3989 end;
3990
3991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3992 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3993 var
3994   ft: TglBitmapFormat;
3995 begin
3996   // find matching format with OpenGL support
3997   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3998     result := Get(ft);
3999     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4000        glBitmapRec4ubCompare(result.Precision, aPrec) and
4001        (result.glFormat <> 0)         and
4002        (result.glInternalFormat <> 0) and
4003        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4004     then
4005       exit;
4006   end;
4007
4008   // find matching format without OpenGL Support
4009   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4010     result := Get(ft);
4011     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4012        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4013        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4014       exit;
4015   end;
4016
4017   result := TFormatDescriptor.Get(tfEmpty);
4018 end;
4019
4020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4021 class procedure TFormatDescriptor.Clear;
4022 var
4023   f: TglBitmapFormat;
4024 begin
4025   FormatDescriptorCS.Enter;
4026   try
4027     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4028       FreeAndNil(FormatDescriptors[f]);
4029   finally
4030     FormatDescriptorCS.Leave;
4031   end;
4032 end;
4033
4034 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4035 class procedure TFormatDescriptor.Finalize;
4036 begin
4037   Clear;
4038   FreeAndNil(FormatDescriptorCS);
4039 end;
4040
4041 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4042 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4044 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4045 var
4046   i: Integer;
4047 begin
4048   for i := 0 to 3 do begin
4049     fShift.arr[i] := 0;
4050     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4051       aMask.arr[i] := aMask.arr[i] shr 1;
4052       inc(fShift.arr[i]);
4053     end;
4054     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4055   end;
4056   fBitsPerPixel := aBPP;
4057   CalcValues;
4058 end;
4059
4060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4061 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4062 begin
4063   fBitsPerPixel := aBBP;
4064   fPrecision    := aPrec;
4065   fShift        := aShift;
4066   CalcValues;
4067 end;
4068
4069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4070 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4071 var
4072   data: QWord;
4073 begin
4074   data :=
4075     ((aPixel.Data.r and Range.r) shl Shift.r) or
4076     ((aPixel.Data.g and Range.g) shl Shift.g) or
4077     ((aPixel.Data.b and Range.b) shl Shift.b) or
4078     ((aPixel.Data.a and Range.a) shl Shift.a);
4079   case BitsPerPixel of
4080     8:           aData^  := data;
4081    16:     PWord(aData)^ := data;
4082    32: PCardinal(aData)^ := data;
4083    64:    PQWord(aData)^ := data;
4084   else
4085     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4086   end;
4087   inc(aData, Round(BytesPerPixel));
4088 end;
4089
4090 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4091 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4092 var
4093   data: QWord;
4094   i: Integer;
4095 begin
4096   case BitsPerPixel of
4097      8: data :=           aData^;
4098     16: data :=     PWord(aData)^;
4099     32: data := PCardinal(aData)^;
4100     64: data :=    PQWord(aData)^;
4101   else
4102     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4103   end;
4104   for i := 0 to 3 do
4105     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4106   inc(aData, Round(BytesPerPixel));
4107 end;
4108
4109 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4110 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4112 procedure TbmpColorTableFormat.SetValues;
4113 begin
4114   inherited SetValues;
4115   fShift := glBitmapRec4ub(8, 8, 8, 0);
4116 end;
4117
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4120 begin
4121   fFormat       := aFormat;
4122   fBitsPerPixel := aBPP;
4123   fPrecision    := aPrec;
4124   fShift        := aShift;
4125   CalcValues;
4126 end;
4127
4128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4129 procedure TbmpColorTableFormat.CalcValues;
4130 begin
4131   inherited CalcValues;
4132 end;
4133
4134 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4135 procedure TbmpColorTableFormat.CreateColorTable;
4136 var
4137   i: Integer;
4138 begin
4139   SetLength(fColorTable, 256);
4140   if not HasColor then begin
4141     // alpha
4142     for i := 0 to High(fColorTable) do begin
4143       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4144       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4145       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4146       fColorTable[i].a := 0;
4147     end;
4148   end else begin
4149     // normal
4150     for i := 0 to High(fColorTable) do begin
4151       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4152       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4153       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4154       fColorTable[i].a := 0;
4155     end;
4156   end;
4157 end;
4158
4159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4160 function TbmpColorTableFormat.CreateMappingData: Pointer;
4161 begin
4162   result := Pointer(0);
4163 end;
4164
4165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4166 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4167 begin
4168   if (BitsPerPixel <> 8) then
4169     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4170   if not HasColor then
4171     // alpha
4172     aData^ := aPixel.Data.a
4173   else
4174     // normal
4175     aData^ := Round(
4176       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4177       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4178       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4179   inc(aData);
4180 end;
4181
4182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4183 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4184
4185   function ReadValue: Byte;
4186   var
4187     i: PtrUInt;
4188   begin
4189     if (BitsPerPixel = 8) then begin
4190       result := aData^;
4191       inc(aData);
4192     end else begin
4193       i := {%H-}PtrUInt(aMapData);
4194       if (BitsPerPixel > 1) then
4195         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4196       else
4197         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4198       inc(i, BitsPerPixel);
4199       while (i >= 8) do begin
4200         inc(aData);
4201         dec(i, 8);
4202       end;
4203       aMapData := {%H-}Pointer(i);
4204     end;
4205   end;
4206
4207 begin
4208   if (BitsPerPixel > 8) then
4209     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4210   with fColorTable[ReadValue] do begin
4211     aPixel.Data.r := r;
4212     aPixel.Data.g := g;
4213     aPixel.Data.b := b;
4214     aPixel.Data.a := a;
4215   end;
4216 end;
4217
4218 destructor TbmpColorTableFormat.Destroy;
4219 begin
4220   SetLength(fColorTable, 0);
4221   inherited Destroy;
4222 end;
4223
4224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4225 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4227 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4228 var
4229   i: Integer;
4230 begin
4231   for i := 0 to 3 do begin
4232     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4233       if (aSourceFD.Range.arr[i] > 0) then
4234         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4235       else
4236         aPixel.Data.arr[i] := 0;
4237     end;
4238   end;
4239 end;
4240
4241 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4242 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4243 begin
4244   with aFuncRec do begin
4245     if (Source.Range.r   > 0) then
4246       Dest.Data.r := Source.Data.r;
4247     if (Source.Range.g > 0) then
4248       Dest.Data.g := Source.Data.g;
4249     if (Source.Range.b  > 0) then
4250       Dest.Data.b := Source.Data.b;
4251     if (Source.Range.a > 0) then
4252       Dest.Data.a := Source.Data.a;
4253   end;
4254 end;
4255
4256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4257 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4258 var
4259   i: Integer;
4260 begin
4261   with aFuncRec do begin
4262     for i := 0 to 3 do
4263       if (Source.Range.arr[i] > 0) then
4264         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4265   end;
4266 end;
4267
4268 type
4269   TShiftData = packed record
4270     case Integer of
4271       0: (r, g, b, a: SmallInt);
4272       1: (arr: array[0..3] of SmallInt);
4273   end;
4274   PShiftData = ^TShiftData;
4275
4276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4277 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4278 var
4279   i: Integer;
4280 begin
4281   with aFuncRec do
4282     for i := 0 to 3 do
4283       if (Source.Range.arr[i] > 0) then
4284         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4285 end;
4286
4287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4288 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4289 var
4290   i: Integer;
4291 begin
4292   with aFuncRec do begin
4293     Dest.Data := Source.Data;
4294     for i := 0 to 3 do
4295       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4296         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4297   end;
4298 end;
4299
4300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4301 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4302 var
4303   i: Integer;
4304 begin
4305   with aFuncRec do begin
4306     for i := 0 to 3 do
4307       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4308   end;
4309 end;
4310
4311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4312 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4313 var
4314   Temp: Single;
4315 begin
4316   with FuncRec do begin
4317     if (FuncRec.Args = nil) then begin //source has no alpha
4318       Temp :=
4319         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4320         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4321         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4322       Dest.Data.a := Round(Dest.Range.a * Temp);
4323     end else
4324       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4325   end;
4326 end;
4327
4328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4329 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4330 type
4331   PglBitmapPixelData = ^TglBitmapPixelData;
4332 begin
4333   with FuncRec do begin
4334     Dest.Data.r := Source.Data.r;
4335     Dest.Data.g := Source.Data.g;
4336     Dest.Data.b := Source.Data.b;
4337
4338     with PglBitmapPixelData(Args)^ do
4339       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4340           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4341           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4342         Dest.Data.a := 0
4343       else
4344         Dest.Data.a := Dest.Range.a;
4345   end;
4346 end;
4347
4348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4350 begin
4351   with FuncRec do begin
4352     Dest.Data.r := Source.Data.r;
4353     Dest.Data.g := Source.Data.g;
4354     Dest.Data.b := Source.Data.b;
4355     Dest.Data.a := PCardinal(Args)^;
4356   end;
4357 end;
4358
4359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4360 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4361 type
4362   PRGBPix = ^TRGBPix;
4363   TRGBPix = array [0..2] of byte;
4364 var
4365   Temp: Byte;
4366 begin
4367   while aWidth > 0 do begin
4368     Temp := PRGBPix(aData)^[0];
4369     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4370     PRGBPix(aData)^[2] := Temp;
4371
4372     if aHasAlpha then
4373       Inc(aData, 4)
4374     else
4375       Inc(aData, 3);
4376     dec(aWidth);
4377   end;
4378 end;
4379
4380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4381 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4384 begin
4385   result := TFormatDescriptor.Get(fFormat);
4386 end;
4387
4388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4389 function TglBitmapData.GetWidth: Integer;
4390 begin
4391   if (ffX in fDimension.Fields) then
4392     result := fDimension.X
4393   else
4394     result := -1;
4395 end;
4396
4397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4398 function TglBitmapData.GetHeight: Integer;
4399 begin
4400   if (ffY in fDimension.Fields) then
4401     result := fDimension.Y
4402   else
4403     result := -1;
4404 end;
4405
4406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4407 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4408 begin
4409   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4410     result := fScanlines[aIndex]
4411   else
4412     result := nil;
4413 end;
4414
4415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4416 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4417 begin
4418   if fFormat = aValue then
4419     exit;
4420   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4421     raise EglBitmapUnsupportedFormat.Create(Format);
4422   SetData(fData, aValue, Width, Height);
4423 end;
4424
4425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4426 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4427 var
4428   TempPos: Integer;
4429 begin
4430   if not Assigned(aResType) then begin
4431     TempPos   := Pos('.', aResource);
4432     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4433     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4434   end;
4435 end;
4436
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 procedure TglBitmapData.UpdateScanlines;
4439 var
4440   w, h, i, LineWidth: Integer;
4441 begin
4442   w := Width;
4443   h := Height;
4444   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4445   if fHasScanlines then begin
4446     SetLength(fScanlines, h);
4447     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4448     for i := 0 to h-1 do begin
4449       fScanlines[i] := fData;
4450       Inc(fScanlines[i], i * LineWidth);
4451     end;
4452   end else
4453     SetLength(fScanlines, 0);
4454 end;
4455
4456 {$IFDEF GLB_SUPPORT_PNG_READ}
4457 {$IF DEFINED(GLB_LAZ_PNG)}
4458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4459 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4461 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4462 const
4463   MAGIC_LEN = 8;
4464   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4465 var
4466   reader: TLazReaderPNG;
4467   intf: TLazIntfImage;
4468   StreamPos: Int64;
4469   magic: String[MAGIC_LEN];
4470 begin
4471   result := true;
4472   StreamPos := aStream.Position;
4473
4474   SetLength(magic, MAGIC_LEN);
4475   aStream.Read(magic[1], MAGIC_LEN);
4476   aStream.Position := StreamPos;
4477   if (magic <> PNG_MAGIC) then begin
4478     result := false;
4479     exit;
4480   end;
4481
4482   intf   := TLazIntfImage.Create(0, 0);
4483   reader := TLazReaderPNG.Create;
4484   try try
4485     reader.UpdateDescription := true;
4486     reader.ImageRead(aStream, intf);
4487     AssignFromLazIntfImage(intf);
4488   except
4489     result := false;
4490     aStream.Position := StreamPos;
4491     exit;
4492   end;
4493   finally
4494     reader.Free;
4495     intf.Free;
4496   end;
4497 end;
4498
4499 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4500 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4501 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4502 var
4503   Surface: PSDL_Surface;
4504   RWops: PSDL_RWops;
4505 begin
4506   result := false;
4507   RWops := glBitmapCreateRWops(aStream);
4508   try
4509     if IMG_isPNG(RWops) > 0 then begin
4510       Surface := IMG_LoadPNG_RW(RWops);
4511       try
4512         AssignFromSurface(Surface);
4513         result := true;
4514       finally
4515         SDL_FreeSurface(Surface);
4516       end;
4517     end;
4518   finally
4519     SDL_FreeRW(RWops);
4520   end;
4521 end;
4522
4523 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4525 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4526 begin
4527   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4528 end;
4529
4530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4531 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4532 var
4533   StreamPos: Int64;
4534   signature: array [0..7] of byte;
4535   png: png_structp;
4536   png_info: png_infop;
4537
4538   TempHeight, TempWidth: Integer;
4539   Format: TglBitmapFormat;
4540
4541   png_data: pByte;
4542   png_rows: array of pByte;
4543   Row, LineSize: Integer;
4544 begin
4545   result := false;
4546
4547   if not init_libPNG then
4548     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4549
4550   try
4551     // signature
4552     StreamPos := aStream.Position;
4553     aStream.Read(signature{%H-}, 8);
4554     aStream.Position := StreamPos;
4555
4556     if png_check_sig(@signature, 8) <> 0 then begin
4557       // png read struct
4558       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4559       if png = nil then
4560         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4561
4562       // png info
4563       png_info := png_create_info_struct(png);
4564       if png_info = nil then begin
4565         png_destroy_read_struct(@png, nil, nil);
4566         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4567       end;
4568
4569       // set read callback
4570       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4571
4572       // read informations
4573       png_read_info(png, png_info);
4574
4575       // size
4576       TempHeight := png_get_image_height(png, png_info);
4577       TempWidth := png_get_image_width(png, png_info);
4578
4579       // format
4580       case png_get_color_type(png, png_info) of
4581         PNG_COLOR_TYPE_GRAY:
4582           Format := tfLuminance8ub1;
4583         PNG_COLOR_TYPE_GRAY_ALPHA:
4584           Format := tfLuminance8Alpha8us1;
4585         PNG_COLOR_TYPE_RGB:
4586           Format := tfRGB8ub3;
4587         PNG_COLOR_TYPE_RGB_ALPHA:
4588           Format := tfRGBA8ub4;
4589         else
4590           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4591       end;
4592
4593       // cut upper 8 bit from 16 bit formats
4594       if png_get_bit_depth(png, png_info) > 8 then
4595         png_set_strip_16(png);
4596
4597       // expand bitdepth smaller than 8
4598       if png_get_bit_depth(png, png_info) < 8 then
4599         png_set_expand(png);
4600
4601       // allocating mem for scanlines
4602       LineSize := png_get_rowbytes(png, png_info);
4603       GetMem(png_data, TempHeight * LineSize);
4604       try
4605         SetLength(png_rows, TempHeight);
4606         for Row := Low(png_rows) to High(png_rows) do begin
4607           png_rows[Row] := png_data;
4608           Inc(png_rows[Row], Row * LineSize);
4609         end;
4610
4611         // read complete image into scanlines
4612         png_read_image(png, @png_rows[0]);
4613
4614         // read end
4615         png_read_end(png, png_info);
4616
4617         // destroy read struct
4618         png_destroy_read_struct(@png, @png_info, nil);
4619
4620         SetLength(png_rows, 0);
4621
4622         // set new data
4623         SetData(png_data, Format, TempWidth, TempHeight);
4624
4625         result := true;
4626       except
4627         if Assigned(png_data) then
4628           FreeMem(png_data);
4629         raise;
4630       end;
4631     end;
4632   finally
4633     quit_libPNG;
4634   end;
4635 end;
4636
4637 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4639 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4640 var
4641   StreamPos: Int64;
4642   Png: TPNGObject;
4643   Header: String[8];
4644   Row, Col, PixSize, LineSize: Integer;
4645   NewImage, pSource, pDest, pAlpha: pByte;
4646   PngFormat: TglBitmapFormat;
4647   FormatDesc: TFormatDescriptor;
4648
4649 const
4650   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4651
4652 begin
4653   result := false;
4654
4655   StreamPos := aStream.Position;
4656   aStream.Read(Header[0], SizeOf(Header));
4657   aStream.Position := StreamPos;
4658
4659   {Test if the header matches}
4660   if Header = PngHeader then begin
4661     Png := TPNGObject.Create;
4662     try
4663       Png.LoadFromStream(aStream);
4664
4665       case Png.Header.ColorType of
4666         COLOR_GRAYSCALE:
4667           PngFormat := tfLuminance8ub1;
4668         COLOR_GRAYSCALEALPHA:
4669           PngFormat := tfLuminance8Alpha8us1;
4670         COLOR_RGB:
4671           PngFormat := tfBGR8ub3;
4672         COLOR_RGBALPHA:
4673           PngFormat := tfBGRA8ub4;
4674         else
4675           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4676       end;
4677
4678       FormatDesc := TFormatDescriptor.Get(PngFormat);
4679       PixSize    := Round(FormatDesc.PixelSize);
4680       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4681
4682       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4683       try
4684         pDest := NewImage;
4685
4686         case Png.Header.ColorType of
4687           COLOR_RGB, COLOR_GRAYSCALE:
4688             begin
4689               for Row := 0 to Png.Height -1 do begin
4690                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4691                 Inc(pDest, LineSize);
4692               end;
4693             end;
4694           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4695             begin
4696               PixSize := PixSize -1;
4697
4698               for Row := 0 to Png.Height -1 do begin
4699                 pSource := Png.Scanline[Row];
4700                 pAlpha := pByte(Png.AlphaScanline[Row]);
4701
4702                 for Col := 0 to Png.Width -1 do begin
4703                   Move (pSource^, pDest^, PixSize);
4704                   Inc(pSource, PixSize);
4705                   Inc(pDest, PixSize);
4706
4707                   pDest^ := pAlpha^;
4708                   inc(pAlpha);
4709                   Inc(pDest);
4710                 end;
4711               end;
4712             end;
4713           else
4714             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4715         end;
4716
4717         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4718
4719         result := true;
4720       except
4721         if Assigned(NewImage) then
4722           FreeMem(NewImage);
4723         raise;
4724       end;
4725     finally
4726       Png.Free;
4727     end;
4728   end;
4729 end;
4730 {$IFEND}
4731 {$ENDIF}
4732
4733 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4734 {$IFDEF GLB_LIB_PNG}
4735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4736 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4737 begin
4738   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4739 end;
4740 {$ENDIF}
4741
4742 {$IF DEFINED(GLB_LAZ_PNG)}
4743 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4744 procedure TglBitmapData.SavePNG(const aStream: TStream);
4745 var
4746   png: TPortableNetworkGraphic;
4747   intf: TLazIntfImage;
4748   raw: TRawImage;
4749 begin
4750   png  := TPortableNetworkGraphic.Create;
4751   intf := TLazIntfImage.Create(0, 0);
4752   try
4753     if not AssignToLazIntfImage(intf) then
4754       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4755     intf.GetRawImage(raw);
4756     png.LoadFromRawImage(raw, false);
4757     png.SaveToStream(aStream);
4758   finally
4759     png.Free;
4760     intf.Free;
4761   end;
4762 end;
4763
4764 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4766 procedure TglBitmapData.SavePNG(const aStream: TStream);
4767 var
4768   png: png_structp;
4769   png_info: png_infop;
4770   png_rows: array of pByte;
4771   LineSize: Integer;
4772   ColorType: Integer;
4773   Row: Integer;
4774   FormatDesc: TFormatDescriptor;
4775 begin
4776   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4777     raise EglBitmapUnsupportedFormat.Create(Format);
4778
4779   if not init_libPNG then
4780     raise Exception.Create('unable to initialize libPNG.');
4781
4782   try
4783     case Format of
4784       tfAlpha8ub1, tfLuminance8ub1:
4785         ColorType := PNG_COLOR_TYPE_GRAY;
4786       tfLuminance8Alpha8us1:
4787         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4788       tfBGR8ub3, tfRGB8ub3:
4789         ColorType := PNG_COLOR_TYPE_RGB;
4790       tfBGRA8ub4, tfRGBA8ub4:
4791         ColorType := PNG_COLOR_TYPE_RGBA;
4792       else
4793         raise EglBitmapUnsupportedFormat.Create(Format);
4794     end;
4795
4796     FormatDesc := TFormatDescriptor.Get(Format);
4797     LineSize := FormatDesc.GetSize(Width, 1);
4798
4799     // creating array for scanline
4800     SetLength(png_rows, Height);
4801     try
4802       for Row := 0 to Height - 1 do begin
4803         png_rows[Row] := Data;
4804         Inc(png_rows[Row], Row * LineSize)
4805       end;
4806
4807       // write struct
4808       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4809       if png = nil then
4810         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4811
4812       // create png info
4813       png_info := png_create_info_struct(png);
4814       if png_info = nil then begin
4815         png_destroy_write_struct(@png, nil);
4816         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4817       end;
4818
4819       // set read callback
4820       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4821
4822       // set compression
4823       png_set_compression_level(png, 6);
4824
4825       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4826         png_set_bgr(png);
4827
4828       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4829       png_write_info(png, png_info);
4830       png_write_image(png, @png_rows[0]);
4831       png_write_end(png, png_info);
4832       png_destroy_write_struct(@png, @png_info);
4833     finally
4834       SetLength(png_rows, 0);
4835     end;
4836   finally
4837     quit_libPNG;
4838   end;
4839 end;
4840
4841 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4843 procedure TglBitmapData.SavePNG(const aStream: TStream);
4844 var
4845   Png: TPNGObject;
4846
4847   pSource, pDest: pByte;
4848   X, Y, PixSize: Integer;
4849   ColorType: Cardinal;
4850   Alpha: Boolean;
4851
4852   pTemp: pByte;
4853   Temp: Byte;
4854 begin
4855   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4856     raise EglBitmapUnsupportedFormat.Create(Format);
4857
4858   case Format of
4859     tfAlpha8ub1, tfLuminance8ub1: begin
4860       ColorType := COLOR_GRAYSCALE;
4861       PixSize   := 1;
4862       Alpha     := false;
4863     end;
4864     tfLuminance8Alpha8us1: begin
4865       ColorType := COLOR_GRAYSCALEALPHA;
4866       PixSize   := 1;
4867       Alpha     := true;
4868     end;
4869     tfBGR8ub3, tfRGB8ub3: begin
4870       ColorType := COLOR_RGB;
4871       PixSize   := 3;
4872       Alpha     := false;
4873     end;
4874     tfBGRA8ub4, tfRGBA8ub4: begin
4875       ColorType := COLOR_RGBALPHA;
4876       PixSize   := 3;
4877       Alpha     := true
4878     end;
4879   else
4880     raise EglBitmapUnsupportedFormat.Create(Format);
4881   end;
4882
4883   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4884   try
4885     // Copy ImageData
4886     pSource := Data;
4887     for Y := 0 to Height -1 do begin
4888       pDest := png.ScanLine[Y];
4889       for X := 0 to Width -1 do begin
4890         Move(pSource^, pDest^, PixSize);
4891         Inc(pDest, PixSize);
4892         Inc(pSource, PixSize);
4893         if Alpha then begin
4894           png.AlphaScanline[Y]^[X] := pSource^;
4895           Inc(pSource);
4896         end;
4897       end;
4898
4899       // convert RGB line to BGR
4900       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4901         pTemp := png.ScanLine[Y];
4902         for X := 0 to Width -1 do begin
4903           Temp := pByteArray(pTemp)^[0];
4904           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4905           pByteArray(pTemp)^[2] := Temp;
4906           Inc(pTemp, 3);
4907         end;
4908       end;
4909     end;
4910
4911     // Save to Stream
4912     Png.CompressionLevel := 6;
4913     Png.SaveToStream(aStream);
4914   finally
4915     FreeAndNil(Png);
4916   end;
4917 end;
4918 {$IFEND}
4919 {$ENDIF}
4920
4921 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4922 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4924 {$IFDEF GLB_LIB_JPEG}
4925 type
4926   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4927   glBitmap_libJPEG_source_mgr = record
4928     pub: jpeg_source_mgr;
4929
4930     SrcStream: TStream;
4931     SrcBuffer: array [1..4096] of byte;
4932   end;
4933
4934   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4935   glBitmap_libJPEG_dest_mgr = record
4936     pub: jpeg_destination_mgr;
4937
4938     DestStream: TStream;
4939     DestBuffer: array [1..4096] of byte;
4940   end;
4941
4942 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4943 begin
4944   //DUMMY
4945 end;
4946
4947
4948 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4949 begin
4950   //DUMMY
4951 end;
4952
4953
4954 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4955 begin
4956   //DUMMY
4957 end;
4958
4959 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4960 begin
4961   //DUMMY
4962 end;
4963
4964
4965 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4966 begin
4967   //DUMMY
4968 end;
4969
4970
4971 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4972 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4973 var
4974   src: glBitmap_libJPEG_source_mgr_ptr;
4975   bytes: integer;
4976 begin
4977   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4978
4979   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4980         if (bytes <= 0) then begin
4981                 src^.SrcBuffer[1] := $FF;
4982                 src^.SrcBuffer[2] := JPEG_EOI;
4983                 bytes := 2;
4984         end;
4985
4986         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4987         src^.pub.bytes_in_buffer := bytes;
4988
4989   result := true;
4990 end;
4991
4992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4993 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4994 var
4995   src: glBitmap_libJPEG_source_mgr_ptr;
4996 begin
4997   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4998
4999   if num_bytes > 0 then begin
5000     // wanted byte isn't in buffer so set stream position and read buffer
5001     if num_bytes > src^.pub.bytes_in_buffer then begin
5002       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5003       src^.pub.fill_input_buffer(cinfo);
5004     end else begin
5005       // wanted byte is in buffer so only skip
5006                 inc(src^.pub.next_input_byte, num_bytes);
5007                 dec(src^.pub.bytes_in_buffer, num_bytes);
5008     end;
5009   end;
5010 end;
5011
5012 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5013 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5014 var
5015   dest: glBitmap_libJPEG_dest_mgr_ptr;
5016 begin
5017   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5018
5019   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5020     // write complete buffer
5021     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5022
5023     // reset buffer
5024     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5025     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5026   end;
5027
5028   result := true;
5029 end;
5030
5031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5032 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5033 var
5034   Idx: Integer;
5035   dest: glBitmap_libJPEG_dest_mgr_ptr;
5036 begin
5037   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5038
5039   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5040     // check for endblock
5041     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5042       // write endblock
5043       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5044
5045       // leave
5046       break;
5047     end else
5048       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5049   end;
5050 end;
5051 {$ENDIF}
5052
5053 {$IFDEF GLB_SUPPORT_JPEG_READ}
5054 {$IF DEFINED(GLB_LAZ_JPEG)}
5055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5056 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5057 const
5058   MAGIC_LEN = 2;
5059   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5060 var
5061   intf: TLazIntfImage;
5062   reader: TFPReaderJPEG;
5063   StreamPos: Int64;
5064   magic: String[MAGIC_LEN];
5065 begin
5066   result := true;
5067   StreamPos := aStream.Position;
5068
5069   SetLength(magic, MAGIC_LEN);
5070   aStream.Read(magic[1], MAGIC_LEN);
5071   aStream.Position := StreamPos;
5072   if (magic <> JPEG_MAGIC) then begin
5073     result := false;
5074     exit;
5075   end;
5076
5077   reader := TFPReaderJPEG.Create;
5078   intf := TLazIntfImage.Create(0, 0);
5079   try try
5080     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5081     reader.ImageRead(aStream, intf);
5082     AssignFromLazIntfImage(intf);
5083   except
5084     result := false;
5085     aStream.Position := StreamPos;
5086     exit;
5087   end;
5088   finally
5089     reader.Free;
5090     intf.Free;
5091   end;
5092 end;
5093
5094 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5096 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5097 var
5098   Surface: PSDL_Surface;
5099   RWops: PSDL_RWops;
5100 begin
5101   result := false;
5102
5103   RWops := glBitmapCreateRWops(aStream);
5104   try
5105     if IMG_isJPG(RWops) > 0 then begin
5106       Surface := IMG_LoadJPG_RW(RWops);
5107       try
5108         AssignFromSurface(Surface);
5109         result := true;
5110       finally
5111         SDL_FreeSurface(Surface);
5112       end;
5113     end;
5114   finally
5115     SDL_FreeRW(RWops);
5116   end;
5117 end;
5118
5119 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5121 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5122 var
5123   StreamPos: Int64;
5124   Temp: array[0..1]of Byte;
5125
5126   jpeg: jpeg_decompress_struct;
5127   jpeg_err: jpeg_error_mgr;
5128
5129   IntFormat: TglBitmapFormat;
5130   pImage: pByte;
5131   TempHeight, TempWidth: Integer;
5132
5133   pTemp: pByte;
5134   Row: Integer;
5135
5136   FormatDesc: TFormatDescriptor;
5137 begin
5138   result := false;
5139
5140   if not init_libJPEG then
5141     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5142
5143   try
5144     // reading first two bytes to test file and set cursor back to begin
5145     StreamPos := aStream.Position;
5146     aStream.Read({%H-}Temp[0], 2);
5147     aStream.Position := StreamPos;
5148
5149     // if Bitmap then read file.
5150     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5151       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5152       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5153
5154       // error managment
5155       jpeg.err := jpeg_std_error(@jpeg_err);
5156       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5157       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5158
5159       // decompression struct
5160       jpeg_create_decompress(@jpeg);
5161
5162       // allocation space for streaming methods
5163       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5164
5165       // seeting up custom functions
5166       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5167         pub.init_source       := glBitmap_libJPEG_init_source;
5168         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5169         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5170         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5171         pub.term_source       := glBitmap_libJPEG_term_source;
5172
5173         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5174         pub.next_input_byte := nil;   // until buffer loaded
5175
5176         SrcStream := aStream;
5177       end;
5178
5179       // set global decoding state
5180       jpeg.global_state := DSTATE_START;
5181
5182       // read header of jpeg
5183       jpeg_read_header(@jpeg, false);
5184
5185       // setting output parameter
5186       case jpeg.jpeg_color_space of
5187         JCS_GRAYSCALE:
5188           begin
5189             jpeg.out_color_space := JCS_GRAYSCALE;
5190             IntFormat := tfLuminance8ub1;
5191           end;
5192         else
5193           jpeg.out_color_space := JCS_RGB;
5194           IntFormat := tfRGB8ub3;
5195       end;
5196
5197       // reading image
5198       jpeg_start_decompress(@jpeg);
5199
5200       TempHeight := jpeg.output_height;
5201       TempWidth := jpeg.output_width;
5202
5203       FormatDesc := TFormatDescriptor.Get(IntFormat);
5204
5205       // creating new image
5206       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5207       try
5208         pTemp := pImage;
5209
5210         for Row := 0 to TempHeight -1 do begin
5211           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5212           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5213         end;
5214
5215         // finish decompression
5216         jpeg_finish_decompress(@jpeg);
5217
5218         // destroy decompression
5219         jpeg_destroy_decompress(@jpeg);
5220
5221         SetData(pImage, IntFormat, TempWidth, TempHeight);
5222
5223         result := true;
5224       except
5225         if Assigned(pImage) then
5226           FreeMem(pImage);
5227         raise;
5228       end;
5229     end;
5230   finally
5231     quit_libJPEG;
5232   end;
5233 end;
5234
5235 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5237 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5238 var
5239   bmp: TBitmap;
5240   jpg: TJPEGImage;
5241   StreamPos: Int64;
5242   Temp: array[0..1]of Byte;
5243 begin
5244   result := false;
5245
5246   // reading first two bytes to test file and set cursor back to begin
5247   StreamPos := aStream.Position;
5248   aStream.Read(Temp[0], 2);
5249   aStream.Position := StreamPos;
5250
5251   // if Bitmap then read file.
5252   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5253     bmp := TBitmap.Create;
5254     try
5255       jpg := TJPEGImage.Create;
5256       try
5257         jpg.LoadFromStream(aStream);
5258         bmp.Assign(jpg);
5259         result := AssignFromBitmap(bmp);
5260       finally
5261         jpg.Free;
5262       end;
5263     finally
5264       bmp.Free;
5265     end;
5266   end;
5267 end;
5268 {$IFEND}
5269 {$ENDIF}
5270
5271 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5272 {$IF DEFINED(GLB_LAZ_JPEG)}
5273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5274 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5275 var
5276   jpeg: TJPEGImage;
5277   intf: TLazIntfImage;
5278   raw: TRawImage;
5279 begin
5280   jpeg := TJPEGImage.Create;
5281   intf := TLazIntfImage.Create(0, 0);
5282   try
5283     if not AssignToLazIntfImage(intf) then
5284       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5285     intf.GetRawImage(raw);
5286     jpeg.LoadFromRawImage(raw, false);
5287     jpeg.SaveToStream(aStream);
5288   finally
5289     intf.Free;
5290     jpeg.Free;
5291   end;
5292 end;
5293
5294 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5295 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5296 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5297 var
5298   jpeg: jpeg_compress_struct;
5299   jpeg_err: jpeg_error_mgr;
5300   Row: Integer;
5301   pTemp, pTemp2: pByte;
5302
5303   procedure CopyRow(pDest, pSource: pByte);
5304   var
5305     X: Integer;
5306   begin
5307     for X := 0 to Width - 1 do begin
5308       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5309       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5310       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5311       Inc(pDest, 3);
5312       Inc(pSource, 3);
5313     end;
5314   end;
5315
5316 begin
5317   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5318     raise EglBitmapUnsupportedFormat.Create(Format);
5319
5320   if not init_libJPEG then
5321     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5322
5323   try
5324     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5325     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5326
5327     // error managment
5328     jpeg.err := jpeg_std_error(@jpeg_err);
5329     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5330     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5331
5332     // compression struct
5333     jpeg_create_compress(@jpeg);
5334
5335     // allocation space for streaming methods
5336     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5337
5338     // seeting up custom functions
5339     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5340       pub.init_destination    := glBitmap_libJPEG_init_destination;
5341       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5342       pub.term_destination    := glBitmap_libJPEG_term_destination;
5343
5344       pub.next_output_byte  := @DestBuffer[1];
5345       pub.free_in_buffer    := Length(DestBuffer);
5346
5347       DestStream := aStream;
5348     end;
5349
5350     // very important state
5351     jpeg.global_state := CSTATE_START;
5352     jpeg.image_width  := Width;
5353     jpeg.image_height := Height;
5354     case Format of
5355       tfAlpha8ub1, tfLuminance8ub1: begin
5356         jpeg.input_components := 1;
5357         jpeg.in_color_space   := JCS_GRAYSCALE;
5358       end;
5359       tfRGB8ub3, tfBGR8ub3: begin
5360         jpeg.input_components := 3;
5361         jpeg.in_color_space   := JCS_RGB;
5362       end;
5363     end;
5364
5365     jpeg_set_defaults(@jpeg);
5366     jpeg_set_quality(@jpeg, 95, true);
5367     jpeg_start_compress(@jpeg, true);
5368     pTemp := Data;
5369
5370     if Format = tfBGR8ub3 then
5371       GetMem(pTemp2, fRowSize)
5372     else
5373       pTemp2 := pTemp;
5374
5375     try
5376       for Row := 0 to jpeg.image_height -1 do begin
5377         // prepare row
5378         if Format = tfBGR8ub3 then
5379           CopyRow(pTemp2, pTemp)
5380         else
5381           pTemp2 := pTemp;
5382
5383         // write row
5384         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5385         inc(pTemp, fRowSize);
5386       end;
5387     finally
5388       // free memory
5389       if Format = tfBGR8ub3 then
5390         FreeMem(pTemp2);
5391     end;
5392     jpeg_finish_compress(@jpeg);
5393     jpeg_destroy_compress(@jpeg);
5394   finally
5395     quit_libJPEG;
5396   end;
5397 end;
5398
5399 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5401 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5402 var
5403   Bmp: TBitmap;
5404   Jpg: TJPEGImage;
5405 begin
5406   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5407     raise EglBitmapUnsupportedFormat.Create(Format);
5408
5409   Bmp := TBitmap.Create;
5410   try
5411     Jpg := TJPEGImage.Create;
5412     try
5413       AssignToBitmap(Bmp);
5414       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5415         Jpg.Grayscale   := true;
5416         Jpg.PixelFormat := jf8Bit;
5417       end;
5418       Jpg.Assign(Bmp);
5419       Jpg.SaveToStream(aStream);
5420     finally
5421       FreeAndNil(Jpg);
5422     end;
5423   finally
5424     FreeAndNil(Bmp);
5425   end;
5426 end;
5427 {$IFEND}
5428 {$ENDIF}
5429
5430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5431 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5433 type
5434   RawHeader = packed record
5435     Magic:        String[5];
5436     Version:      Byte;
5437     Width:        Integer;
5438     Height:       Integer;
5439     DataSize:     Integer;
5440     BitsPerPixel: Integer;
5441     Precision:    TglBitmapRec4ub;
5442     Shift:        TglBitmapRec4ub;
5443   end;
5444
5445 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5446 var
5447   header: RawHeader;
5448   StartPos: Int64;
5449   fd: TFormatDescriptor;
5450   buf: PByte;
5451 begin
5452   result := false;
5453   StartPos := aStream.Position;
5454   aStream.Read(header{%H-}, SizeOf(header));
5455   if (header.Magic <> 'glBMP') then begin
5456     aStream.Position := StartPos;
5457     exit;
5458   end;
5459
5460   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5461   if (fd.Format = tfEmpty) then
5462     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5463
5464   buf := GetMemory(header.DataSize);
5465   aStream.Read(buf^, header.DataSize);
5466   SetData(buf, fd.Format, header.Width, header.Height);
5467
5468   result := true;
5469 end;
5470
5471 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5472 var
5473   header: RawHeader;
5474   fd: TFormatDescriptor;
5475 begin
5476   fd := TFormatDescriptor.Get(Format);
5477   header.Magic        := 'glBMP';
5478   header.Version      := 1;
5479   header.Width        := Width;
5480   header.Height       := Height;
5481   header.DataSize     := fd.GetSize(fDimension);
5482   header.BitsPerPixel := fd.BitsPerPixel;
5483   header.Precision    := fd.Precision;
5484   header.Shift        := fd.Shift;
5485   aStream.Write(header, SizeOf(header));
5486   aStream.Write(Data^,  header.DataSize);
5487 end;
5488
5489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5490 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5492 const
5493   BMP_MAGIC          = $4D42;
5494
5495   BMP_COMP_RGB       = 0;
5496   BMP_COMP_RLE8      = 1;
5497   BMP_COMP_RLE4      = 2;
5498   BMP_COMP_BITFIELDS = 3;
5499
5500 type
5501   TBMPHeader = packed record
5502     bfType: Word;
5503     bfSize: Cardinal;
5504     bfReserved1: Word;
5505     bfReserved2: Word;
5506     bfOffBits: Cardinal;
5507   end;
5508
5509   TBMPInfo = packed record
5510     biSize: Cardinal;
5511     biWidth: Longint;
5512     biHeight: Longint;
5513     biPlanes: Word;
5514     biBitCount: Word;
5515     biCompression: Cardinal;
5516     biSizeImage: Cardinal;
5517     biXPelsPerMeter: Longint;
5518     biYPelsPerMeter: Longint;
5519     biClrUsed: Cardinal;
5520     biClrImportant: Cardinal;
5521   end;
5522
5523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5524 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5525
5526   //////////////////////////////////////////////////////////////////////////////////////////////////
5527   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5528   var
5529     tmp, i: Cardinal;
5530   begin
5531     result := tfEmpty;
5532     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5533     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5534
5535     //Read Compression
5536     case aInfo.biCompression of
5537       BMP_COMP_RLE4,
5538       BMP_COMP_RLE8: begin
5539         raise EglBitmap.Create('RLE compression is not supported');
5540       end;
5541       BMP_COMP_BITFIELDS: begin
5542         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5543           for i := 0 to 2 do begin
5544             aStream.Read(tmp{%H-}, SizeOf(tmp));
5545             aMask.arr[i] := tmp;
5546           end;
5547         end else
5548           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5549       end;
5550     end;
5551
5552     //get suitable format
5553     case aInfo.biBitCount of
5554        8: result := tfLuminance8ub1;
5555       16: result := tfX1RGB5us1;
5556       24: result := tfBGR8ub3;
5557       32: result := tfXRGB8ui1;
5558     end;
5559   end;
5560
5561   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5562   var
5563     i, c: Integer;
5564     fd: TFormatDescriptor;
5565     ColorTable: TbmpColorTable;
5566   begin
5567     result := nil;
5568     if (aInfo.biBitCount >= 16) then
5569       exit;
5570     aFormat := tfLuminance8ub1;
5571     c := aInfo.biClrUsed;
5572     if (c = 0) then
5573       c := 1 shl aInfo.biBitCount;
5574     SetLength(ColorTable, c);
5575     for i := 0 to c-1 do begin
5576       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5577       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5578         aFormat := tfRGB8ub3;
5579     end;
5580
5581     fd := TFormatDescriptor.Get(aFormat);
5582     result := TbmpColorTableFormat.Create;
5583     result.ColorTable   := ColorTable;
5584     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5585   end;
5586
5587   //////////////////////////////////////////////////////////////////////////////////////////////////
5588   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5589   var
5590     fd: TFormatDescriptor;
5591   begin
5592     result := nil;
5593     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5594
5595       // find suitable format ...
5596       fd := TFormatDescriptor.GetFromMask(aMask);
5597       if (fd.Format <> tfEmpty) then begin
5598         aFormat := fd.Format;
5599         exit;
5600       end;
5601
5602       // or create custom bitfield format
5603       result := TbmpBitfieldFormat.Create;
5604       result.SetCustomValues(aInfo.biBitCount, aMask);
5605     end;
5606   end;
5607
5608 var
5609   //simple types
5610   StartPos: Int64;
5611   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5612   PaddingBuff: Cardinal;
5613   LineBuf, ImageData, TmpData: PByte;
5614   SourceMD, DestMD: Pointer;
5615   BmpFormat: TglBitmapFormat;
5616
5617   //records
5618   Mask: TglBitmapRec4ul;
5619   Header: TBMPHeader;
5620   Info: TBMPInfo;
5621
5622   //classes
5623   SpecialFormat: TFormatDescriptor;
5624   FormatDesc: TFormatDescriptor;
5625
5626   //////////////////////////////////////////////////////////////////////////////////////////////////
5627   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5628   var
5629     i: Integer;
5630     Pixel: TglBitmapPixelData;
5631   begin
5632     aStream.Read(aLineBuf^, rbLineSize);
5633     SpecialFormat.PreparePixel(Pixel);
5634     for i := 0 to Info.biWidth-1 do begin
5635       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5636       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5637       FormatDesc.Map(Pixel, aData, DestMD);
5638     end;
5639   end;
5640
5641 begin
5642   result        := false;
5643   BmpFormat     := tfEmpty;
5644   SpecialFormat := nil;
5645   LineBuf       := nil;
5646   SourceMD      := nil;
5647   DestMD        := nil;
5648
5649   // Header
5650   StartPos := aStream.Position;
5651   aStream.Read(Header{%H-}, SizeOf(Header));
5652
5653   if Header.bfType = BMP_MAGIC then begin
5654     try try
5655       BmpFormat        := ReadInfo(Info, Mask);
5656       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5657       if not Assigned(SpecialFormat) then
5658         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5659       aStream.Position := StartPos + Header.bfOffBits;
5660
5661       if (BmpFormat <> tfEmpty) then begin
5662         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5663         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5664         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5665         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5666
5667         //get Memory
5668         DestMD    := FormatDesc.CreateMappingData;
5669         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5670         GetMem(ImageData, ImageSize);
5671         if Assigned(SpecialFormat) then begin
5672           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5673           SourceMD := SpecialFormat.CreateMappingData;
5674         end;
5675
5676         //read Data
5677         try try
5678           FillChar(ImageData^, ImageSize, $FF);
5679           TmpData := ImageData;
5680           if (Info.biHeight > 0) then
5681             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5682           for i := 0 to Abs(Info.biHeight)-1 do begin
5683             if Assigned(SpecialFormat) then
5684               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5685             else
5686               aStream.Read(TmpData^, wbLineSize);   //else only read data
5687             if (Info.biHeight > 0) then
5688               dec(TmpData, wbLineSize)
5689             else
5690               inc(TmpData, wbLineSize);
5691             aStream.Read(PaddingBuff{%H-}, Padding);
5692           end;
5693           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5694           result := true;
5695         finally
5696           if Assigned(LineBuf) then
5697             FreeMem(LineBuf);
5698           if Assigned(SourceMD) then
5699             SpecialFormat.FreeMappingData(SourceMD);
5700           FormatDesc.FreeMappingData(DestMD);
5701         end;
5702         except
5703           if Assigned(ImageData) then
5704             FreeMem(ImageData);
5705           raise;
5706         end;
5707       end else
5708         raise EglBitmap.Create('LoadBMP - No suitable format found');
5709     except
5710       aStream.Position := StartPos;
5711       raise;
5712     end;
5713     finally
5714       FreeAndNil(SpecialFormat);
5715     end;
5716   end
5717     else aStream.Position := StartPos;
5718 end;
5719
5720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5721 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5722 var
5723   Header: TBMPHeader;
5724   Info: TBMPInfo;
5725   Converter: TFormatDescriptor;
5726   FormatDesc: TFormatDescriptor;
5727   SourceFD, DestFD: Pointer;
5728   pData, srcData, dstData, ConvertBuffer: pByte;
5729
5730   Pixel: TglBitmapPixelData;
5731   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5732   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5733
5734   PaddingBuff: Cardinal;
5735
5736   function GetLineWidth : Integer;
5737   begin
5738     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5739   end;
5740
5741 begin
5742   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5743     raise EglBitmapUnsupportedFormat.Create(Format);
5744
5745   Converter  := nil;
5746   FormatDesc := TFormatDescriptor.Get(Format);
5747   ImageSize  := FormatDesc.GetSize(Dimension);
5748
5749   FillChar(Header{%H-}, SizeOf(Header), 0);
5750   Header.bfType      := BMP_MAGIC;
5751   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5752   Header.bfReserved1 := 0;
5753   Header.bfReserved2 := 0;
5754   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5755
5756   FillChar(Info{%H-}, SizeOf(Info), 0);
5757   Info.biSize        := SizeOf(Info);
5758   Info.biWidth       := Width;
5759   Info.biHeight      := Height;
5760   Info.biPlanes      := 1;
5761   Info.biCompression := BMP_COMP_RGB;
5762   Info.biSizeImage   := ImageSize;
5763
5764   try
5765     case Format of
5766       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5767       begin
5768         Info.biBitCount  :=  8;
5769         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5770         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5771         Converter := TbmpColorTableFormat.Create;
5772         with (Converter as TbmpColorTableFormat) do begin
5773           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5774           CreateColorTable;
5775         end;
5776       end;
5777
5778       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5779       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5780       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5781       begin
5782         Info.biBitCount    := 16;
5783         Info.biCompression := BMP_COMP_BITFIELDS;
5784       end;
5785
5786       tfBGR8ub3, tfRGB8ub3:
5787       begin
5788         Info.biBitCount := 24;
5789         if (Format = tfRGB8ub3) then
5790           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5791       end;
5792
5793       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5794       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5795       begin
5796         Info.biBitCount    := 32;
5797         Info.biCompression := BMP_COMP_BITFIELDS;
5798       end;
5799     else
5800       raise EglBitmapUnsupportedFormat.Create(Format);
5801     end;
5802     Info.biXPelsPerMeter := 2835;
5803     Info.biYPelsPerMeter := 2835;
5804
5805     // prepare bitmasks
5806     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5807       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5808       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5809
5810       RedMask    := FormatDesc.Mask.r;
5811       GreenMask  := FormatDesc.Mask.g;
5812       BlueMask   := FormatDesc.Mask.b;
5813       AlphaMask  := FormatDesc.Mask.a;
5814     end;
5815
5816     // headers
5817     aStream.Write(Header, SizeOf(Header));
5818     aStream.Write(Info, SizeOf(Info));
5819
5820     // colortable
5821     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5822       with (Converter as TbmpColorTableFormat) do
5823         aStream.Write(ColorTable[0].b,
5824           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5825
5826     // bitmasks
5827     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5828       aStream.Write(RedMask,   SizeOf(Cardinal));
5829       aStream.Write(GreenMask, SizeOf(Cardinal));
5830       aStream.Write(BlueMask,  SizeOf(Cardinal));
5831       aStream.Write(AlphaMask, SizeOf(Cardinal));
5832     end;
5833
5834     // image data
5835     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5836     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5837     Padding     := GetLineWidth - wbLineSize;
5838     PaddingBuff := 0;
5839
5840     pData := Data;
5841     inc(pData, (Height-1) * rbLineSize);
5842
5843     // prepare row buffer. But only for RGB because RGBA supports color masks
5844     // so it's possible to change color within the image.
5845     if Assigned(Converter) then begin
5846       FormatDesc.PreparePixel(Pixel);
5847       GetMem(ConvertBuffer, wbLineSize);
5848       SourceFD := FormatDesc.CreateMappingData;
5849       DestFD   := Converter.CreateMappingData;
5850     end else
5851       ConvertBuffer := nil;
5852
5853     try
5854       for LineIdx := 0 to Height - 1 do begin
5855         // preparing row
5856         if Assigned(Converter) then begin
5857           srcData := pData;
5858           dstData := ConvertBuffer;
5859           for PixelIdx := 0 to Info.biWidth-1 do begin
5860             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5861             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5862             Converter.Map(Pixel, dstData, DestFD);
5863           end;
5864           aStream.Write(ConvertBuffer^, wbLineSize);
5865         end else begin
5866           aStream.Write(pData^, rbLineSize);
5867         end;
5868         dec(pData, rbLineSize);
5869         if (Padding > 0) then
5870           aStream.Write(PaddingBuff, Padding);
5871       end;
5872     finally
5873       // destroy row buffer
5874       if Assigned(ConvertBuffer) then begin
5875         FormatDesc.FreeMappingData(SourceFD);
5876         Converter.FreeMappingData(DestFD);
5877         FreeMem(ConvertBuffer);
5878       end;
5879     end;
5880   finally
5881     if Assigned(Converter) then
5882       Converter.Free;
5883   end;
5884 end;
5885
5886 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5887 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5888 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5889 type
5890   TTGAHeader = packed record
5891     ImageID: Byte;
5892     ColorMapType: Byte;
5893     ImageType: Byte;
5894     //ColorMapSpec: Array[0..4] of Byte;
5895     ColorMapStart: Word;
5896     ColorMapLength: Word;
5897     ColorMapEntrySize: Byte;
5898     OrigX: Word;
5899     OrigY: Word;
5900     Width: Word;
5901     Height: Word;
5902     Bpp: Byte;
5903     ImageDesc: Byte;
5904   end;
5905
5906 const
5907   TGA_UNCOMPRESSED_RGB  =  2;
5908   TGA_UNCOMPRESSED_GRAY =  3;
5909   TGA_COMPRESSED_RGB    = 10;
5910   TGA_COMPRESSED_GRAY   = 11;
5911
5912   TGA_NONE_COLOR_TABLE  = 0;
5913
5914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5915 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5916 var
5917   Header: TTGAHeader;
5918   ImageData: System.PByte;
5919   StartPosition: Int64;
5920   PixelSize, LineSize: Integer;
5921   tgaFormat: TglBitmapFormat;
5922   FormatDesc: TFormatDescriptor;
5923   Counter: packed record
5924     X, Y: packed record
5925       low, high, dir: Integer;
5926     end;
5927   end;
5928
5929 const
5930   CACHE_SIZE = $4000;
5931
5932   ////////////////////////////////////////////////////////////////////////////////////////
5933   procedure ReadUncompressed;
5934   var
5935     i, j: Integer;
5936     buf, tmp1, tmp2: System.PByte;
5937   begin
5938     buf := nil;
5939     if (Counter.X.dir < 0) then
5940       GetMem(buf, LineSize);
5941     try
5942       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5943         tmp1 := ImageData;
5944         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5945         if (Counter.X.dir < 0) then begin               //flip X
5946           aStream.Read(buf^, LineSize);
5947           tmp2 := buf;
5948           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5949           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5950             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5951               tmp1^ := tmp2^;
5952               inc(tmp1);
5953               inc(tmp2);
5954             end;
5955             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5956           end;
5957         end else
5958           aStream.Read(tmp1^, LineSize);
5959         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5960       end;
5961     finally
5962       if Assigned(buf) then
5963         FreeMem(buf);
5964     end;
5965   end;
5966
5967   ////////////////////////////////////////////////////////////////////////////////////////
5968   procedure ReadCompressed;
5969
5970     /////////////////////////////////////////////////////////////////
5971     var
5972       TmpData: System.PByte;
5973       LinePixelsRead: Integer;
5974     procedure CheckLine;
5975     begin
5976       if (LinePixelsRead >= Header.Width) then begin
5977         LinePixelsRead := 0;
5978         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5979         TmpData := ImageData;
5980         inc(TmpData, Counter.Y.low * LineSize);           //set line
5981         if (Counter.X.dir < 0) then                       //if x flipped then
5982           inc(TmpData, LineSize - PixelSize);             //set last pixel
5983       end;
5984     end;
5985
5986     /////////////////////////////////////////////////////////////////
5987     var
5988       Cache: PByte;
5989       CacheSize, CachePos: Integer;
5990     procedure CachedRead(out Buffer; Count: Integer);
5991     var
5992       BytesRead: Integer;
5993     begin
5994       if (CachePos + Count > CacheSize) then begin
5995         //if buffer overflow save non read bytes
5996         BytesRead := 0;
5997         if (CacheSize - CachePos > 0) then begin
5998           BytesRead := CacheSize - CachePos;
5999           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6000           inc(CachePos, BytesRead);
6001         end;
6002
6003         //load cache from file
6004         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6005         aStream.Read(Cache^, CacheSize);
6006         CachePos := 0;
6007
6008         //read rest of requested bytes
6009         if (Count - BytesRead > 0) then begin
6010           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6011           inc(CachePos, Count - BytesRead);
6012         end;
6013       end else begin
6014         //if no buffer overflow just read the data
6015         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6016         inc(CachePos, Count);
6017       end;
6018     end;
6019
6020     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6021     begin
6022       case PixelSize of
6023         1: begin
6024           aBuffer^ := aData^;
6025           inc(aBuffer, Counter.X.dir);
6026         end;
6027         2: begin
6028           PWord(aBuffer)^ := PWord(aData)^;
6029           inc(aBuffer, 2 * Counter.X.dir);
6030         end;
6031         3: begin
6032           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6033           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6034           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6035           inc(aBuffer, 3 * Counter.X.dir);
6036         end;
6037         4: begin
6038           PCardinal(aBuffer)^ := PCardinal(aData)^;
6039           inc(aBuffer, 4 * Counter.X.dir);
6040         end;
6041       end;
6042     end;
6043
6044   var
6045     TotalPixelsToRead, TotalPixelsRead: Integer;
6046     Temp: Byte;
6047     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6048     PixelRepeat: Boolean;
6049     PixelsToRead, PixelCount: Integer;
6050   begin
6051     CacheSize := 0;
6052     CachePos  := 0;
6053
6054     TotalPixelsToRead := Header.Width * Header.Height;
6055     TotalPixelsRead   := 0;
6056     LinePixelsRead    := 0;
6057
6058     GetMem(Cache, CACHE_SIZE);
6059     try
6060       TmpData := ImageData;
6061       inc(TmpData, Counter.Y.low * LineSize);           //set line
6062       if (Counter.X.dir < 0) then                       //if x flipped then
6063         inc(TmpData, LineSize - PixelSize);             //set last pixel
6064
6065       repeat
6066         //read CommandByte
6067         CachedRead(Temp, 1);
6068         PixelRepeat  := (Temp and $80) > 0;
6069         PixelsToRead := (Temp and $7F) + 1;
6070         inc(TotalPixelsRead, PixelsToRead);
6071
6072         if PixelRepeat then
6073           CachedRead(buf[0], PixelSize);
6074         while (PixelsToRead > 0) do begin
6075           CheckLine;
6076           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6077           while (PixelCount > 0) do begin
6078             if not PixelRepeat then
6079               CachedRead(buf[0], PixelSize);
6080             PixelToBuffer(@buf[0], TmpData);
6081             inc(LinePixelsRead);
6082             dec(PixelsToRead);
6083             dec(PixelCount);
6084           end;
6085         end;
6086       until (TotalPixelsRead >= TotalPixelsToRead);
6087     finally
6088       FreeMem(Cache);
6089     end;
6090   end;
6091
6092   function IsGrayFormat: Boolean;
6093   begin
6094     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6095   end;
6096
6097 begin
6098   result := false;
6099
6100   // reading header to test file and set cursor back to begin
6101   StartPosition := aStream.Position;
6102   aStream.Read(Header{%H-}, SizeOf(Header));
6103
6104   // no colormapped files
6105   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6106     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6107   begin
6108     try
6109       if Header.ImageID <> 0 then       // skip image ID
6110         aStream.Position := aStream.Position + Header.ImageID;
6111
6112       tgaFormat := tfEmpty;
6113       case Header.Bpp of
6114          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6115                0: tgaFormat := tfLuminance8ub1;
6116                8: tgaFormat := tfAlpha8ub1;
6117             end;
6118
6119         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6120                0: tgaFormat := tfLuminance16us1;
6121                8: tgaFormat := tfLuminance8Alpha8ub2;
6122             end else case (Header.ImageDesc and $F) of
6123                0: tgaFormat := tfX1RGB5us1;
6124                1: tgaFormat := tfA1RGB5us1;
6125                4: tgaFormat := tfARGB4us1;
6126             end;
6127
6128         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6129                0: tgaFormat := tfBGR8ub3;
6130             end;
6131
6132         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6133                0: tgaFormat := tfDepth32ui1;
6134             end else case (Header.ImageDesc and $F) of
6135                0: tgaFormat := tfX2RGB10ui1;
6136                2: tgaFormat := tfA2RGB10ui1;
6137                8: tgaFormat := tfARGB8ui1;
6138             end;
6139       end;
6140
6141       if (tgaFormat = tfEmpty) then
6142         raise EglBitmap.Create('LoadTga - unsupported format');
6143
6144       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6145       PixelSize  := FormatDesc.GetSize(1, 1);
6146       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6147
6148       GetMem(ImageData, LineSize * Header.Height);
6149       try
6150         //column direction
6151         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6152           Counter.X.low  := Header.Height-1;;
6153           Counter.X.high := 0;
6154           Counter.X.dir  := -1;
6155         end else begin
6156           Counter.X.low  := 0;
6157           Counter.X.high := Header.Height-1;
6158           Counter.X.dir  := 1;
6159         end;
6160
6161         // Row direction
6162         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6163           Counter.Y.low  := 0;
6164           Counter.Y.high := Header.Height-1;
6165           Counter.Y.dir  := 1;
6166         end else begin
6167           Counter.Y.low  := Header.Height-1;;
6168           Counter.Y.high := 0;
6169           Counter.Y.dir  := -1;
6170         end;
6171
6172         // Read Image
6173         case Header.ImageType of
6174           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6175             ReadUncompressed;
6176           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6177             ReadCompressed;
6178         end;
6179
6180         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6181         result := true;
6182       except
6183         if Assigned(ImageData) then
6184           FreeMem(ImageData);
6185         raise;
6186       end;
6187     finally
6188       aStream.Position := StartPosition;
6189     end;
6190   end
6191     else aStream.Position := StartPosition;
6192 end;
6193
6194 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6195 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6196 var
6197   Header: TTGAHeader;
6198   Size: Integer;
6199   FormatDesc: TFormatDescriptor;
6200 begin
6201   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6202     raise EglBitmapUnsupportedFormat.Create(Format);
6203
6204   //prepare header
6205   FormatDesc := TFormatDescriptor.Get(Format);
6206   FillChar(Header{%H-}, SizeOf(Header), 0);
6207   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6208   Header.Bpp       := FormatDesc.BitsPerPixel;
6209   Header.Width     := Width;
6210   Header.Height    := Height;
6211   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6212   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6213     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6214   else
6215     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6216   aStream.Write(Header, SizeOf(Header));
6217
6218   // write Data
6219   Size := FormatDesc.GetSize(Dimension);
6220   aStream.Write(Data^, Size);
6221 end;
6222
6223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6224 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6226 const
6227   DDS_MAGIC: Cardinal         = $20534444;
6228
6229   // DDS_header.dwFlags
6230   DDSD_CAPS                   = $00000001;
6231   DDSD_HEIGHT                 = $00000002;
6232   DDSD_WIDTH                  = $00000004;
6233   DDSD_PIXELFORMAT            = $00001000;
6234
6235   // DDS_header.sPixelFormat.dwFlags
6236   DDPF_ALPHAPIXELS            = $00000001;
6237   DDPF_ALPHA                  = $00000002;
6238   DDPF_FOURCC                 = $00000004;
6239   DDPF_RGB                    = $00000040;
6240   DDPF_LUMINANCE              = $00020000;
6241
6242   // DDS_header.sCaps.dwCaps1
6243   DDSCAPS_TEXTURE             = $00001000;
6244
6245   // DDS_header.sCaps.dwCaps2
6246   DDSCAPS2_CUBEMAP            = $00000200;
6247
6248   D3DFMT_DXT1                 = $31545844;
6249   D3DFMT_DXT3                 = $33545844;
6250   D3DFMT_DXT5                 = $35545844;
6251
6252 type
6253   TDDSPixelFormat = packed record
6254     dwSize: Cardinal;
6255     dwFlags: Cardinal;
6256     dwFourCC: Cardinal;
6257     dwRGBBitCount: Cardinal;
6258     dwRBitMask: Cardinal;
6259     dwGBitMask: Cardinal;
6260     dwBBitMask: Cardinal;
6261     dwABitMask: Cardinal;
6262   end;
6263
6264   TDDSCaps = packed record
6265     dwCaps1: Cardinal;
6266     dwCaps2: Cardinal;
6267     dwDDSX: Cardinal;
6268     dwReserved: Cardinal;
6269   end;
6270
6271   TDDSHeader = packed record
6272     dwSize: Cardinal;
6273     dwFlags: Cardinal;
6274     dwHeight: Cardinal;
6275     dwWidth: Cardinal;
6276     dwPitchOrLinearSize: Cardinal;
6277     dwDepth: Cardinal;
6278     dwMipMapCount: Cardinal;
6279     dwReserved: array[0..10] of Cardinal;
6280     PixelFormat: TDDSPixelFormat;
6281     Caps: TDDSCaps;
6282     dwReserved2: Cardinal;
6283   end;
6284
6285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6286 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6287 var
6288   Header: TDDSHeader;
6289   Converter: TbmpBitfieldFormat;
6290
6291   function GetDDSFormat: TglBitmapFormat;
6292   var
6293     fd: TFormatDescriptor;
6294     i: Integer;
6295     Mask: TglBitmapRec4ul;
6296     Range: TglBitmapRec4ui;
6297     match: Boolean;
6298   begin
6299     result := tfEmpty;
6300     with Header.PixelFormat do begin
6301       // Compresses
6302       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6303         case Header.PixelFormat.dwFourCC of
6304           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6305           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6306           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6307         end;
6308       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6309         // prepare masks
6310         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6311           Mask.r := dwRBitMask;
6312           Mask.g := dwGBitMask;
6313           Mask.b := dwBBitMask;
6314         end else begin
6315           Mask.r := dwRBitMask;
6316           Mask.g := dwRBitMask;
6317           Mask.b := dwRBitMask;
6318         end;
6319         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6320           Mask.a := dwABitMask
6321         else
6322           Mask.a := 0;;
6323
6324         //find matching format
6325         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6326         result := fd.Format;
6327         if (result <> tfEmpty) then
6328           exit;
6329
6330         //find format with same Range
6331         for i := 0 to 3 do
6332           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6333         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6334           fd := TFormatDescriptor.Get(result);
6335           match := true;
6336           for i := 0 to 3 do
6337             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6338               match := false;
6339               break;
6340             end;
6341           if match then
6342             break;
6343         end;
6344
6345         //no format with same range found -> use default
6346         if (result = tfEmpty) then begin
6347           if (dwABitMask > 0) then
6348             result := tfRGBA8ui1
6349           else
6350             result := tfRGB8ub3;
6351         end;
6352
6353         Converter := TbmpBitfieldFormat.Create;
6354         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6355       end;
6356     end;
6357   end;
6358
6359 var
6360   StreamPos: Int64;
6361   x, y, LineSize, RowSize, Magic: Cardinal;
6362   NewImage, TmpData, RowData, SrcData: System.PByte;
6363   SourceMD, DestMD: Pointer;
6364   Pixel: TglBitmapPixelData;
6365   ddsFormat: TglBitmapFormat;
6366   FormatDesc: TFormatDescriptor;
6367
6368 begin
6369   result    := false;
6370   Converter := nil;
6371   StreamPos := aStream.Position;
6372
6373   // Magic
6374   aStream.Read(Magic{%H-}, sizeof(Magic));
6375   if (Magic <> DDS_MAGIC) then begin
6376     aStream.Position := StreamPos;
6377     exit;
6378   end;
6379
6380   //Header
6381   aStream.Read(Header{%H-}, sizeof(Header));
6382   if (Header.dwSize <> SizeOf(Header)) or
6383      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6384         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6385   begin
6386     aStream.Position := StreamPos;
6387     exit;
6388   end;
6389
6390   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6391     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6392
6393   ddsFormat := GetDDSFormat;
6394   try
6395     if (ddsFormat = tfEmpty) then
6396       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6397
6398     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6399     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6400     GetMem(NewImage, Header.dwHeight * LineSize);
6401     try
6402       TmpData := NewImage;
6403
6404       //Converter needed
6405       if Assigned(Converter) then begin
6406         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6407         GetMem(RowData, RowSize);
6408         SourceMD := Converter.CreateMappingData;
6409         DestMD   := FormatDesc.CreateMappingData;
6410         try
6411           for y := 0 to Header.dwHeight-1 do begin
6412             TmpData := NewImage;
6413             inc(TmpData, y * LineSize);
6414             SrcData := RowData;
6415             aStream.Read(SrcData^, RowSize);
6416             for x := 0 to Header.dwWidth-1 do begin
6417               Converter.Unmap(SrcData, Pixel, SourceMD);
6418               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6419               FormatDesc.Map(Pixel, TmpData, DestMD);
6420             end;
6421           end;
6422         finally
6423           Converter.FreeMappingData(SourceMD);
6424           FormatDesc.FreeMappingData(DestMD);
6425           FreeMem(RowData);
6426         end;
6427       end else
6428
6429       // Compressed
6430       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6431         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6432         for Y := 0 to Header.dwHeight-1 do begin
6433           aStream.Read(TmpData^, RowSize);
6434           Inc(TmpData, LineSize);
6435         end;
6436       end else
6437
6438       // Uncompressed
6439       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6440         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6441         for Y := 0 to Header.dwHeight-1 do begin
6442           aStream.Read(TmpData^, RowSize);
6443           Inc(TmpData, LineSize);
6444         end;
6445       end else
6446         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6447
6448       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6449       result := true;
6450     except
6451       if Assigned(NewImage) then
6452         FreeMem(NewImage);
6453       raise;
6454     end;
6455   finally
6456     FreeAndNil(Converter);
6457   end;
6458 end;
6459
6460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6461 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6462 var
6463   Header: TDDSHeader;
6464   FormatDesc: TFormatDescriptor;
6465 begin
6466   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6467     raise EglBitmapUnsupportedFormat.Create(Format);
6468
6469   FormatDesc := TFormatDescriptor.Get(Format);
6470
6471   // Generell
6472   FillChar(Header{%H-}, SizeOf(Header), 0);
6473   Header.dwSize  := SizeOf(Header);
6474   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6475
6476   Header.dwWidth  := Max(1, Width);
6477   Header.dwHeight := Max(1, Height);
6478
6479   // Caps
6480   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6481
6482   // Pixelformat
6483   Header.PixelFormat.dwSize := sizeof(Header);
6484   if (FormatDesc.IsCompressed) then begin
6485     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6486     case Format of
6487       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6488       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6489       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6490     end;
6491   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6492     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6493     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6494     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6495   end else if FormatDesc.IsGrayscale then begin
6496     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6497     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6498     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6499     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6500   end else begin
6501     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6502     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6503     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6504     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6505     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6506     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6507   end;
6508
6509   if (FormatDesc.HasAlpha) then
6510     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6511
6512   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6513   aStream.Write(Header, SizeOf(Header));
6514   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6515 end;
6516
6517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6518 function TglBitmapData.FlipHorz: Boolean;
6519 var
6520   fd: TglBitmapFormatDescriptor;
6521   Col, RowSize, PixelSize: Integer;
6522   pTempDest, pDest, pSource: PByte;
6523 begin
6524   result    := false;
6525   fd        := FormatDescriptor;
6526   PixelSize := Ceil(fd.BytesPerPixel);
6527   RowSize   := fd.GetSize(Width, 1);
6528   if Assigned(Data) and not fd.IsCompressed then begin
6529     pSource := Data;
6530     GetMem(pDest, RowSize);
6531     try
6532       pTempDest := pDest;
6533       Inc(pTempDest, RowSize);
6534       for Col := 0 to Width-1 do begin
6535         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6536         Move(pSource^, pTempDest^, PixelSize);
6537         Inc(pSource, PixelSize);
6538       end;
6539       SetData(pDest, Format, Width);
6540       result := true;
6541     except
6542       if Assigned(pDest) then
6543         FreeMem(pDest);
6544       raise;
6545     end;
6546   end;
6547 end;
6548
6549 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6550 function TglBitmapData.FlipVert: Boolean;
6551 var
6552   fd: TglBitmapFormatDescriptor;
6553   Row, RowSize, PixelSize: Integer;
6554   TempDestData, DestData, SourceData: PByte;
6555 begin
6556   result    := false;
6557   fd        := FormatDescriptor;
6558   PixelSize := Ceil(fd.BytesPerPixel);
6559   RowSize   := fd.GetSize(Width, 1);
6560   if Assigned(Data) then begin
6561     SourceData := Data;
6562     GetMem(DestData, Height * RowSize);
6563     try
6564       TempDestData := DestData;
6565       Inc(TempDestData, Width * (Height -1) * PixelSize);
6566       for Row := 0 to Height -1 do begin
6567         Move(SourceData^, TempDestData^, RowSize);
6568         Dec(TempDestData, RowSize);
6569         Inc(SourceData, RowSize);
6570       end;
6571       SetData(DestData, Format, Width, Height);
6572       result := true;
6573     except
6574       if Assigned(DestData) then
6575         FreeMem(DestData);
6576       raise;
6577     end;
6578   end;
6579 end;
6580
6581 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6582 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6583 var
6584   fs: TFileStream;
6585 begin
6586   if not FileExists(aFilename) then
6587     raise EglBitmap.Create('file does not exist: ' + aFilename);
6588   fs := TFileStream.Create(aFilename, fmOpenRead);
6589   try
6590     fs.Position := 0;
6591     LoadFromStream(fs);
6592     fFilename := aFilename;
6593   finally
6594     fs.Free;
6595   end;
6596 end;
6597
6598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6599 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6600 begin
6601   {$IFDEF GLB_SUPPORT_PNG_READ}
6602   if not LoadPNG(aStream) then
6603   {$ENDIF}
6604   {$IFDEF GLB_SUPPORT_JPEG_READ}
6605   if not LoadJPEG(aStream) then
6606   {$ENDIF}
6607   if not LoadDDS(aStream) then
6608   if not LoadTGA(aStream) then
6609   if not LoadBMP(aStream) then
6610   if not LoadRAW(aStream) then
6611     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6612 end;
6613
6614 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6615 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6616   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6617 var
6618   tmpData: PByte;
6619   size: Integer;
6620 begin
6621   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6622   GetMem(tmpData, size);
6623   try
6624     FillChar(tmpData^, size, #$FF);
6625     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6626   except
6627     if Assigned(tmpData) then
6628       FreeMem(tmpData);
6629     raise;
6630   end;
6631   Convert(Self, aFunc, false, aFormat, aArgs);
6632 end;
6633
6634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6635 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6636 var
6637   rs: TResourceStream;
6638 begin
6639   PrepareResType(aResource, aResType);
6640   rs := TResourceStream.Create(aInstance, aResource, aResType);
6641   try
6642     LoadFromStream(rs);
6643   finally
6644     rs.Free;
6645   end;
6646 end;
6647
6648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6649 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6650 var
6651   rs: TResourceStream;
6652 begin
6653   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6654   try
6655     LoadFromStream(rs);
6656   finally
6657     rs.Free;
6658   end;
6659 end;
6660
6661 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6662 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6663 var
6664   fs: TFileStream;
6665 begin
6666   fs := TFileStream.Create(aFileName, fmCreate);
6667   try
6668     fs.Position := 0;
6669     SaveToStream(fs, aFileType);
6670   finally
6671     fs.Free;
6672   end;
6673 end;
6674
6675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6676 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6677 begin
6678   case aFileType of
6679     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6680     ftPNG:  SavePNG(aStream);
6681     {$ENDIF}
6682     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6683     ftJPEG: SaveJPEG(aStream);
6684     {$ENDIF}
6685     ftDDS:  SaveDDS(aStream);
6686     ftTGA:  SaveTGA(aStream);
6687     ftBMP:  SaveBMP(aStream);
6688     ftRAW:  SaveRAW(aStream);
6689   end;
6690 end;
6691
6692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6693 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6694 begin
6695   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6696 end;
6697
6698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6699 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6700   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6701 var
6702   DestData, TmpData, SourceData: pByte;
6703   TempHeight, TempWidth: Integer;
6704   SourceFD, DestFD: TFormatDescriptor;
6705   SourceMD, DestMD: Pointer;
6706
6707   FuncRec: TglBitmapFunctionRec;
6708 begin
6709   Assert(Assigned(Data));
6710   Assert(Assigned(aSource));
6711   Assert(Assigned(aSource.Data));
6712
6713   result := false;
6714   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6715     SourceFD := TFormatDescriptor.Get(aSource.Format);
6716     DestFD   := TFormatDescriptor.Get(aFormat);
6717
6718     if (SourceFD.IsCompressed) then
6719       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6720     if (DestFD.IsCompressed) then
6721       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6722
6723     // inkompatible Formats so CreateTemp
6724     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6725       aCreateTemp := true;
6726
6727     // Values
6728     TempHeight := Max(1, aSource.Height);
6729     TempWidth  := Max(1, aSource.Width);
6730
6731     FuncRec.Sender := Self;
6732     FuncRec.Args   := aArgs;
6733
6734     TmpData := nil;
6735     if aCreateTemp then begin
6736       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6737       DestData := TmpData;
6738     end else
6739       DestData := Data;
6740
6741     try
6742       SourceFD.PreparePixel(FuncRec.Source);
6743       DestFD.PreparePixel  (FuncRec.Dest);
6744
6745       SourceMD := SourceFD.CreateMappingData;
6746       DestMD   := DestFD.CreateMappingData;
6747
6748       FuncRec.Size            := aSource.Dimension;
6749       FuncRec.Position.Fields := FuncRec.Size.Fields;
6750
6751       try
6752         SourceData := aSource.Data;
6753         FuncRec.Position.Y := 0;
6754         while FuncRec.Position.Y < TempHeight do begin
6755           FuncRec.Position.X := 0;
6756           while FuncRec.Position.X < TempWidth do begin
6757             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6758             aFunc(FuncRec);
6759             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6760             inc(FuncRec.Position.X);
6761           end;
6762           inc(FuncRec.Position.Y);
6763         end;
6764
6765         // Updating Image or InternalFormat
6766         if aCreateTemp then
6767           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6768         else if (aFormat <> fFormat) then
6769           Format := aFormat;
6770
6771         result := true;
6772       finally
6773         SourceFD.FreeMappingData(SourceMD);
6774         DestFD.FreeMappingData(DestMD);
6775       end;
6776     except
6777       if aCreateTemp and Assigned(TmpData) then
6778         FreeMem(TmpData);
6779       raise;
6780     end;
6781   end;
6782 end;
6783
6784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6785 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6786 var
6787   SourceFD, DestFD: TFormatDescriptor;
6788   SourcePD, DestPD: TglBitmapPixelData;
6789   ShiftData: TShiftData;
6790
6791   function DataIsIdentical: Boolean;
6792   begin
6793     result := SourceFD.MaskMatch(DestFD.Mask);
6794   end;
6795
6796   function CanCopyDirect: Boolean;
6797   begin
6798     result :=
6799       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6800       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6801       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6802       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6803   end;
6804
6805   function CanShift: Boolean;
6806   begin
6807     result :=
6808       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6809       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6810       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6811       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6812   end;
6813
6814   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6815   begin
6816     result := 0;
6817     while (aSource > aDest) and (aSource > 0) do begin
6818       inc(result);
6819       aSource := aSource shr 1;
6820     end;
6821   end;
6822
6823 begin
6824   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6825     SourceFD := TFormatDescriptor.Get(Format);
6826     DestFD   := TFormatDescriptor.Get(aFormat);
6827
6828     if DataIsIdentical then begin
6829       result := true;
6830       Format := aFormat;
6831       exit;
6832     end;
6833
6834     SourceFD.PreparePixel(SourcePD);
6835     DestFD.PreparePixel  (DestPD);
6836
6837     if CanCopyDirect then
6838       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6839     else if CanShift then begin
6840       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6841       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6842       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6843       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6844       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6845     end else
6846       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6847   end else
6848     result := true;
6849 end;
6850
6851 {$IFDEF GLB_SDL}
6852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6853 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6854 var
6855   Row, RowSize: Integer;
6856   SourceData, TmpData: PByte;
6857   TempDepth: Integer;
6858   FormatDesc: TFormatDescriptor;
6859
6860   function GetRowPointer(Row: Integer): pByte;
6861   begin
6862     result := aSurface.pixels;
6863     Inc(result, Row * RowSize);
6864   end;
6865
6866 begin
6867   result := false;
6868
6869   FormatDesc := TFormatDescriptor.Get(Format);
6870   if FormatDesc.IsCompressed then
6871     raise EglBitmapUnsupportedFormat.Create(Format);
6872
6873   if Assigned(Data) then begin
6874     case Trunc(FormatDesc.PixelSize) of
6875       1: TempDepth :=  8;
6876       2: TempDepth := 16;
6877       3: TempDepth := 24;
6878       4: TempDepth := 32;
6879     else
6880       raise EglBitmapUnsupportedFormat.Create(Format);
6881     end;
6882
6883     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6884       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6885     SourceData := Data;
6886     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6887
6888     for Row := 0 to FileHeight-1 do begin
6889       TmpData := GetRowPointer(Row);
6890       if Assigned(TmpData) then begin
6891         Move(SourceData^, TmpData^, RowSize);
6892         inc(SourceData, RowSize);
6893       end;
6894     end;
6895     result := true;
6896   end;
6897 end;
6898
6899 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6900 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6901 var
6902   pSource, pData, pTempData: PByte;
6903   Row, RowSize, TempWidth, TempHeight: Integer;
6904   IntFormat: TglBitmapFormat;
6905   fd: TFormatDescriptor;
6906   Mask: TglBitmapMask;
6907
6908   function GetRowPointer(Row: Integer): pByte;
6909   begin
6910     result := aSurface^.pixels;
6911     Inc(result, Row * RowSize);
6912   end;
6913
6914 begin
6915   result := false;
6916   if (Assigned(aSurface)) then begin
6917     with aSurface^.format^ do begin
6918       Mask.r := RMask;
6919       Mask.g := GMask;
6920       Mask.b := BMask;
6921       Mask.a := AMask;
6922       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6923       if (IntFormat = tfEmpty) then
6924         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6925     end;
6926
6927     fd := TFormatDescriptor.Get(IntFormat);
6928     TempWidth  := aSurface^.w;
6929     TempHeight := aSurface^.h;
6930     RowSize := fd.GetSize(TempWidth, 1);
6931     GetMem(pData, TempHeight * RowSize);
6932     try
6933       pTempData := pData;
6934       for Row := 0 to TempHeight -1 do begin
6935         pSource := GetRowPointer(Row);
6936         if (Assigned(pSource)) then begin
6937           Move(pSource^, pTempData^, RowSize);
6938           Inc(pTempData, RowSize);
6939         end;
6940       end;
6941       SetData(pData, IntFormat, TempWidth, TempHeight);
6942       result := true;
6943     except
6944       if Assigned(pData) then
6945         FreeMem(pData);
6946       raise;
6947     end;
6948   end;
6949 end;
6950
6951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6952 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6953 var
6954   Row, Col, AlphaInterleave: Integer;
6955   pSource, pDest: PByte;
6956
6957   function GetRowPointer(Row: Integer): pByte;
6958   begin
6959     result := aSurface.pixels;
6960     Inc(result, Row * Width);
6961   end;
6962
6963 begin
6964   result := false;
6965   if Assigned(Data) then begin
6966     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6967       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6968
6969       AlphaInterleave := 0;
6970       case Format of
6971         tfLuminance8Alpha8ub2:
6972           AlphaInterleave := 1;
6973         tfBGRA8ub4, tfRGBA8ub4:
6974           AlphaInterleave := 3;
6975       end;
6976
6977       pSource := Data;
6978       for Row := 0 to Height -1 do begin
6979         pDest := GetRowPointer(Row);
6980         if Assigned(pDest) then begin
6981           for Col := 0 to Width -1 do begin
6982             Inc(pSource, AlphaInterleave);
6983             pDest^ := pSource^;
6984             Inc(pDest);
6985             Inc(pSource);
6986           end;
6987         end;
6988       end;
6989       result := true;
6990     end;
6991   end;
6992 end;
6993
6994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6995 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6996 var
6997   bmp: TglBitmap2D;
6998 begin
6999   bmp := TglBitmap2D.Create;
7000   try
7001     bmp.AssignFromSurface(aSurface);
7002     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
7003   finally
7004     bmp.Free;
7005   end;
7006 end;
7007 {$ENDIF}
7008
7009 {$IFDEF GLB_DELPHI}
7010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7011 function CreateGrayPalette: HPALETTE;
7012 var
7013   Idx: Integer;
7014   Pal: PLogPalette;
7015 begin
7016   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
7017
7018   Pal.palVersion := $300;
7019   Pal.palNumEntries := 256;
7020
7021   for Idx := 0 to Pal.palNumEntries - 1 do begin
7022     Pal.palPalEntry[Idx].peRed   := Idx;
7023     Pal.palPalEntry[Idx].peGreen := Idx;
7024     Pal.palPalEntry[Idx].peBlue  := Idx;
7025     Pal.palPalEntry[Idx].peFlags := 0;
7026   end;
7027   Result := CreatePalette(Pal^);
7028   FreeMem(Pal);
7029 end;
7030
7031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7032 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7033 var
7034   Row, RowSize: Integer;
7035   pSource, pData: PByte;
7036 begin
7037   result := false;
7038   if Assigned(Data) then begin
7039     if Assigned(aBitmap) then begin
7040       aBitmap.Width  := Width;
7041       aBitmap.Height := Height;
7042
7043       case Format of
7044         tfAlpha8ub1, tfLuminance8ub1: begin
7045           aBitmap.PixelFormat := pf8bit;
7046           aBitmap.Palette     := CreateGrayPalette;
7047         end;
7048         tfRGB5A1us1:
7049           aBitmap.PixelFormat := pf15bit;
7050         tfR5G6B5us1:
7051           aBitmap.PixelFormat := pf16bit;
7052         tfRGB8ub3, tfBGR8ub3:
7053           aBitmap.PixelFormat := pf24bit;
7054         tfRGBA8ub4, tfBGRA8ub4:
7055           aBitmap.PixelFormat := pf32bit;
7056       else
7057         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7058       end;
7059
7060       RowSize := FormatDescriptor.GetSize(Width, 1);
7061       pSource := Data;
7062       for Row := 0 to Height-1 do begin
7063         pData := aBitmap.Scanline[Row];
7064         Move(pSource^, pData^, RowSize);
7065         Inc(pSource, RowSize);
7066         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7067           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7068       end;
7069       result := true;
7070     end;
7071   end;
7072 end;
7073
7074 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7075 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7076 var
7077   pSource, pData, pTempData: PByte;
7078   Row, RowSize, TempWidth, TempHeight: Integer;
7079   IntFormat: TglBitmapFormat;
7080 begin
7081   result := false;
7082
7083   if (Assigned(aBitmap)) then begin
7084     case aBitmap.PixelFormat of
7085       pf8bit:
7086         IntFormat := tfLuminance8ub1;
7087       pf15bit:
7088         IntFormat := tfRGB5A1us1;
7089       pf16bit:
7090         IntFormat := tfR5G6B5us1;
7091       pf24bit:
7092         IntFormat := tfBGR8ub3;
7093       pf32bit:
7094         IntFormat := tfBGRA8ub4;
7095     else
7096       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7097     end;
7098
7099     TempWidth  := aBitmap.Width;
7100     TempHeight := aBitmap.Height;
7101     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7102     GetMem(pData, TempHeight * RowSize);
7103     try
7104       pTempData := pData;
7105       for Row := 0 to TempHeight -1 do begin
7106         pSource := aBitmap.Scanline[Row];
7107         if (Assigned(pSource)) then begin
7108           Move(pSource^, pTempData^, RowSize);
7109           Inc(pTempData, RowSize);
7110         end;
7111       end;
7112       SetData(pData, IntFormat, TempWidth, TempHeight);
7113       result := true;
7114     except
7115       if Assigned(pData) then
7116         FreeMem(pData);
7117       raise;
7118     end;
7119   end;
7120 end;
7121
7122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7123 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7124 var
7125   Row, Col, AlphaInterleave: Integer;
7126   pSource, pDest: PByte;
7127 begin
7128   result := false;
7129
7130   if Assigned(Data) then begin
7131     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7132       if Assigned(aBitmap) then begin
7133         aBitmap.PixelFormat := pf8bit;
7134         aBitmap.Palette     := CreateGrayPalette;
7135         aBitmap.Width       := Width;
7136         aBitmap.Height      := Height;
7137
7138         case Format of
7139           tfLuminance8Alpha8ub2:
7140             AlphaInterleave := 1;
7141           tfRGBA8ub4, tfBGRA8ub4:
7142             AlphaInterleave := 3;
7143           else
7144             AlphaInterleave := 0;
7145         end;
7146
7147         // Copy Data
7148         pSource := Data;
7149
7150         for Row := 0 to Height -1 do begin
7151           pDest := aBitmap.Scanline[Row];
7152           if Assigned(pDest) then begin
7153             for Col := 0 to Width -1 do begin
7154               Inc(pSource, AlphaInterleave);
7155               pDest^ := pSource^;
7156               Inc(pDest);
7157               Inc(pSource);
7158             end;
7159           end;
7160         end;
7161         result := true;
7162       end;
7163     end;
7164   end;
7165 end;
7166
7167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7168 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7169 var
7170   data: TglBitmapData;
7171 begin
7172   data := TglBitmapData.Create;
7173   try
7174     data.AssignFromBitmap(aBitmap);
7175     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7176   finally
7177     data.Free;
7178   end;
7179 end;
7180 {$ENDIF}
7181
7182 {$IFDEF GLB_LAZARUS}
7183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7184 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7185 var
7186   rid: TRawImageDescription;
7187   FormatDesc: TFormatDescriptor;
7188 begin
7189   if not Assigned(Data) then
7190     raise EglBitmap.Create('no pixel data assigned. load data before save');
7191
7192   result := false;
7193   if not Assigned(aImage) or (Format = tfEmpty) then
7194     exit;
7195   FormatDesc := TFormatDescriptor.Get(Format);
7196   if FormatDesc.IsCompressed then
7197     exit;
7198
7199   FillChar(rid{%H-}, SizeOf(rid), 0);
7200   if FormatDesc.IsGrayscale then
7201     rid.Format := ricfGray
7202   else
7203     rid.Format := ricfRGBA;
7204
7205   rid.Width        := Width;
7206   rid.Height       := Height;
7207   rid.Depth        := FormatDesc.BitsPerPixel;
7208   rid.BitOrder     := riboBitsInOrder;
7209   rid.ByteOrder    := riboLSBFirst;
7210   rid.LineOrder    := riloTopToBottom;
7211   rid.LineEnd      := rileTight;
7212   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7213   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7214   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7215   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7216   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7217   rid.RedShift     := FormatDesc.Shift.r;
7218   rid.GreenShift   := FormatDesc.Shift.g;
7219   rid.BlueShift    := FormatDesc.Shift.b;
7220   rid.AlphaShift   := FormatDesc.Shift.a;
7221
7222   rid.MaskBitsPerPixel  := 0;
7223   rid.PaletteColorCount := 0;
7224
7225   aImage.DataDescription := rid;
7226   aImage.CreateData;
7227
7228   if not Assigned(aImage.PixelData) then
7229     raise EglBitmap.Create('error while creating LazIntfImage');
7230   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7231
7232   result := true;
7233 end;
7234
7235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7236 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7237 var
7238   f: TglBitmapFormat;
7239   FormatDesc: TFormatDescriptor;
7240   ImageData: PByte;
7241   ImageSize: Integer;
7242   CanCopy: Boolean;
7243   Mask: TglBitmapRec4ul;
7244
7245   procedure CopyConvert;
7246   var
7247     bfFormat: TbmpBitfieldFormat;
7248     pSourceLine, pDestLine: PByte;
7249     pSourceMD, pDestMD: Pointer;
7250     Shift, Prec: TglBitmapRec4ub;
7251     x, y: Integer;
7252     pixel: TglBitmapPixelData;
7253   begin
7254     bfFormat  := TbmpBitfieldFormat.Create;
7255     with aImage.DataDescription do begin
7256       Prec.r := RedPrec;
7257       Prec.g := GreenPrec;
7258       Prec.b := BluePrec;
7259       Prec.a := AlphaPrec;
7260       Shift.r := RedShift;
7261       Shift.g := GreenShift;
7262       Shift.b := BlueShift;
7263       Shift.a := AlphaShift;
7264       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7265     end;
7266     pSourceMD := bfFormat.CreateMappingData;
7267     pDestMD   := FormatDesc.CreateMappingData;
7268     try
7269       for y := 0 to aImage.Height-1 do begin
7270         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7271         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7272         for x := 0 to aImage.Width-1 do begin
7273           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7274           FormatDesc.Map(pixel, pDestLine, pDestMD);
7275         end;
7276       end;
7277     finally
7278       FormatDesc.FreeMappingData(pDestMD);
7279       bfFormat.FreeMappingData(pSourceMD);
7280       bfFormat.Free;
7281     end;
7282   end;
7283
7284 begin
7285   result := false;
7286   if not Assigned(aImage) then
7287     exit;
7288
7289   with aImage.DataDescription do begin
7290     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7291     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7292     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7293     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7294   end;
7295   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7296   f          := FormatDesc.Format;
7297   if (f = tfEmpty) then
7298     exit;
7299
7300   CanCopy :=
7301     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7302     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7303
7304   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7305   ImageData := GetMem(ImageSize);
7306   try
7307     if CanCopy then
7308       Move(aImage.PixelData^, ImageData^, ImageSize)
7309     else
7310       CopyConvert;
7311     SetData(ImageData, f, aImage.Width, aImage.Height);
7312   except
7313     if Assigned(ImageData) then
7314       FreeMem(ImageData);
7315     raise;
7316   end;
7317
7318   result := true;
7319 end;
7320
7321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7322 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7323 var
7324   rid: TRawImageDescription;
7325   FormatDesc: TFormatDescriptor;
7326   Pixel: TglBitmapPixelData;
7327   x, y: Integer;
7328   srcMD: Pointer;
7329   src, dst: PByte;
7330 begin
7331   result := false;
7332   if not Assigned(aImage) or (Format = tfEmpty) then
7333     exit;
7334   FormatDesc := TFormatDescriptor.Get(Format);
7335   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7336     exit;
7337
7338   FillChar(rid{%H-}, SizeOf(rid), 0);
7339   rid.Format       := ricfGray;
7340   rid.Width        := Width;
7341   rid.Height       := Height;
7342   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7343   rid.BitOrder     := riboBitsInOrder;
7344   rid.ByteOrder    := riboLSBFirst;
7345   rid.LineOrder    := riloTopToBottom;
7346   rid.LineEnd      := rileTight;
7347   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7348   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7349   rid.GreenPrec    := 0;
7350   rid.BluePrec     := 0;
7351   rid.AlphaPrec    := 0;
7352   rid.RedShift     := 0;
7353   rid.GreenShift   := 0;
7354   rid.BlueShift    := 0;
7355   rid.AlphaShift   := 0;
7356
7357   rid.MaskBitsPerPixel  := 0;
7358   rid.PaletteColorCount := 0;
7359
7360   aImage.DataDescription := rid;
7361   aImage.CreateData;
7362
7363   srcMD := FormatDesc.CreateMappingData;
7364   try
7365     FormatDesc.PreparePixel(Pixel);
7366     src := Data;
7367     dst := aImage.PixelData;
7368     for y := 0 to Height-1 do
7369       for x := 0 to Width-1 do begin
7370         FormatDesc.Unmap(src, Pixel, srcMD);
7371         case rid.BitsPerPixel of
7372            8: begin
7373             dst^ := Pixel.Data.a;
7374             inc(dst);
7375           end;
7376           16: begin
7377             PWord(dst)^ := Pixel.Data.a;
7378             inc(dst, 2);
7379           end;
7380           24: begin
7381             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7382             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7383             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7384             inc(dst, 3);
7385           end;
7386           32: begin
7387             PCardinal(dst)^ := Pixel.Data.a;
7388             inc(dst, 4);
7389           end;
7390         else
7391           raise EglBitmapUnsupportedFormat.Create(Format);
7392         end;
7393       end;
7394   finally
7395     FormatDesc.FreeMappingData(srcMD);
7396   end;
7397   result := true;
7398 end;
7399
7400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7401 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7402 var
7403   data: TglBitmapData;
7404 begin
7405   data := TglBitmapData.Create;
7406   try
7407     data.AssignFromLazIntfImage(aImage);
7408     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7409   finally
7410     data.Free;
7411   end;
7412 end;
7413 {$ENDIF}
7414
7415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7416 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7417   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7418 var
7419   rs: TResourceStream;
7420 begin
7421   PrepareResType(aResource, aResType);
7422   rs := TResourceStream.Create(aInstance, aResource, aResType);
7423   try
7424     result := AddAlphaFromStream(rs, aFunc, aArgs);
7425   finally
7426     rs.Free;
7427   end;
7428 end;
7429
7430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7431 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7432   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7433 var
7434   rs: TResourceStream;
7435 begin
7436   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7437   try
7438     result := AddAlphaFromStream(rs, aFunc, aArgs);
7439   finally
7440     rs.Free;
7441   end;
7442 end;
7443
7444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7445 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7446 begin
7447   if TFormatDescriptor.Get(Format).IsCompressed then
7448     raise EglBitmapUnsupportedFormat.Create(Format);
7449   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7450 end;
7451
7452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7453 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7454 var
7455   FS: TFileStream;
7456 begin
7457   FS := TFileStream.Create(aFileName, fmOpenRead);
7458   try
7459     result := AddAlphaFromStream(FS, aFunc, aArgs);
7460   finally
7461     FS.Free;
7462   end;
7463 end;
7464
7465 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7466 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7467 var
7468   data: TglBitmapData;
7469 begin
7470   data := TglBitmapData.Create(aStream);
7471   try
7472     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7473   finally
7474     data.Free;
7475   end;
7476 end;
7477
7478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7479 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7480 var
7481   DestData, DestData2, SourceData: pByte;
7482   TempHeight, TempWidth: Integer;
7483   SourceFD, DestFD: TFormatDescriptor;
7484   SourceMD, DestMD, DestMD2: Pointer;
7485
7486   FuncRec: TglBitmapFunctionRec;
7487 begin
7488   result := false;
7489
7490   Assert(Assigned(Data));
7491   Assert(Assigned(aDataObj));
7492   Assert(Assigned(aDataObj.Data));
7493
7494   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7495     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7496
7497     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7498     DestFD   := TFormatDescriptor.Get(Format);
7499
7500     if not Assigned(aFunc) then begin
7501       aFunc        := glBitmapAlphaFunc;
7502       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7503     end else
7504       FuncRec.Args := aArgs;
7505
7506     // Values
7507     TempWidth  := aDataObj.Width;
7508     TempHeight := aDataObj.Height;
7509     if (TempWidth <= 0) or (TempHeight <= 0) then
7510       exit;
7511
7512     FuncRec.Sender          := Self;
7513     FuncRec.Size            := Dimension;
7514     FuncRec.Position.Fields := FuncRec.Size.Fields;
7515
7516     DestData   := Data;
7517     DestData2  := Data;
7518     SourceData := aDataObj.Data;
7519
7520     // Mapping
7521     SourceFD.PreparePixel(FuncRec.Source);
7522     DestFD.PreparePixel  (FuncRec.Dest);
7523
7524     SourceMD := SourceFD.CreateMappingData;
7525     DestMD   := DestFD.CreateMappingData;
7526     DestMD2  := DestFD.CreateMappingData;
7527     try
7528       FuncRec.Position.Y := 0;
7529       while FuncRec.Position.Y < TempHeight do begin
7530         FuncRec.Position.X := 0;
7531         while FuncRec.Position.X < TempWidth do begin
7532           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7533           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7534           aFunc(FuncRec);
7535           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7536           inc(FuncRec.Position.X);
7537         end;
7538         inc(FuncRec.Position.Y);
7539       end;
7540     finally
7541       SourceFD.FreeMappingData(SourceMD);
7542       DestFD.FreeMappingData(DestMD);
7543       DestFD.FreeMappingData(DestMD2);
7544     end;
7545   end;
7546 end;
7547
7548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7549 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7550 begin
7551   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7552 end;
7553
7554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7555 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7556 var
7557   PixelData: TglBitmapPixelData;
7558 begin
7559   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7560   result := AddAlphaFromColorKeyFloat(
7561     aRed   / PixelData.Range.r,
7562     aGreen / PixelData.Range.g,
7563     aBlue  / PixelData.Range.b,
7564     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7565 end;
7566
7567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7568 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7569 var
7570   values: array[0..2] of Single;
7571   tmp: Cardinal;
7572   i: Integer;
7573   PixelData: TglBitmapPixelData;
7574 begin
7575   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7576   with PixelData do begin
7577     values[0] := aRed;
7578     values[1] := aGreen;
7579     values[2] := aBlue;
7580
7581     for i := 0 to 2 do begin
7582       tmp          := Trunc(Range.arr[i] * aDeviation);
7583       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7584       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7585     end;
7586     Data.a  := 0;
7587     Range.a := 0;
7588   end;
7589   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7590 end;
7591
7592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7593 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7594 begin
7595   result := AddAlphaFromValueFloat(aAlpha / $FF);
7596 end;
7597
7598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7599 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7600 var
7601   PixelData: TglBitmapPixelData;
7602 begin
7603   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7604   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7605 end;
7606
7607 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7608 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7609 var
7610   PixelData: TglBitmapPixelData;
7611 begin
7612   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7613   with PixelData do
7614     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7615   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7616 end;
7617
7618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7619 function TglBitmapData.RemoveAlpha: Boolean;
7620 var
7621   FormatDesc: TFormatDescriptor;
7622 begin
7623   result := false;
7624   FormatDesc := TFormatDescriptor.Get(Format);
7625   if Assigned(Data) then begin
7626     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7627       raise EglBitmapUnsupportedFormat.Create(Format);
7628     result := ConvertTo(FormatDesc.WithoutAlpha);
7629   end;
7630 end;
7631
7632 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7633 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7634   const aAlpha: Byte);
7635 begin
7636   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7637 end;
7638
7639 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7640 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7641 var
7642   PixelData: TglBitmapPixelData;
7643 begin
7644   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7645   FillWithColorFloat(
7646     aRed   / PixelData.Range.r,
7647     aGreen / PixelData.Range.g,
7648     aBlue  / PixelData.Range.b,
7649     aAlpha / PixelData.Range.a);
7650 end;
7651
7652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7653 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7654 var
7655   PixelData: TglBitmapPixelData;
7656 begin
7657   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7658   with PixelData do begin
7659     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7660     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7661     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7662     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7663   end;
7664   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7665 end;
7666
7667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7668 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7669 begin
7670   if (Data <> aData) then begin
7671     if (Assigned(Data)) then
7672       FreeMem(Data);
7673     fData := aData;
7674   end;
7675
7676   if Assigned(fData) then begin
7677     FillChar(fDimension, SizeOf(fDimension), 0);
7678     if aWidth <> -1 then begin
7679       fDimension.Fields := fDimension.Fields + [ffX];
7680       fDimension.X := aWidth;
7681     end;
7682
7683     if aHeight <> -1 then begin
7684       fDimension.Fields := fDimension.Fields + [ffY];
7685       fDimension.Y := aHeight;
7686     end;
7687
7688     fFormat := aFormat;
7689   end else
7690     fFormat := tfEmpty;
7691
7692   UpdateScanlines;
7693 end;
7694
7695 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7696 function TglBitmapData.Clone: TglBitmapData;
7697 var
7698   Temp: TglBitmapData;
7699   TempPtr: PByte;
7700   Size: Integer;
7701 begin
7702   result := nil;
7703   Temp := (ClassType.Create as TglBitmapData);
7704   try
7705     // copy texture data if assigned
7706     if Assigned(Data) then begin
7707       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7708       GetMem(TempPtr, Size);
7709       try
7710         Move(Data^, TempPtr^, Size);
7711         Temp.SetData(TempPtr, Format, Width, Height);
7712       except
7713         if Assigned(TempPtr) then
7714           FreeMem(TempPtr);
7715         raise;
7716       end;
7717     end else begin
7718       TempPtr := nil;
7719       Temp.SetData(TempPtr, Format, Width, Height);
7720     end;
7721
7722           // copy properties
7723     Temp.fFormat := Format;
7724     result := Temp;
7725   except
7726     FreeAndNil(Temp);
7727     raise;
7728   end;
7729 end;
7730
7731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7732 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7733 var
7734   mask: PtrInt;
7735 begin
7736   mask :=
7737      (Byte(aRed)   and 1)        or
7738     ((Byte(aGreen) and 1) shl 1) or
7739     ((Byte(aBlue)  and 1) shl 2) or
7740     ((Byte(aAlpha) and 1) shl 3);
7741   if (mask > 0) then
7742     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7743 end;
7744
7745 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7746 type
7747   TMatrixItem = record
7748     X, Y: Integer;
7749     W: Single;
7750   end;
7751
7752   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7753   TglBitmapToNormalMapRec = Record
7754     Scale: Single;
7755     Heights: array of Single;
7756     MatrixU : array of TMatrixItem;
7757     MatrixV : array of TMatrixItem;
7758   end;
7759
7760 const
7761   ONE_OVER_255 = 1 / 255;
7762
7763   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7764 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7765 var
7766   Val: Single;
7767 begin
7768   with FuncRec do begin
7769     Val :=
7770       Source.Data.r * LUMINANCE_WEIGHT_R +
7771       Source.Data.g * LUMINANCE_WEIGHT_G +
7772       Source.Data.b * LUMINANCE_WEIGHT_B;
7773     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7774   end;
7775 end;
7776
7777 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7778 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7779 begin
7780   with FuncRec do
7781     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7782 end;
7783
7784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7785 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7786 type
7787   TVec = Array[0..2] of Single;
7788 var
7789   Idx: Integer;
7790   du, dv: Double;
7791   Len: Single;
7792   Vec: TVec;
7793
7794   function GetHeight(X, Y: Integer): Single;
7795   begin
7796     with FuncRec do begin
7797       X := Max(0, Min(Size.X -1, X));
7798       Y := Max(0, Min(Size.Y -1, Y));
7799       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7800     end;
7801   end;
7802
7803 begin
7804   with FuncRec do begin
7805     with PglBitmapToNormalMapRec(Args)^ do begin
7806       du := 0;
7807       for Idx := Low(MatrixU) to High(MatrixU) do
7808         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7809
7810       dv := 0;
7811       for Idx := Low(MatrixU) to High(MatrixU) do
7812         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7813
7814       Vec[0] := -du * Scale;
7815       Vec[1] := -dv * Scale;
7816       Vec[2] := 1;
7817     end;
7818
7819     // Normalize
7820     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7821     if Len <> 0 then begin
7822       Vec[0] := Vec[0] * Len;
7823       Vec[1] := Vec[1] * Len;
7824       Vec[2] := Vec[2] * Len;
7825     end;
7826
7827     // Farbe zuweisem
7828     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7829     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7830     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7831   end;
7832 end;
7833
7834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7835 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7836 var
7837   Rec: TglBitmapToNormalMapRec;
7838
7839   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7840   begin
7841     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7842       Matrix[Index].X := X;
7843       Matrix[Index].Y := Y;
7844       Matrix[Index].W := W;
7845     end;
7846   end;
7847
7848 begin
7849   if TFormatDescriptor.Get(Format).IsCompressed then
7850     raise EglBitmapUnsupportedFormat.Create(Format);
7851
7852   if aScale > 100 then
7853     Rec.Scale := 100
7854   else if aScale < -100 then
7855     Rec.Scale := -100
7856   else
7857     Rec.Scale := aScale;
7858
7859   SetLength(Rec.Heights, Width * Height);
7860   try
7861     case aFunc of
7862       nm4Samples: begin
7863         SetLength(Rec.MatrixU, 2);
7864         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7865         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7866
7867         SetLength(Rec.MatrixV, 2);
7868         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7869         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7870       end;
7871
7872       nmSobel: begin
7873         SetLength(Rec.MatrixU, 6);
7874         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7875         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7876         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7877         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7878         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7879         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7880
7881         SetLength(Rec.MatrixV, 6);
7882         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7883         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7884         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7885         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7886         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7887         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7888       end;
7889
7890       nm3x3: begin
7891         SetLength(Rec.MatrixU, 6);
7892         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7893         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7894         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7895         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7896         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7897         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7898
7899         SetLength(Rec.MatrixV, 6);
7900         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7901         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7902         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7903         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7904         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7905         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7906       end;
7907
7908       nm5x5: begin
7909         SetLength(Rec.MatrixU, 20);
7910         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7911         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7912         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7913         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7914         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7915         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7916         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7917         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7918         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7919         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7920         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7921         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7922         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7923         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7924         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7925         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7926         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7927         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7928         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7929         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7930
7931         SetLength(Rec.MatrixV, 20);
7932         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7933         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7934         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7935         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7936         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7937         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7938         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7939         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7940         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7941         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7942         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7943         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7944         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7945         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7946         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7947         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7948         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7949         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7950         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7951         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7952       end;
7953     end;
7954
7955     // Daten Sammeln
7956     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7957       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7958     else
7959       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7960     Convert(glBitmapToNormalMapFunc, false, @Rec);
7961   finally
7962     SetLength(Rec.Heights, 0);
7963   end;
7964 end;
7965
7966 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7967 constructor TglBitmapData.Create;
7968 begin
7969   inherited Create;
7970   fFormat := glBitmapDefaultFormat;
7971 end;
7972
7973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7974 constructor TglBitmapData.Create(const aFileName: String);
7975 begin
7976   Create;
7977   LoadFromFile(aFileName);
7978 end;
7979
7980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7981 constructor TglBitmapData.Create(const aStream: TStream);
7982 begin
7983   Create;
7984   LoadFromStream(aStream);
7985 end;
7986
7987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7988 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7989 var
7990   ImageSize: Integer;
7991 begin
7992   Create;
7993   if not Assigned(aData) then begin
7994     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7995     GetMem(aData, ImageSize);
7996     try
7997       FillChar(aData^, ImageSize, #$FF);
7998       SetData(aData, aFormat, aSize.X, aSize.Y);
7999     except
8000       if Assigned(aData) then
8001         FreeMem(aData);
8002       raise;
8003     end;
8004   end else begin
8005     SetData(aData, aFormat, aSize.X, aSize.Y);
8006   end;
8007 end;
8008
8009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8010 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
8011 begin
8012   Create;
8013   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
8014 end;
8015
8016 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8017 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
8018 begin
8019   Create;
8020   LoadFromResource(aInstance, aResource, aResType);
8021 end;
8022
8023 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8024 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8025 begin
8026   Create;
8027   LoadFromResourceID(aInstance, aResourceID, aResType);
8028 end;
8029
8030 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8031 destructor TglBitmapData.Destroy;
8032 begin
8033   SetData(nil, tfEmpty);
8034   inherited Destroy;
8035 end;
8036
8037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8038 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8039 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8040 function TglBitmap.GetWidth: Integer;
8041 begin
8042   if (ffX in fDimension.Fields) then
8043     result := fDimension.X
8044   else
8045     result := -1;
8046 end;
8047
8048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8049 function TglBitmap.GetHeight: Integer;
8050 begin
8051   if (ffY in fDimension.Fields) then
8052     result := fDimension.Y
8053   else
8054     result := -1;
8055 end;
8056
8057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8058 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8059 begin
8060   if fCustomData = aValue then
8061     exit;
8062   fCustomData := aValue;
8063 end;
8064
8065 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8066 procedure TglBitmap.SetCustomName(const aValue: String);
8067 begin
8068   if fCustomName = aValue then
8069     exit;
8070   fCustomName := aValue;
8071 end;
8072
8073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8074 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8075 begin
8076   if fCustomNameW = aValue then
8077     exit;
8078   fCustomNameW := aValue;
8079 end;
8080
8081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8082 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8083 begin
8084   if fDeleteTextureOnFree = aValue then
8085     exit;
8086   fDeleteTextureOnFree := aValue;
8087 end;
8088
8089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8090 procedure TglBitmap.SetID(const aValue: Cardinal);
8091 begin
8092   if fID = aValue then
8093     exit;
8094   fID := aValue;
8095 end;
8096
8097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8098 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8099 begin
8100   if fMipMap = aValue then
8101     exit;
8102   fMipMap := aValue;
8103 end;
8104
8105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8106 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8107 begin
8108   if fTarget = aValue then
8109     exit;
8110   fTarget := aValue;
8111 end;
8112
8113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8114 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8115 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8116 var
8117   MaxAnisotropic: Integer;
8118 {$IFEND}
8119 begin
8120   fAnisotropic := aValue;
8121   if (ID > 0) then begin
8122 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8123     if GL_EXT_texture_filter_anisotropic then begin
8124       if fAnisotropic > 0 then begin
8125         Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8126         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8127         if aValue > MaxAnisotropic then
8128           fAnisotropic := MaxAnisotropic;
8129         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8130       end;
8131     end else begin
8132       fAnisotropic := 0;
8133     end;
8134 {$ELSE}
8135     fAnisotropic := 0;
8136 {$IFEND}
8137   end;
8138 end;
8139
8140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8141 procedure TglBitmap.CreateID;
8142 begin
8143   if (ID <> 0) then
8144     glDeleteTextures(1, @fID);
8145   glGenTextures(1, @fID);
8146   Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8147 end;
8148
8149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8150 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8151 begin
8152   // Set Up Parameters
8153   SetWrap(fWrapS, fWrapT, fWrapR);
8154   SetFilter(fFilterMin, fFilterMag);
8155   SetAnisotropic(fAnisotropic);
8156
8157 {$IFNDEF OPENGL_ES}
8158   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8159   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8160     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8161 {$ENDIF}
8162
8163 {$IFNDEF OPENGL_ES}
8164   // Mip Maps Generation Mode
8165   aBuildWithGlu := false;
8166   if (MipMap = mmMipmap) then begin
8167     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8168       glTexParameteri(Target, GL_GENERATE_MIPMAP, GLint(GL_TRUE))
8169     else
8170       aBuildWithGlu := true;
8171   end else if (MipMap = mmMipmapGlu) then
8172     aBuildWithGlu := true;
8173 {$ELSE}
8174   if (MipMap = mmMipmap) then
8175     glGenerateMipmap(Target);
8176 {$ENDIF}
8177 end;
8178
8179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8180 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8182 procedure TglBitmap.AfterConstruction;
8183 begin
8184   inherited AfterConstruction;
8185
8186   fID         := 0;
8187   fTarget     := 0;
8188 {$IFNDEF OPENGL_ES}
8189   fIsResident := false;
8190 {$ENDIF}
8191
8192   fMipMap              := glBitmapDefaultMipmap;
8193   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8194
8195   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8196   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8197 {$IFNDEF OPENGL_ES}
8198   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8199 {$ENDIF}
8200 end;
8201
8202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8203 procedure TglBitmap.BeforeDestruction;
8204 begin
8205   if (fID > 0) and fDeleteTextureOnFree then
8206     glDeleteTextures(1, @fID);
8207   inherited BeforeDestruction;
8208 end;
8209
8210 {$IFNDEF OPENGL_ES}
8211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8212 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8213 begin
8214   fBorderColor[0] := aRed;
8215   fBorderColor[1] := aGreen;
8216   fBorderColor[2] := aBlue;
8217   fBorderColor[3] := aAlpha;
8218   if (ID > 0) then begin
8219     Bind(false);
8220     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8221   end;
8222 end;
8223 {$ENDIF}
8224
8225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8226 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8227 begin
8228   //check MIN filter
8229   case aMin of
8230     GL_NEAREST:
8231       fFilterMin := GL_NEAREST;
8232     GL_LINEAR:
8233       fFilterMin := GL_LINEAR;
8234     GL_NEAREST_MIPMAP_NEAREST:
8235       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8236     GL_LINEAR_MIPMAP_NEAREST:
8237       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8238     GL_NEAREST_MIPMAP_LINEAR:
8239       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8240     GL_LINEAR_MIPMAP_LINEAR:
8241       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8242     else
8243       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8244   end;
8245
8246   //check MAG filter
8247   case aMag of
8248     GL_NEAREST:
8249       fFilterMag := GL_NEAREST;
8250     GL_LINEAR:
8251       fFilterMag := GL_LINEAR;
8252     else
8253       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8254   end;
8255
8256   //apply filter
8257   if (ID > 0) then begin
8258     Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8259     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8260
8261     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8262       case fFilterMin of
8263         GL_NEAREST, GL_LINEAR:
8264           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8265         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8266           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8267         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8268           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8269       end;
8270     end else
8271       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8272   end;
8273 end;
8274
8275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8276 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8277
8278   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8279   begin
8280     case aValue of
8281 {$IFNDEF OPENGL_ES}
8282       GL_CLAMP:
8283         aTarget := GL_CLAMP;
8284 {$ENDIF}
8285
8286       GL_REPEAT:
8287         aTarget := GL_REPEAT;
8288
8289       GL_CLAMP_TO_EDGE: begin
8290 {$IFNDEF OPENGL_ES}
8291         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8292           aTarget := GL_CLAMP
8293         else
8294 {$ENDIF}
8295           aTarget := GL_CLAMP_TO_EDGE;
8296       end;
8297
8298 {$IFNDEF OPENGL_ES}
8299       GL_CLAMP_TO_BORDER: begin
8300         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8301           aTarget := GL_CLAMP_TO_BORDER
8302         else
8303           aTarget := GL_CLAMP;
8304       end;
8305 {$ENDIF}
8306
8307 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8308       GL_MIRRORED_REPEAT: begin
8309   {$IFNDEF OPENGL_ES}
8310         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8311   {$ELSE}
8312         if GL_VERSION_2_0 then
8313   {$ENDIF}
8314           aTarget := GL_MIRRORED_REPEAT
8315         else
8316           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8317       end;
8318 {$IFEND}
8319     else
8320       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8321     end;
8322   end;
8323
8324 begin
8325   CheckAndSetWrap(S, fWrapS);
8326   CheckAndSetWrap(T, fWrapT);
8327   CheckAndSetWrap(R, fWrapR);
8328
8329   if (ID > 0) then begin
8330     Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
8331     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8332     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8333 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8334     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8335     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8336 {$IFEND}
8337   end;
8338 end;
8339
8340 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8342 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8343
8344   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8345   begin
8346     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8347        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8348       fSwizzle[aIndex] := aValue
8349     else
8350       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8351   end;
8352
8353 begin
8354 {$IFNDEF OPENGL_ES}
8355   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8356     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8357 {$ELSE}
8358   if not GL_VERSION_3_0 then
8359     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8360 {$ENDIF}
8361   CheckAndSetValue(r, 0);
8362   CheckAndSetValue(g, 1);
8363   CheckAndSetValue(b, 2);
8364   CheckAndSetValue(a, 3);
8365
8366   if (ID > 0) then begin
8367     Bind(false);
8368 {$IFNDEF OPENGL_ES}
8369     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8370 {$ELSE}
8371     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8372     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8373     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8374     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8375 {$ENDIF}
8376   end;
8377 end;
8378 {$IFEND}
8379
8380 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8381 procedure TglBitmap.Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean{$ENDIF});
8382 begin
8383 {$IFNDEF OPENGL_ES}
8384   if aEnableTextureUnit then
8385     glEnable(Target);
8386 {$ENDIF}
8387   if (ID > 0) then
8388     glBindTexture(Target, ID);
8389 end;
8390
8391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8392 procedure TglBitmap.Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean{$ENDIF});
8393 begin
8394 {$IFNDEF OPENGL_ES}
8395   if aDisableTextureUnit then
8396     glDisable(Target);
8397 {$ENDIF}
8398   glBindTexture(Target, 0);
8399 end;
8400
8401 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8402 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8403 var
8404   w, h: Integer;
8405 begin
8406   w := aDataObj.Width;
8407   h := aDataObj.Height;
8408   fDimension.Fields := [];
8409   if (w > 0) then
8410     fDimension.Fields := fDimension.Fields + [ffX];
8411   if (h > 0) then
8412     fDimension.Fields := fDimension.Fields + [ffY];
8413   fDimension.X := w;
8414   fDimension.Y := h;
8415 end;
8416
8417 {$IFNDEF OPENGL_ES}
8418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8419 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8420 var
8421   Temp: PByte;
8422   TempWidth, TempHeight: Integer;
8423   TempIntFormat: GLint;
8424   IntFormat: TglBitmapFormat;
8425   FormatDesc: TFormatDescriptor;
8426 begin
8427   result := false;
8428   Bind;
8429
8430   // Request Data
8431   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8432   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8433   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8434
8435   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8436   IntFormat  := FormatDesc.Format;
8437
8438   // Getting data from OpenGL
8439   FormatDesc := TFormatDescriptor.Get(IntFormat);
8440   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8441   try
8442     if FormatDesc.IsCompressed then begin
8443       if not Assigned(glGetCompressedTexImage) then
8444         raise EglBitmap.Create('compressed formats not supported by video adapter');
8445       glGetCompressedTexImage(Target, 0, Temp)
8446     end else
8447       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8448     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8449     result := true;
8450   except
8451     if Assigned(Temp) then
8452       FreeMem(Temp);
8453     raise;
8454   end;
8455 end;
8456 {$ENDIF}
8457
8458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8459 constructor TglBitmap.Create;
8460 begin
8461   if (ClassType = TglBitmap) then
8462     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8463   inherited Create;
8464 end;
8465
8466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8467 constructor TglBitmap.Create(const aData: TglBitmapData);
8468 begin
8469   Create;
8470   UploadData(aData);
8471 end;
8472
8473 {$IFNDEF OPENGL_ES}
8474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8475 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8477 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8478 var
8479   fd: TglBitmapFormatDescriptor;
8480 begin
8481   // Upload data
8482   fd := aDataObj.FormatDescriptor;
8483   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8484     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8485
8486   if fd.IsCompressed then begin
8487     if not Assigned(glCompressedTexImage1D) then
8488       raise EglBitmap.Create('compressed formats not supported by video adapter');
8489     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8490   end else if aBuildWithGlu then
8491     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8492   else
8493     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8494 end;
8495
8496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8497 procedure TglBitmap1D.AfterConstruction;
8498 begin
8499   inherited;
8500   Target := GL_TEXTURE_1D;
8501 end;
8502
8503 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8504 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8505 var
8506   BuildWithGlu, TexRec: Boolean;
8507   TexSize: Integer;
8508 begin
8509   if not Assigned(aDataObj) then
8510     exit;
8511
8512   // Check Texture Size
8513   if (aCheckSize) then begin
8514     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8515
8516     if (aDataObj.Width > TexSize) then
8517       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8518
8519     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8520               (Target = GL_TEXTURE_RECTANGLE);
8521     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8522       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8523   end;
8524
8525   if (fID = 0) then
8526     CreateID;
8527   SetupParameters(BuildWithGlu);
8528   UploadDataIntern(aDataObj, BuildWithGlu);
8529   glAreTexturesResident(1, @fID, @fIsResident);
8530
8531   inherited UploadData(aDataObj, aCheckSize);
8532 end;
8533 {$ENDIF}
8534
8535 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8536 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8538 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
8539 var
8540   fd: TglBitmapFormatDescriptor;
8541 begin
8542   fd := aDataObj.FormatDescriptor;
8543   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8544     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8545
8546   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8547
8548   if fd.IsCompressed then begin
8549     if not Assigned(glCompressedTexImage2D) then
8550       raise EglBitmap.Create('compressed formats not supported by video adapter');
8551     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8552 {$IFNDEF OPENGL_ES}
8553   end else if aBuildWithGlu then begin
8554     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8555 {$ENDIF}
8556   end else begin
8557     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8558   end;
8559 end;
8560
8561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8562 procedure TglBitmap2D.AfterConstruction;
8563 begin
8564   inherited;
8565   Target := GL_TEXTURE_2D;
8566 end;
8567
8568 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8569 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8570 var
8571   {$IFNDEF OPENGL_ES}
8572   BuildWithGlu, TexRec: Boolean;
8573   {$ENDIF}
8574   PotTex: Boolean;
8575   TexSize: Integer;
8576 begin
8577   if not Assigned(aDataObj) then
8578     exit;
8579
8580   // Check Texture Size
8581   if (aCheckSize) then begin
8582     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8583
8584     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8585       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8586
8587     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8588 {$IF NOT DEFINED(OPENGL_ES)}
8589     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8590     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8591       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8592 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8593     if not PotTex and not GL_OES_texture_npot then
8594       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8595 {$ELSE}
8596     if not PotTex then
8597       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8598 {$IFEND}
8599   end;
8600
8601   if (fID = 0) then
8602     CreateID;
8603   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8604   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8605 {$IFNDEF OPENGL_ES}
8606   glAreTexturesResident(1, @fID, @fIsResident);
8607 {$ENDIF}
8608
8609   inherited UploadData(aDataObj, aCheckSize);
8610 end;
8611
8612 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8613 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8614 var
8615   Temp: pByte;
8616   Size, w, h: Integer;
8617   FormatDesc: TFormatDescriptor;
8618 begin
8619   FormatDesc := TFormatDescriptor.Get(aFormat);
8620   if FormatDesc.IsCompressed then
8621     raise EglBitmapUnsupportedFormat.Create(aFormat);
8622
8623   w    := aRight  - aLeft;
8624   h    := aBottom - aTop;
8625   Size := FormatDesc.GetSize(w, h);
8626   GetMem(Temp, Size);
8627   try
8628     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8629     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8630     aDataObj.SetData(Temp, aFormat, w, h);
8631     aDataObj.FlipVert;
8632   except
8633     if Assigned(Temp) then
8634       FreeMem(Temp);
8635     raise;
8636   end;
8637 end;
8638
8639 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8641 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8643 procedure TglBitmapCubeMap.AfterConstruction;
8644 begin
8645   inherited;
8646
8647 {$IFNDEF OPENGL_ES}
8648   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8649     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8650 {$ELSE}
8651   if not (GL_VERSION_2_0) then
8652     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8653 {$ENDIF}
8654
8655   SetWrap;
8656   Target   := GL_TEXTURE_CUBE_MAP;
8657 {$IFNDEF OPENGL_ES}
8658   fGenMode := GL_REFLECTION_MAP;
8659 {$ENDIF}
8660 end;
8661
8662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8663 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8664 begin
8665   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8666 end;
8667
8668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8669 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8670 var
8671   {$IFNDEF OPENGL_ES}
8672   BuildWithGlu: Boolean;
8673   {$ENDIF}
8674   TexSize: Integer;
8675 begin
8676   if (aCheckSize) then begin
8677     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8678
8679     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8680       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8681
8682 {$IF NOT DEFINED(OPENGL_ES)}
8683     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8684       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8685 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8686     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8687       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8688 {$ELSE}
8689     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8690       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8691 {$IFEND}
8692   end;
8693
8694   if (fID = 0) then
8695     CreateID;
8696   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8697   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8698
8699   inherited UploadData(aDataObj, aCheckSize);
8700 end;
8701
8702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8703 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean{$ENDIF});
8704 begin
8705   inherited Bind({$IFNDEF OPENGL_ES}aEnableTextureUnit{$ENDIF});
8706 {$IFNDEF OPENGL_ES}
8707   if aEnableTexCoordsGen then begin
8708     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8709     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8710     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8711     glEnable(GL_TEXTURE_GEN_S);
8712     glEnable(GL_TEXTURE_GEN_T);
8713     glEnable(GL_TEXTURE_GEN_R);
8714   end;
8715 {$ENDIF}
8716 end;
8717
8718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8719 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean{$ENDIF});
8720 begin
8721   inherited Unbind({$IFNDEF OPENGL_ES}aDisableTextureUnit{$ENDIF});
8722 {$IFNDEF OPENGL_ES}
8723   if aDisableTexCoordsGen then begin
8724     glDisable(GL_TEXTURE_GEN_S);
8725     glDisable(GL_TEXTURE_GEN_T);
8726     glDisable(GL_TEXTURE_GEN_R);
8727   end;
8728 {$ENDIF}
8729 end;
8730 {$IFEND}
8731
8732 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8734 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8736 type
8737   TVec = Array[0..2] of Single;
8738   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8739
8740   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8741   TglBitmapNormalMapRec = record
8742     HalfSize : Integer;
8743     Func: TglBitmapNormalMapGetVectorFunc;
8744   end;
8745
8746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8747 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8748 begin
8749   aVec[0] := aHalfSize;
8750   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8751   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8752 end;
8753
8754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8755 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8756 begin
8757   aVec[0] := - aHalfSize;
8758   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8759   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8760 end;
8761
8762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8763 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8764 begin
8765   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8766   aVec[1] := aHalfSize;
8767   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8768 end;
8769
8770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8771 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8772 begin
8773   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8774   aVec[1] := - aHalfSize;
8775   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8776 end;
8777
8778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8779 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8780 begin
8781   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8782   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8783   aVec[2] := aHalfSize;
8784 end;
8785
8786 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8787 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8788 begin
8789   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8790   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8791   aVec[2] := - aHalfSize;
8792 end;
8793
8794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8795 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8796 var
8797   i: Integer;
8798   Vec: TVec;
8799   Len: Single;
8800 begin
8801   with FuncRec do begin
8802     with PglBitmapNormalMapRec(Args)^ do begin
8803       Func(Vec, Position, HalfSize);
8804
8805       // Normalize
8806       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8807       if Len <> 0 then begin
8808         Vec[0] := Vec[0] * Len;
8809         Vec[1] := Vec[1] * Len;
8810         Vec[2] := Vec[2] * Len;
8811       end;
8812
8813       // Scale Vector and AddVectro
8814       Vec[0] := Vec[0] * 0.5 + 0.5;
8815       Vec[1] := Vec[1] * 0.5 + 0.5;
8816       Vec[2] := Vec[2] * 0.5 + 0.5;
8817     end;
8818
8819     // Set Color
8820     for i := 0 to 2 do
8821       Dest.Data.arr[i] := Round(Vec[i] * 255);
8822   end;
8823 end;
8824
8825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8826 procedure TglBitmapNormalMap.AfterConstruction;
8827 begin
8828   inherited;
8829 {$IFNDEF OPENGL_ES}
8830   fGenMode := GL_NORMAL_MAP;
8831 {$ENDIF}
8832 end;
8833
8834 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8835 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8836 var
8837   Rec: TglBitmapNormalMapRec;
8838   SizeRec: TglBitmapSize;
8839   DataObj: TglBitmapData;
8840 begin
8841   Rec.HalfSize := aSize div 2;
8842
8843   SizeRec.Fields := [ffX, ffY];
8844   SizeRec.X := aSize;
8845   SizeRec.Y := aSize;
8846
8847   DataObj := TglBitmapData.Create;
8848   try
8849     // Positive X
8850     Rec.Func := glBitmapNormalMapPosX;
8851     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8852     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8853
8854     // Negative X
8855     Rec.Func := glBitmapNormalMapNegX;
8856     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8857     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8858
8859     // Positive Y
8860     Rec.Func := glBitmapNormalMapPosY;
8861     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8862     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8863
8864     // Negative Y
8865     Rec.Func := glBitmapNormalMapNegY;
8866     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8867     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8868
8869     // Positive Z
8870     Rec.Func := glBitmapNormalMapPosZ;
8871     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8872     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8873
8874     // Negative Z
8875     Rec.Func := glBitmapNormalMapNegZ;
8876     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8877     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8878   finally
8879     FreeAndNil(DataObj);
8880   end;
8881 end;
8882 {$IFEND}
8883
8884 initialization
8885   glBitmapSetDefaultFormat (tfEmpty);
8886   glBitmapSetDefaultMipmap (mmMipmap);
8887   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8888   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8889 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8890   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8891 {$IFEND}
8892
8893   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8894   glBitmapSetDefaultDeleteTextureOnFree    (true);
8895
8896   TFormatDescriptor.Init;
8897
8898 finalization
8899   TFormatDescriptor.Finalize;
8900
8901 end.