glBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 interface
 183
 184 uses
 185   {$IFDEF OPENGL_ES}            dglOpenGLES,
 186   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 187
 188   {$IF DEFINED(GLB_WIN) AND
 189        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 190
 191   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 192   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 193   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 194
 195   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 196   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 197   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 198   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 199   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 200
 201   Classes, SysUtils;
 202
 203 type
 204 {$IFNDEF fpc}
 205   QWord   = System.UInt64;
 206   PQWord  = ^QWord;
 207
 208   PtrInt  = Longint;
 209   PtrUInt = DWord;
 210 {$ENDIF}
 211
 212
 213   { type that describes the format of the data stored in a texture.
 214     the name of formats is composed of the following constituents:
 215     - multiple channels:
 216        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 217        - width of the chanel in bit       (4, 8, 16, ...)
 218     - data type                           (e.g. ub, us, ui)
 219     - number of elements of data types }
 220   TglBitmapFormat = (
 221     tfEmpty = 0,
 222
 223     tfAlpha4ub1,                //< 1 x unsigned byte
 224     tfAlpha8ub1,                //< 1 x unsigned byte
 225     tfAlpha16us1,               //< 1 x unsigned short
 226
 227     tfLuminance4ub1,            //< 1 x unsigned byte
 228     tfLuminance8ub1,            //< 1 x unsigned byte
 229     tfLuminance16us1,           //< 1 x unsigned short
 230
 231     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 232     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 233     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 235     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 236
 237     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 238     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 239     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 240     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 241     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 242     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 243     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 244     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 245     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 246     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 247     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 248     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 249
 250     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 251     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 252     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 253     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 254     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 255     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 256     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 257     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 258     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 259     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 260
 261     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 262     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 263     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 264     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 265     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 266     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 267     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 268     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 269     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 270     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 271     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 272
 273     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 274     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 275     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 276     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 277     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 278     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 279     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 280     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 281     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 282     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 283
 284     tfDepth16us1,               //< 1 x unsigned short (depth)
 285     tfDepth24ui1,               //< 1 x unsigned int (depth)
 286     tfDepth32ui1,               //< 1 x unsigned int (depth)
 287
 288     tfS3tcDtx1RGBA,
 289     tfS3tcDtx3RGBA,
 290     tfS3tcDtx5RGBA
 291   );
 292
 293   { type to define suitable file formats }
 294   TglBitmapFileType = (
 295      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 296      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 297      ftDDS,                                             //< Direct Draw Surface file (DDS)
 298      ftTGA,                                             //< Targa Image File (TGA)
 299      ftBMP,                                             //< Windows Bitmap File (BMP)
 300      ftRAW);                                            //< glBitmap RAW file format
 301    TglBitmapFileTypes = set of TglBitmapFileType;
 302
 303   { possible mipmap types }
 304   TglBitmapMipMap = (
 305      mmNone,                //< no mipmaps
 306      mmMipmap,              //< normal mipmaps
 307      mmMipmapGlu);          //< mipmaps generated with glu functions
 308
 309   { possible normal map functions }
 310    TglBitmapNormalMapFunc = (
 311      nm4Samples,
 312      nmSobel,
 313      nm3x3,
 314      nm5x5);
 315
 316  ////////////////////////////////////////////////////////////////////////////////////////////////////
 317    EglBitmap                  = class(Exception);   //< glBitmap exception
 318    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 319    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 320    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 321    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 322    public
 323      constructor Create(const aFormat: TglBitmapFormat); overload;
 324      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 325    end;
 326
 327 ////////////////////////////////////////////////////////////////////////////////////////////////////
 328   { record that stores 4 unsigned integer values }
 329   TglBitmapRec4ui = packed record
 330   case Integer of
 331     0: (r, g, b, a: Cardinal);
 332     1: (arr: array[0..3] of Cardinal);
 333   end;
 334
 335   { record that stores 4 unsigned byte values }
 336   TglBitmapRec4ub = packed record
 337   case Integer of
 338     0: (r, g, b, a: Byte);
 339     1: (arr: array[0..3] of Byte);
 340   end;
 341
 342   { record that stores 4 unsigned long integer values }
 343   TglBitmapRec4ul = packed record
 344   case Integer of
 345     0: (r, g, b, a: QWord);
 346     1: (arr: array[0..3] of QWord);
 347   end;
 348
 349   { structure to store pixel data in }
 350   TglBitmapPixelData = packed record
 351     Data:   TglBitmapRec4ui;  //< color data for each color channel
 352     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 353     Format: TglBitmapFormat;  //< format of the pixel
 354   end;
 355   PglBitmapPixelData = ^TglBitmapPixelData;
 356
 357   TglBitmapSizeFields = set of (ffX, ffY);
 358   TglBitmapSize = packed record
 359     Fields: TglBitmapSizeFields;
 360     X: Word;
 361     Y: Word;
 362   end;
 363   TglBitmapPixelPosition = TglBitmapSize;
 364
 365   { describes the properties of a given texture data format }
 366   TglBitmapFormatDescriptor = class(TObject)
 367   private
 368     // cached properties
 369     fBytesPerPixel: Single;   //< number of bytes for each pixel
 370     fChannelCount: Integer;   //< number of color channels
 371     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 372     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 373
 374     { @return @true if the format has a red color channel, @false otherwise }
 375     function GetHasRed: Boolean;
 376
 377     { @return @true if the format has a green color channel, @false otherwise }
 378     function GetHasGreen: Boolean;
 379
 380     { @return @true if the format has a blue color channel, @false otherwise }
 381     function GetHasBlue: Boolean;
 382
 383     { @return @true if the format has a alpha color channel, @false otherwise }
 384     function GetHasAlpha: Boolean;
 385
 386     { @return @true if the format has any color color channel, @false otherwise }
 387     function GetHasColor: Boolean;
 388
 389     { @return @true if the format is a grayscale format, @false otherwise }
 390     function GetIsGrayscale: Boolean;
 391
 392     { @return @true if the format is supported by OpenGL, @false otherwise }
 393     function GetHasOpenGLSupport: Boolean;
 394
 395   protected
 396     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 397     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 398     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 399     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 400     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 401     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 402
 403     fBitsPerPixel: Integer;           //< number of bits per pixel
 404     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 405
 406     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 407     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 408
 409     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 410     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 411     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 412
 413     { set values for this format descriptor }
 414     procedure SetValues; virtual;
 415
 416     { calculate cached values }
 417     procedure CalcValues;
 418   public
 419     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 420     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 421     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 422     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 423     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 424
 425     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 426     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 427     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 428     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 429
 430     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 431     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 432     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 433     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 434     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 435
 436     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 437     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 438     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 439
 440     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 441     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 442     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 443     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 444     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 445     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 446
 447     property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
 448
 449     function GetSize(const aSize: TglBitmapSize): Integer;     overload; virtual;
 450     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
 451
 452     { constructor }
 453     constructor Create;
 454   public
 455     { get the format descriptor by a given OpenGL internal format
 456         @param aInternalFormat  OpenGL internal format to get format descriptor for
 457         @returns                suitable format descriptor or tfEmpty-Descriptor }
 458     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 459   end;
 460
 461 ////////////////////////////////////////////////////////////////////////////////////////////////////
 462   TglBitmapData = class;
 463
 464   { structure to store data for converting in }
 465   TglBitmapFunctionRec = record
 466     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 467     Size:     TglBitmapSize;          //< size of the texture
 468     Position: TglBitmapPixelPosition; //< position of the currently pixel
 469     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 470     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 471     Args:     Pointer;                //< user defined args that was passed to the convert function
 472   end;
 473
 474   { callback to use for converting texture data }
 475   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 476
 477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 478   { class to store texture data in. used to load, save and
 479     manipulate data before assigned to texture object
 480     all operations on a data object can be done from a background thread }
 481   TglBitmapData = class
 482   private { fields }
 483
 484     fData: PByte;               //< texture data
 485     fDimension: TglBitmapSize;  //< pixel size of the data
 486     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 487     fFilename: String;          //< file the data was load from
 488
 489     fScanlines:    array of PByte;  //< pointer to begin of each line
 490     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 491
 492   private { getter / setter }
 493
 494     { @returns the format descriptor suitable to the texture data format }
 495     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 496
 497     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 498     function GetWidth: Integer;
 499
 500     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 501     function GetHeight: Integer;
 502
 503     { get scanline at index aIndex
 504         @returns Pointer to start of line or @nil }
 505     function GetScanlines(const aIndex: Integer): PByte;
 506
 507     { set new value for the data format. only possible if new format has the same pixel size.
 508       if you want to convert the texture data, see ConvertTo function }
 509     procedure SetFormat(const aValue: TglBitmapFormat);
 510
 511   private { internal misc }
 512
 513     { splits a resource identifier into the resource and it's type
 514         @param aResource  resource identifier to split and store name in
 515         @param aResType   type of the resource }
 516     procedure PrepareResType(var aResource: String; var aResType: PChar);
 517
 518     { updates scanlines array }
 519     procedure UpdateScanlines;
 520
 521   private { internal load and save }
 522 {$IFDEF GLB_SUPPORT_PNG_READ}
 523     { try to load a PNG from a stream
 524         @param aStream  stream to load PNG from
 525         @returns        @true on success, @false otherwise }
 526     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 527 {$ENDIF}
 528
 529 {$ifdef GLB_SUPPORT_PNG_WRITE}
 530     { save texture data as PNG to stream
 531         @param aStream stream to save data to}
 532     procedure SavePNG(const aStream: TStream); virtual;
 533 {$ENDIF}
 534
 535 {$IFDEF GLB_SUPPORT_JPEG_READ}
 536     { try to load a JPEG from a stream
 537         @param aStream  stream to load JPEG from
 538         @returns        @true on success, @false otherwise }
 539     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 540 {$ENDIF}
 541
 542 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 543     { save texture data as JPEG to stream
 544         @param aStream stream to save data to}
 545     procedure SaveJPEG(const aStream: TStream); virtual;
 546 {$ENDIF}
 547
 548     { try to load a RAW image from a stream
 549         @param aStream  stream to load RAW image from
 550         @returns        @true on success, @false otherwise }
 551     function LoadRAW(const aStream: TStream): Boolean;
 552
 553     { save texture data as RAW image to stream
 554         @param aStream stream to save data to}
 555     procedure SaveRAW(const aStream: TStream);
 556
 557     { try to load a BMP from a stream
 558         @param aStream  stream to load BMP from
 559         @returns        @true on success, @false otherwise }
 560     function LoadBMP(const aStream: TStream): Boolean;
 561
 562     { save texture data as BMP to stream
 563         @param aStream stream to save data to}
 564     procedure SaveBMP(const aStream: TStream);
 565
 566     { try to load a TGA from a stream
 567         @param aStream  stream to load TGA from
 568         @returns        @true on success, @false otherwise }
 569     function LoadTGA(const aStream: TStream): Boolean;
 570
 571     { save texture data as TGA to stream
 572         @param aStream stream to save data to}
 573     procedure SaveTGA(const aStream: TStream);
 574
 575     { try to load a DDS from a stream
 576         @param aStream  stream to load DDS from
 577         @returns        @true on success, @false otherwise }
 578     function LoadDDS(const aStream: TStream): Boolean;
 579
 580     { save texture data as DDS to stream
 581         @param aStream stream to save data to}
 582     procedure SaveDDS(const aStream: TStream);
 583
 584   public { properties }
 585     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 586     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 587     property Filename:  String          read fFilename;                 //< file the data was loaded from
 588     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 589     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 590     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 591     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 592
 593     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 594
 595   public { flip }
 596
 597     { flip texture horizontal
 598         @returns @true in success, @false otherwise }
 599     function FlipHorz: Boolean; virtual;
 600
 601     { flip texture vertical
 602         @returns @true in success, @false otherwise }
 603     function FlipVert: Boolean; virtual;
 604
 605   public { load }
 606
 607     { load a texture from a file
 608         @param aFilename file to load texuture from }
 609     procedure LoadFromFile(const aFilename: String);
 610
 611     { load a texture from a stream
 612         @param aStream  stream to load texture from }
 613     procedure LoadFromStream(const aStream: TStream); virtual;
 614
 615     { use a function to generate texture data
 616         @param aSize    size of the texture
 617         @param aFormat  format of the texture data
 618         @param aFunc    callback to use for generation
 619         @param aArgs    user defined paramaters (use at will) }
 620     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 621
 622     { load a texture from a resource
 623         @param aInstance  resource handle
 624         @param aResource  resource indentifier
 625         @param aResType   resource type (if known) }
 626     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 627
 628     { load a texture from a resource id
 629         @param aInstance  resource handle
 630         @param aResource  resource ID
 631         @param aResType   resource type }
 632     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 633
 634   public { save }
 635
 636     { save texture data to a file
 637         @param aFilename  filename to store texture in
 638         @param aFileType  file type to store data into }
 639     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 640
 641     { save texture data to a stream
 642         @param aFilename  filename to store texture in
 643         @param aFileType  file type to store data into }
 644     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 645
 646   public { convert }
 647
 648     { convert texture data using a user defined callback
 649         @param aFunc        callback to use for converting
 650         @param aCreateTemp  create a temporary buffer to use for converting
 651         @param aArgs        user defined paramters (use at will)
 652         @returns            @true if converting was successful, @false otherwise }
 653     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 654
 655     { convert texture data using a user defined callback
 656         @param aSource      glBitmap to read data from
 657         @param aFunc        callback to use for converting
 658         @param aCreateTemp  create a temporary buffer to use for converting
 659         @param aFormat      format of the new data
 660         @param aArgs        user defined paramters (use at will)
 661         @returns            @true if converting was successful, @false otherwise }
 662     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 663       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 664
 665     { convert texture data using a specific format
 666         @param aFormat  new format of texture data
 667         @returns        @true if converting was successful, @false otherwise }
 668     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 669
 670 {$IFDEF GLB_SDL}
 671   public { SDL }
 672
 673     { assign texture data to SDL surface
 674         @param aSurface SDL surface to write data to
 675         @returns        @true on success, @false otherwise }
 676     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 677
 678     { assign texture data from SDL surface
 679         @param aSurface SDL surface to read data from
 680         @returns        @true on success, @false otherwise }
 681     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 682
 683     { assign alpha channel data to SDL surface
 684         @param aSurface SDL surface to write alpha channel data to
 685         @returns        @true on success, @false otherwise }
 686     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 687
 688     { assign alpha channel data from SDL surface
 689         @param aSurface SDL surface to read data from
 690         @param aFunc    callback to use for converting
 691         @param aArgs    user defined parameters (use at will)
 692         @returns        @true on success, @false otherwise }
 693     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 694 {$ENDIF}
 695
 696 {$IFDEF GLB_DELPHI}
 697   public { Delphi }
 698
 699     { assign texture data to TBitmap object
 700         @param aBitmap  TBitmap to write data to
 701         @returns        @true on success, @false otherwise }
 702     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 703
 704     { assign texture data from TBitmap object
 705         @param aBitmap  TBitmap to read data from
 706         @returns        @true on success, @false otherwise }
 707     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 708
 709     { assign alpha channel data to TBitmap object
 710         @param aBitmap  TBitmap to write data to
 711         @returns        @true on success, @false otherwise }
 712     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 713
 714     { assign alpha channel data from TBitmap object
 715         @param aBitmap  TBitmap to read data from
 716         @param aFunc    callback to use for converting
 717         @param aArgs    user defined parameters (use at will)
 718         @returns        @true on success, @false otherwise }
 719     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 720 {$ENDIF}
 721
 722 {$IFDEF GLB_LAZARUS}
 723   public { Lazarus }
 724
 725     { assign texture data to TLazIntfImage object
 726         @param aImage   TLazIntfImage to write data to
 727         @returns        @true on success, @false otherwise }
 728     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 729
 730     { assign texture data from TLazIntfImage object
 731         @param aImage   TLazIntfImage to read data from
 732         @returns        @true on success, @false otherwise }
 733     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 734
 735     { assign alpha channel data to TLazIntfImage object
 736         @param aImage   TLazIntfImage to write data to
 737         @returns        @true on success, @false otherwise }
 738     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 739
 740     { assign alpha channel data from TLazIntfImage object
 741         @param aImage   TLazIntfImage to read data from
 742         @param aFunc    callback to use for converting
 743         @param aArgs    user defined parameters (use at will)
 744         @returns        @true on success, @false otherwise }
 745     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 746 {$ENDIF}
 747
 748   public { Alpha }
 749     { load alpha channel data from resource
 750         @param aInstance  resource handle
 751         @param aResource  resource ID
 752         @param aResType   resource type
 753         @param aFunc      callback to use for converting
 754         @param aArgs      user defined parameters (use at will)
 755         @returns          @true on success, @false otherwise }
 756     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 757
 758     { load alpha channel data from resource ID
 759         @param aInstance    resource handle
 760         @param aResourceID  resource ID
 761         @param aResType     resource type
 762         @param aFunc        callback to use for converting
 763         @param aArgs        user defined parameters (use at will)
 764         @returns            @true on success, @false otherwise }
 765     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 766
 767     { add alpha channel data from function
 768         @param aFunc  callback to get data from
 769         @param aArgs  user defined parameters (use at will)
 770         @returns      @true on success, @false otherwise }
 771     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 772
 773     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 774         @param aFilename  file to load alpha channel data from
 775         @param aFunc      callback to use for converting
 776         @param aArgs     SetFormat user defined parameters (use at will)
 777         @returns          @true on success, @false otherwise }
 778     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 779
 780     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 781         @param aStream  stream to load alpha channel data from
 782         @param aFunc    callback to use for converting
 783         @param aArgs    user defined parameters (use at will)
 784         @returns        @true on success, @false otherwise }
 785     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 786
 787     { add alpha channel data from existing glBitmap object
 788         @param aBitmap  TglBitmap to copy alpha channel data from
 789         @param aFunc    callback to use for converting
 790         @param aArgs    user defined parameters (use at will)
 791         @returns        @true on success, @false otherwise }
 792     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 793
 794     { add alpha to pixel if the pixels color is greter than the given color value
 795         @param aRed         red threshold (0-255)
 796         @param aGreen       green threshold (0-255)
 797         @param aBlue        blue threshold (0-255)
 798         @param aDeviatation accepted deviatation (0-255)
 799         @returns            @true on success, @false otherwise }
 800     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 801
 802     { add alpha to pixel if the pixels color is greter than the given color value
 803         @param aRed         red threshold (0-Range.r)
 804         @param aGreen       green threshold (0-Range.g)
 805         @param aBlue        blue threshold (0-Range.b)
 806         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 807         @returns            @true on success, @false otherwise }
 808     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 809
 810     { add alpha to pixel if the pixels color is greter than the given color value
 811         @param aRed         red threshold (0.0-1.0)
 812         @param aGreen       green threshold (0.0-1.0)
 813         @param aBlue        blue threshold (0.0-1.0)
 814         @param aDeviatation accepted deviatation (0.0-1.0)
 815         @returns            @true on success, @false otherwise }
 816     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 817
 818     { add a constand alpha value to all pixels
 819         @param aAlpha alpha value to add (0-255)
 820         @returns      @true on success, @false otherwise }
 821     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 822
 823     { add a constand alpha value to all pixels
 824         @param aAlpha alpha value to add (0-max(Range.rgb))
 825         @returns      @true on success, @false otherwise }
 826     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 827
 828     { add a constand alpha value to all pixels
 829         @param aAlpha alpha value to add (0.0-1.0)
 830         @returns      @true on success, @false otherwise }
 831     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 832
 833     { remove alpha channel
 834         @returns  @true on success, @false otherwise }
 835     function RemoveAlpha: Boolean; virtual;
 836
 837   public { fill }
 838     { fill complete texture with one color
 839         @param aRed   red color for border (0-255)
 840         @param aGreen green color for border (0-255)
 841         @param aBlue  blue color for border (0-255)
 842         @param aAlpha alpha color for border (0-255) }
 843     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 844
 845     { fill complete texture with one color
 846         @param aRed   red color for border (0-Range.r)
 847         @param aGreen green color for border (0-Range.g)
 848         @param aBlue  blue color for border (0-Range.b)
 849         @param aAlpha alpha color for border (0-Range.a) }
 850     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 851
 852     { fill complete texture with one color
 853         @param aRed   red color for border (0.0-1.0)
 854         @param aGreen green color for border (0.0-1.0)
 855         @param aBlue  blue color for border (0.0-1.0)
 856         @param aAlpha alpha color for border (0.0-1.0) }
 857     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 858
 859   public { Misc }
 860
 861     { set data pointer of texture data
 862         @param aData    pointer to new texture data
 863         @param aFormat  format of the data stored at aData
 864         @param aWidth   width of the texture data
 865         @param aHeight  height of the texture data }
 866     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 867       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 868
 869       { create a clone of the current object
 870         @returns clone of this object}
 871     function Clone: TglBitmapData;
 872
 873     { invert color data (bitwise not)
 874         @param aRed     invert red channel
 875         @param aGreen   invert green channel
 876         @param aBlue    invert blue channel
 877         @param aAlpha   invert alpha channel }
 878     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 879
 880     { create normal map from texture data
 881         @param aFunc      normal map function to generate normalmap with
 882         @param aScale     scale of the normale stored in the normal map
 883         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 884     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 885       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 886
 887   public { constructor }
 888
 889     { constructor - creates a texutre data object }
 890     constructor Create; overload;
 891
 892     { constructor - creates a texture data object and loads it from a file
 893         @param aFilename file to load texture from }
 894     constructor Create(const aFileName: String); overload;
 895
 896     { constructor - creates a texture data object and loads it from a stream
 897         @param aStream stream to load texture from }
 898     constructor Create(const aStream: TStream); overload;
 899
 900     { constructor - creates a texture data object with the given size, format and data
 901         @param aSize    size of the texture
 902         @param aFormat  format of the given data
 903         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 904     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 905
 906     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 907         @param aSize    size of the texture
 908         @param aFormat  format of the given data
 909         @param aFunc    callback to use for generating the data
 910         @param aArgs    user defined parameters (use at will) }
 911     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 912
 913     { constructor - creates a texture data object and loads it from a resource
 914         @param aInstance  resource handle
 915         @param aResource  resource indentifier
 916         @param aResType   resource type (if known) }
 917     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 918
 919     { constructor - creates a texture data object and loads it from a resource
 920         @param aInstance    resource handle
 921         @param aResourceID  resource ID
 922         @param aResType     resource type (if known) }
 923     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 924
 925     { destructor }
 926     destructor Destroy; override;
 927
 928   end;
 929
 930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 931   { base class for all glBitmap classes. used to manage OpenGL texture objects
 932     all operations on a bitmap object must be done from the render thread }
 933   TglBitmap = class
 934   protected
 935     fID: GLuint;                          //< name of the OpenGL texture object
 936     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 937     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 938
 939     // texture properties
 940     fFilterMin: GLenum;                   //< min filter to apply to the texture
 941     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 942     fWrapS: GLenum;                       //< texture wrapping for x axis
 943     fWrapT: GLenum;                       //< texture wrapping for y axis
 944     fWrapR: GLenum;                       //< texture wrapping for z axis
 945     fAnisotropic: Integer;                //< anisotropic level
 946     fBorderColor: array[0..3] of Single;  //< color of the texture border
 947
 948 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 949     //Swizzle
 950     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 951 {$IFEND}
 952 {$IFNDEF OPENGL_ES}
 953     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 954 {$ENDIF}
 955
 956     fDimension: TglBitmapSize;            //< size of this texture
 957     fMipMap: TglBitmapMipMap;             //< mipmap type
 958
 959     // CustomData
 960     fCustomData: Pointer;                 //< user defined data
 961     fCustomName: String;                  //< user defined name
 962     fCustomNameW: WideString;             //< user defined name
 963   protected
 964     { @returns the actual width of the texture }
 965     function GetWidth:  Integer; virtual;
 966
 967     { @returns the actual height of the texture }
 968     function GetHeight: Integer; virtual;
 969
 970   protected
 971     { set a new value for fCustomData }
 972     procedure SetCustomData(const aValue: Pointer);
 973
 974     { set a new value for fCustomName }
 975     procedure SetCustomName(const aValue: String);
 976
 977     { set a new value for fCustomNameW }
 978     procedure SetCustomNameW(const aValue: WideString);
 979
 980     { set new value for fDeleteTextureOnFree }
 981     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 982
 983     { set name of OpenGL texture object }
 984     procedure SetID(const aValue: Cardinal);
 985
 986     { set new value for fMipMap }
 987     procedure SetMipMap(const aValue: TglBitmapMipMap);
 988
 989     { set new value for target }
 990     procedure SetTarget(const aValue: Cardinal);
 991
 992     { set new value for fAnisotrophic }
 993     procedure SetAnisotropic(const aValue: Integer);
 994
 995   protected
 996     { create OpenGL texture object (delete exisiting object if exists) }
 997     procedure CreateID;
 998
 999     { setup texture parameters }
1000     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1001
1002   protected
1003     property Width:  Integer read GetWidth;   //< the actual width of the texture
1004     property Height: Integer read GetHeight;  //< the actual height of the texture
1005
1006   public
1007     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1008     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1009     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1010
1011     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1012     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1013
1014     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1015     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1016     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1017
1018     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1019 {$IFNDEF OPENGL_ES}
1020     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1021 {$ENDIF}
1022
1023     { this method is called after the constructor and sets the default values of this object }
1024     procedure AfterConstruction; override;
1025
1026     { this method is called before the destructor and does some cleanup }
1027     procedure BeforeDestruction; override;
1028
1029   public
1030 {$IFNDEF OPENGL_ES}
1031     { set the new value for texture border color
1032         @param aRed   red color for border (0.0-1.0)
1033         @param aGreen green color for border (0.0-1.0)
1034         @param aBlue  blue color for border (0.0-1.0)
1035         @param aAlpha alpha color for border (0.0-1.0) }
1036     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1037 {$ENDIF}
1038
1039   public
1040     { set new texture filer
1041         @param aMin   min filter
1042         @param aMag   mag filter }
1043     procedure SetFilter(const aMin, aMag: GLenum);
1044
1045     { set new texture wrapping
1046         @param S  texture wrapping for x axis
1047         @param T  texture wrapping for y axis
1048         @param R  texture wrapping for z axis }
1049     procedure SetWrap(
1050       const S: GLenum = GL_CLAMP_TO_EDGE;
1051       const T: GLenum = GL_CLAMP_TO_EDGE;
1052       const R: GLenum = GL_CLAMP_TO_EDGE);
1053
1054 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1055     { set new swizzle
1056         @param r  swizzle for red channel
1057         @param g  swizzle for green channel
1058         @param b  swizzle for blue channel
1059         @param a  swizzle for alpha channel }
1060     procedure SetSwizzle(const r, g, b, a: GLenum);
1061 {$IFEND}
1062
1063   public
1064     { bind texture
1065         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1066     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1067
1068     { bind texture
1069         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1070     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1071
1072     { upload texture data from given data object to video card
1073         @param aData        texture data object that contains the actual data
1074         @param aCheckSize   check size before upload and throw exception if something is wrong }
1075     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1076
1077 {$IFNDEF OPENGL_ES}
1078     { download texture data from video card and store it into given data object
1079         @returns @true when download was successfull, @false otherwise }
1080     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1081 {$ENDIF}
1082   public
1083     { constructor - creates an empty texture }
1084     constructor Create; overload;
1085
1086     { constructor - creates an texture object and uploads the given data }
1087     constructor Create(const aData: TglBitmapData); overload;
1088
1089   end;
1090
1091 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1092 {$IF NOT DEFINED(OPENGL_ES)}
1093   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1094     all operations on a bitmap object must be done from the render thread }
1095   TglBitmap1D = class(TglBitmap)
1096   protected
1097
1098     { upload the texture data to video card
1099         @param aDataObj       texture data object that contains the actual data
1100         @param aBuildWithGlu  use glu functions to build mipmaps }
1101     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1102
1103   public
1104     property Width; //< actual with of the texture
1105
1106     { this method is called after constructor and initializes the object }
1107     procedure AfterConstruction; override;
1108
1109     { upload texture data from given data object to video card
1110         @param aData        texture data object that contains the actual data
1111         @param aCheckSize   check size before upload and throw exception if something is wrong }
1112     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1113
1114   end;
1115 {$IFEND}
1116
1117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1118   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1119     all operations on a bitmap object must be done from the render thread }
1120   TglBitmap2D = class(TglBitmap)
1121   protected
1122
1123     { upload the texture data to video card
1124         @param aDataObj       texture data object that contains the actual data
1125         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1126         @param aBuildWithGlu  use glu functions to build mipmaps }
1127     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1128       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1129
1130   public
1131     property Width;   //< actual width of the texture
1132     property Height;  //< actual height of the texture
1133
1134     { this method is called after constructor and initializes the object }
1135     procedure AfterConstruction; override;
1136
1137     { upload texture data from given data object to video card
1138         @param aData        texture data object that contains the actual data
1139         @param aCheckSize   check size before upload and throw exception if something is wrong }
1140     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1141
1142   public
1143
1144     { copy a part of the frame buffer to the texture
1145         @param aTop     topmost pixel to copy
1146         @param aLeft    leftmost pixel to copy
1147         @param aRight   rightmost pixel to copy
1148         @param aBottom  bottommost pixel to copy
1149         @param aFormat  format to store data in
1150         @param aDataObj texture data object to store the data in }
1151     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1152
1153   end;
1154
1155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1156 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1157   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1158     all operations on a bitmap object must be done from the render thread }
1159   TglBitmapCubeMap = class(TglBitmap2D)
1160   protected
1161   {$IFNDEF OPENGL_ES}
1162     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1163   {$ENDIF}
1164
1165   public
1166     { this method is called after constructor and initializes the object }
1167     procedure AfterConstruction; override;
1168
1169     { upload texture data from given data object to video card
1170         @param aData        texture data object that contains the actual data
1171         @param aCheckSize   check size before upload and throw exception if something is wrong }
1172     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1173
1174     { upload texture data from given data object to video card
1175         @param aData        texture data object that contains the actual data
1176         @param aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1177         @param aCheckSize   check size before upload and throw exception if something is wrong }
1178     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1179
1180     { bind texture
1181         @param aEnableTexCoordsGen  enable cube map generator
1182         @param aEnableTextureUnit   enable texture unit }
1183     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1184
1185     { unbind texture
1186         @param aDisableTexCoordsGen   disable cube map generator
1187         @param aDisableTextureUnit    disable texture unit }
1188     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1189   end;
1190 {$IFEND}
1191
1192 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1194   { wrapper class for cube normal maps
1195     all operations on a bitmap object must be done from the render thread }
1196   TglBitmapNormalMap = class(TglBitmapCubeMap)
1197   public
1198     { this method is called after constructor and initializes the object }
1199     procedure AfterConstruction; override;
1200
1201     { create cube normal map from texture data and upload it to video card
1202         @param aSize        size of each cube map texture
1203         @param aCheckSize   check size before upload and throw exception if something is wrong }
1204     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1205   end;
1206 {$IFEND}
1207
1208 const
1209   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1210
1211 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1212 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1213 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1214 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1215 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1216 procedure glBitmapSetDefaultWrap(
1217   const S: Cardinal = GL_CLAMP_TO_EDGE;
1218   const T: Cardinal = GL_CLAMP_TO_EDGE;
1219   const R: Cardinal = GL_CLAMP_TO_EDGE);
1220
1221 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1222 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1223 {$IFEND}
1224
1225 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1226 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1227 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1228 function glBitmapGetDefaultFormat: TglBitmapFormat;
1229 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1230 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1231 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1232 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1233 {$IFEND}
1234
1235 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1236 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1237 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1238 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1239 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1240 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1241 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1242
1243 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1244
1245 {$IFDEF GLB_DELPHI}
1246 function CreateGrayPalette: HPALETTE;
1247 {$ENDIF}
1248
1249 implementation
1250
1251 uses
1252   Math, syncobjs, typinfo
1253   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1254
1255
1256 var
1257   glBitmapDefaultDeleteTextureOnFree: Boolean;
1258   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1259   glBitmapDefaultFormat: TglBitmapFormat;
1260   glBitmapDefaultMipmap: TglBitmapMipMap;
1261   glBitmapDefaultFilterMin: Cardinal;
1262   glBitmapDefaultFilterMag: Cardinal;
1263   glBitmapDefaultWrapS: Cardinal;
1264   glBitmapDefaultWrapT: Cardinal;
1265   glBitmapDefaultWrapR: Cardinal;
1266   glDefaultSwizzle: array[0..3] of GLenum;
1267
1268 ////////////////////////////////////////////////////////////////////////////////////////////////////
1269 type
1270   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1271   public
1272     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1273     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1274
1275     function CreateMappingData: Pointer; virtual;
1276     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1277
1278     function IsEmpty: Boolean; virtual;
1279     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1280
1281     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1282
1283     constructor Create; virtual;
1284   public
1285     class procedure Init;
1286     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1287     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1288     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1289     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1290     class procedure Clear;
1291     class procedure Finalize;
1292   end;
1293   TFormatDescriptorClass = class of TFormatDescriptor;
1294
1295   TfdEmpty = class(TFormatDescriptor);
1296
1297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1298   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1299     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1300     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1301   end;
1302
1303   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1304     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1305     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1306   end;
1307
1308   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1309     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311   end;
1312
1313   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1314     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1315     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1316   end;
1317
1318   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1319     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321   end;
1322
1323   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1324     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1325     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1326   end;
1327
1328   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1329     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1330     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1331   end;
1332
1333   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1334     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1335     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1336   end;
1337
1338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1339   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1340     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1341     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1342   end;
1343
1344   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1345     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1346     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1347   end;
1348
1349   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1350     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1351     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1352   end;
1353
1354   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1355     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1356     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1357   end;
1358
1359   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1360     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1361     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1362   end;
1363
1364   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1365     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1366     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1367   end;
1368
1369   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1370     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1371     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1372   end;
1373
1374   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1375     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1376     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1377   end;
1378
1379   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1380     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1381     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1382   end;
1383
1384   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1385     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1386     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1387   end;
1388
1389   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1390     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1391     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1392   end;
1393
1394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1395   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1396     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1397     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1398   end;
1399
1400   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1401     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1402     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1403   end;
1404
1405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1406   TfdAlpha4ub1 = class(TfdAlphaUB1)
1407     procedure SetValues; override;
1408   end;
1409
1410   TfdAlpha8ub1 = class(TfdAlphaUB1)
1411     procedure SetValues; override;
1412   end;
1413
1414   TfdAlpha16us1 = class(TfdAlphaUS1)
1415     procedure SetValues; override;
1416   end;
1417
1418   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1419     procedure SetValues; override;
1420   end;
1421
1422   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1423     procedure SetValues; override;
1424   end;
1425
1426   TfdLuminance16us1 = class(TfdLuminanceUS1)
1427     procedure SetValues; override;
1428   end;
1429
1430   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1431     procedure SetValues; override;
1432   end;
1433
1434   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1435     procedure SetValues; override;
1436   end;
1437
1438   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1439     procedure SetValues; override;
1440   end;
1441
1442   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1443     procedure SetValues; override;
1444   end;
1445
1446   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1447     procedure SetValues; override;
1448   end;
1449
1450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1451   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1452     procedure SetValues; override;
1453   end;
1454
1455   TfdRGBX4us1 = class(TfdUniversalUS1)
1456     procedure SetValues; override;
1457   end;
1458
1459   TfdXRGB4us1 = class(TfdUniversalUS1)
1460     procedure SetValues; override;
1461   end;
1462
1463   TfdR5G6B5us1 = class(TfdUniversalUS1)
1464     procedure SetValues; override;
1465   end;
1466
1467   TfdRGB5X1us1 = class(TfdUniversalUS1)
1468     procedure SetValues; override;
1469   end;
1470
1471   TfdX1RGB5us1 = class(TfdUniversalUS1)
1472     procedure SetValues; override;
1473   end;
1474
1475   TfdRGB8ub3 = class(TfdRGBub3)
1476     procedure SetValues; override;
1477   end;
1478
1479   TfdRGBX8ui1 = class(TfdUniversalUI1)
1480     procedure SetValues; override;
1481   end;
1482
1483   TfdXRGB8ui1 = class(TfdUniversalUI1)
1484     procedure SetValues; override;
1485   end;
1486
1487   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1488     procedure SetValues; override;
1489   end;
1490
1491   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1492     procedure SetValues; override;
1493   end;
1494
1495   TfdRGB16us3 = class(TfdRGBus3)
1496     procedure SetValues; override;
1497   end;
1498
1499   TfdRGBA4us1 = class(TfdUniversalUS1)
1500     procedure SetValues; override;
1501   end;
1502
1503   TfdARGB4us1 = class(TfdUniversalUS1)
1504     procedure SetValues; override;
1505   end;
1506
1507   TfdRGB5A1us1 = class(TfdUniversalUS1)
1508     procedure SetValues; override;
1509   end;
1510
1511   TfdA1RGB5us1 = class(TfdUniversalUS1)
1512     procedure SetValues; override;
1513   end;
1514
1515   TfdRGBA8ui1 = class(TfdUniversalUI1)
1516     procedure SetValues; override;
1517   end;
1518
1519   TfdARGB8ui1 = class(TfdUniversalUI1)
1520     procedure SetValues; override;
1521   end;
1522
1523   TfdRGBA8ub4 = class(TfdRGBAub4)
1524     procedure SetValues; override;
1525   end;
1526
1527   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1528     procedure SetValues; override;
1529   end;
1530
1531   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1532     procedure SetValues; override;
1533   end;
1534
1535   TfdRGBA16us4 = class(TfdRGBAus4)
1536     procedure SetValues; override;
1537   end;
1538
1539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1540   TfdBGRX4us1 = class(TfdUniversalUS1)
1541     procedure SetValues; override;
1542   end;
1543
1544   TfdXBGR4us1 = class(TfdUniversalUS1)
1545     procedure SetValues; override;
1546   end;
1547
1548   TfdB5G6R5us1 = class(TfdUniversalUS1)
1549     procedure SetValues; override;
1550   end;
1551
1552   TfdBGR5X1us1 = class(TfdUniversalUS1)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdX1BGR5us1 = class(TfdUniversalUS1)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdBGR8ub3 = class(TfdBGRub3)
1561     procedure SetValues; override;
1562   end;
1563
1564   TfdBGRX8ui1 = class(TfdUniversalUI1)
1565     procedure SetValues; override;
1566   end;
1567
1568   TfdXBGR8ui1 = class(TfdUniversalUI1)
1569     procedure SetValues; override;
1570   end;
1571
1572   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1573     procedure SetValues; override;
1574   end;
1575
1576   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1577     procedure SetValues; override;
1578   end;
1579
1580   TfdBGR16us3 = class(TfdBGRus3)
1581     procedure SetValues; override;
1582   end;
1583
1584   TfdBGRA4us1 = class(TfdUniversalUS1)
1585     procedure SetValues; override;
1586   end;
1587
1588   TfdABGR4us1 = class(TfdUniversalUS1)
1589     procedure SetValues; override;
1590   end;
1591
1592   TfdBGR5A1us1 = class(TfdUniversalUS1)
1593     procedure SetValues; override;
1594   end;
1595
1596   TfdA1BGR5us1 = class(TfdUniversalUS1)
1597     procedure SetValues; override;
1598   end;
1599
1600   TfdBGRA8ui1 = class(TfdUniversalUI1)
1601     procedure SetValues; override;
1602   end;
1603
1604   TfdABGR8ui1 = class(TfdUniversalUI1)
1605     procedure SetValues; override;
1606   end;
1607
1608   TfdBGRA8ub4 = class(TfdBGRAub4)
1609     procedure SetValues; override;
1610   end;
1611
1612   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1613     procedure SetValues; override;
1614   end;
1615
1616   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1617     procedure SetValues; override;
1618   end;
1619
1620   TfdBGRA16us4 = class(TfdBGRAus4)
1621     procedure SetValues; override;
1622   end;
1623
1624   TfdDepth16us1 = class(TfdDepthUS1)
1625     procedure SetValues; override;
1626   end;
1627
1628   TfdDepth24ui1 = class(TfdDepthUI1)
1629     procedure SetValues; override;
1630   end;
1631
1632   TfdDepth32ui1 = class(TfdDepthUI1)
1633     procedure SetValues; override;
1634   end;
1635
1636   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1637     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1638     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1639     procedure SetValues; override;
1640   end;
1641
1642   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1643     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1644     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1645     procedure SetValues; override;
1646   end;
1647
1648   TfdS3tcDtx5RGBA = 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 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655   TbmpBitfieldFormat = class(TFormatDescriptor)
1656   public
1657     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1658     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1659     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1660     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1661   end;
1662
1663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1664   TbmpColorTableEnty = packed record
1665     b, g, r, a: Byte;
1666   end;
1667   TbmpColorTable = array of TbmpColorTableEnty;
1668   TbmpColorTableFormat = class(TFormatDescriptor)
1669   private
1670     fColorTable: TbmpColorTable;
1671   protected
1672     procedure SetValues; override;
1673   public
1674     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1675
1676     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1677     procedure CalcValues;
1678     procedure CreateColorTable;
1679
1680     function CreateMappingData: Pointer; override;
1681     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1682     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1683     destructor Destroy; override;
1684   end;
1685
1686 const
1687   LUMINANCE_WEIGHT_R = 0.30;
1688   LUMINANCE_WEIGHT_G = 0.59;
1689   LUMINANCE_WEIGHT_B = 0.11;
1690
1691   ALPHA_WEIGHT_R = 0.30;
1692   ALPHA_WEIGHT_G = 0.59;
1693   ALPHA_WEIGHT_B = 0.11;
1694
1695   DEPTH_WEIGHT_R = 0.333333333;
1696   DEPTH_WEIGHT_G = 0.333333333;
1697   DEPTH_WEIGHT_B = 0.333333333;
1698
1699   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1700     TfdEmpty,
1701
1702     TfdAlpha4ub1,
1703     TfdAlpha8ub1,
1704     TfdAlpha16us1,
1705
1706     TfdLuminance4ub1,
1707     TfdLuminance8ub1,
1708     TfdLuminance16us1,
1709
1710     TfdLuminance4Alpha4ub2,
1711     TfdLuminance6Alpha2ub2,
1712     TfdLuminance8Alpha8ub2,
1713     TfdLuminance12Alpha4us2,
1714     TfdLuminance16Alpha16us2,
1715
1716     TfdR3G3B2ub1,
1717     TfdRGBX4us1,
1718     TfdXRGB4us1,
1719     TfdR5G6B5us1,
1720     TfdRGB5X1us1,
1721     TfdX1RGB5us1,
1722     TfdRGB8ub3,
1723     TfdRGBX8ui1,
1724     TfdXRGB8ui1,
1725     TfdRGB10X2ui1,
1726     TfdX2RGB10ui1,
1727     TfdRGB16us3,
1728
1729     TfdRGBA4us1,
1730     TfdARGB4us1,
1731     TfdRGB5A1us1,
1732     TfdA1RGB5us1,
1733     TfdRGBA8ui1,
1734     TfdARGB8ui1,
1735     TfdRGBA8ub4,
1736     TfdRGB10A2ui1,
1737     TfdA2RGB10ui1,
1738     TfdRGBA16us4,
1739
1740     TfdBGRX4us1,
1741     TfdXBGR4us1,
1742     TfdB5G6R5us1,
1743     TfdBGR5X1us1,
1744     TfdX1BGR5us1,
1745     TfdBGR8ub3,
1746     TfdBGRX8ui1,
1747     TfdXBGR8ui1,
1748     TfdBGR10X2ui1,
1749     TfdX2BGR10ui1,
1750     TfdBGR16us3,
1751
1752     TfdBGRA4us1,
1753     TfdABGR4us1,
1754     TfdBGR5A1us1,
1755     TfdA1BGR5us1,
1756     TfdBGRA8ui1,
1757     TfdABGR8ui1,
1758     TfdBGRA8ub4,
1759     TfdBGR10A2ui1,
1760     TfdA2BGR10ui1,
1761     TfdBGRA16us4,
1762
1763     TfdDepth16us1,
1764     TfdDepth24ui1,
1765     TfdDepth32ui1,
1766
1767     TfdS3tcDtx1RGBA,
1768     TfdS3tcDtx3RGBA,
1769     TfdS3tcDtx5RGBA
1770   );
1771
1772 var
1773   FormatDescriptorCS: TCriticalSection;
1774   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1775
1776 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1777 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1778 begin
1779   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1780 end;
1781
1782 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1783 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1784 begin
1785   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1786 end;
1787
1788 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1789 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1790 begin
1791   result.Fields := [];
1792   if (X >= 0) then
1793     result.Fields := result.Fields + [ffX];
1794   if (Y >= 0) then
1795     result.Fields := result.Fields + [ffY];
1796   result.X := Max(0, X);
1797   result.Y := Max(0, Y);
1798 end;
1799
1800 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1801 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1802 begin
1803   result := glBitmapSize(X, Y);
1804 end;
1805
1806 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1807 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1808 begin
1809   result.r := r;
1810   result.g := g;
1811   result.b := b;
1812   result.a := a;
1813 end;
1814
1815 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1817 begin
1818   result.r := r;
1819   result.g := g;
1820   result.b := b;
1821   result.a := a;
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1826 begin
1827   result.r := r;
1828   result.g := g;
1829   result.b := b;
1830   result.a := a;
1831 end;
1832
1833 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1834 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1835 var
1836   i: Integer;
1837 begin
1838   result := false;
1839   for i := 0 to high(r1.arr) do
1840     if (r1.arr[i] <> r2.arr[i]) then
1841       exit;
1842   result := true;
1843 end;
1844
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1846 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): 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 glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1859 var
1860   desc: TFormatDescriptor;
1861   p, tmp: PByte;
1862   x, y, i: Integer;
1863   md: Pointer;
1864   px: TglBitmapPixelData;
1865 begin
1866   result := nil;
1867   desc := TFormatDescriptor.Get(aFormat);
1868   if (desc.IsCompressed) or (desc.glFormat = 0) then
1869     exit;
1870
1871   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1872   md := desc.CreateMappingData;
1873   try
1874     tmp := p;
1875     desc.PreparePixel(px);
1876     for y := 0 to 4 do
1877       for x := 0 to 4 do begin
1878         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1879         for i := 0 to 3 do begin
1880           if ((y < 3) and (y = i)) or
1881              ((y = 3) and (i < 3)) or
1882              ((y = 4) and (i = 3))
1883           then
1884             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1885           else if ((y < 4) and (i = 3)) or
1886                   ((y = 4) and (i < 3))
1887           then
1888             px.Data.arr[i] := px.Range.arr[i]
1889           else
1890             px.Data.arr[i] := 0; //px.Range.arr[i];
1891         end;
1892         desc.Map(px, tmp, md);
1893       end;
1894   finally
1895     desc.FreeMappingData(md);
1896   end;
1897
1898   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1899 end;
1900
1901 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1902 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1903 begin
1904   result.r := r;
1905   result.g := g;
1906   result.b := b;
1907   result.a := a;
1908 end;
1909
1910 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1911 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1912 begin
1913   result := [];
1914
1915   if (aFormat in [
1916         //8bpp
1917         tfAlpha4ub1, tfAlpha8ub1,
1918         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1919
1920         //16bpp
1921         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1922         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1923         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1924
1925         //24bpp
1926         tfBGR8ub3, tfRGB8ub3,
1927
1928         //32bpp
1929         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1930         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1931   then
1932     result := result + [ ftBMP ];
1933
1934   if (aFormat in [
1935         //8bbp
1936         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1937
1938         //16bbp
1939         tfAlpha16us1, tfLuminance16us1,
1940         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1941         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1942
1943         //24bbp
1944         tfBGR8ub3,
1945
1946         //32bbp
1947         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1948         tfDepth24ui1, tfDepth32ui1])
1949   then
1950     result := result + [ftTGA];
1951
1952   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1953     result := result + [ftDDS];
1954
1955 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1956   if aFormat in [
1957       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1958       tfRGB8ub3, tfRGBA8ui1,
1959       tfBGR8ub3, tfBGRA8ui1] then
1960     result := result + [ftPNG];
1961 {$ENDIF}
1962
1963 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1964   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1965     result := result + [ftJPEG];
1966 {$ENDIF}
1967 end;
1968
1969 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1970 function IsPowerOfTwo(aNumber: Integer): Boolean;
1971 begin
1972   while (aNumber and 1) = 0 do
1973     aNumber := aNumber shr 1;
1974   result := aNumber = 1;
1975 end;
1976
1977 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1978 function GetTopMostBit(aBitSet: QWord): Integer;
1979 begin
1980   result := 0;
1981   while aBitSet > 0 do begin
1982     inc(result);
1983     aBitSet := aBitSet shr 1;
1984   end;
1985 end;
1986
1987 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1988 function CountSetBits(aBitSet: QWord): Integer;
1989 begin
1990   result := 0;
1991   while aBitSet > 0 do begin
1992     if (aBitSet and 1) = 1 then
1993       inc(result);
1994     aBitSet := aBitSet shr 1;
1995   end;
1996 end;
1997
1998 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1999 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2000 begin
2001   result := Trunc(
2002     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2003     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2004     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2005 end;
2006
2007 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2008 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2009 begin
2010   result := Trunc(
2011     DEPTH_WEIGHT_R * aPixel.Data.r +
2012     DEPTH_WEIGHT_G * aPixel.Data.g +
2013     DEPTH_WEIGHT_B * aPixel.Data.b);
2014 end;
2015
2016 {$IFDEF GLB_SDL_IMAGE}
2017 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2018 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2019 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2020 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2021 begin
2022   result := TStream(context^.unknown.data1).Seek(offset, whence);
2023 end;
2024
2025 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2026 begin
2027   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2028 end;
2029
2030 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2031 begin
2032   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2033 end;
2034
2035 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2036 begin
2037   result := 0;
2038 end;
2039
2040 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2041 begin
2042   result := SDL_AllocRW;
2043
2044   if result = nil then
2045     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2046
2047   result^.seek := glBitmapRWseek;
2048   result^.read := glBitmapRWread;
2049   result^.write := glBitmapRWwrite;
2050   result^.close := glBitmapRWclose;
2051   result^.unknown.data1 := Stream;
2052 end;
2053 {$ENDIF}
2054
2055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2056 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2057 begin
2058   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2059 end;
2060
2061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2062 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2063 begin
2064   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2065 end;
2066
2067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2069 begin
2070   glBitmapDefaultMipmap := aValue;
2071 end;
2072
2073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2074 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2075 begin
2076   glBitmapDefaultFormat := aFormat;
2077 end;
2078
2079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2080 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2081 begin
2082   glBitmapDefaultFilterMin := aMin;
2083   glBitmapDefaultFilterMag := aMag;
2084 end;
2085
2086 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2088 begin
2089   glBitmapDefaultWrapS := S;
2090   glBitmapDefaultWrapT := T;
2091   glBitmapDefaultWrapR := R;
2092 end;
2093
2094 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2095 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2096 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2097 begin
2098   glDefaultSwizzle[0] := r;
2099   glDefaultSwizzle[1] := g;
2100   glDefaultSwizzle[2] := b;
2101   glDefaultSwizzle[3] := a;
2102 end;
2103 {$IFEND}
2104
2105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2106 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2107 begin
2108   result := glBitmapDefaultDeleteTextureOnFree;
2109 end;
2110
2111 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2112 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2113 begin
2114   result := glBitmapDefaultFreeDataAfterGenTextures;
2115 end;
2116
2117 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2118 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2119 begin
2120   result := glBitmapDefaultMipmap;
2121 end;
2122
2123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2124 function glBitmapGetDefaultFormat: TglBitmapFormat;
2125 begin
2126   result := glBitmapDefaultFormat;
2127 end;
2128
2129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2131 begin
2132   aMin := glBitmapDefaultFilterMin;
2133   aMag := glBitmapDefaultFilterMag;
2134 end;
2135
2136 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2137 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2138 begin
2139   S := glBitmapDefaultWrapS;
2140   T := glBitmapDefaultWrapT;
2141   R := glBitmapDefaultWrapR;
2142 end;
2143
2144 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2146 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2147 begin
2148   r := glDefaultSwizzle[0];
2149   g := glDefaultSwizzle[1];
2150   b := glDefaultSwizzle[2];
2151   a := glDefaultSwizzle[3];
2152 end;
2153 {$IFEND}
2154
2155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2156 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2158 function TFormatDescriptor.CreateMappingData: Pointer;
2159 begin
2160   result := nil;
2161 end;
2162
2163 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2164 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2165 begin
2166   //DUMMY
2167 end;
2168
2169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2170 function TFormatDescriptor.IsEmpty: Boolean;
2171 begin
2172   result := (fFormat = tfEmpty);
2173 end;
2174
2175 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2176 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2177 var
2178   i: Integer;
2179   m: TglBitmapRec4ul;
2180 begin
2181   result := false;
2182   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2183     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2184   m := Mask;
2185   for i := 0 to 3 do
2186     if (aMask.arr[i] <> m.arr[i]) then
2187       exit;
2188   result := true;
2189 end;
2190
2191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2192 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2193 begin
2194   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2195   aPixel.Data   := Range;
2196   aPixel.Format := fFormat;
2197   aPixel.Range  := Range;
2198 end;
2199
2200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2201 constructor TFormatDescriptor.Create;
2202 begin
2203   inherited Create;
2204 end;
2205
2206 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2207 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2209 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2210 begin
2211   aData^ := aPixel.Data.a;
2212   inc(aData);
2213 end;
2214
2215 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2216 begin
2217   aPixel.Data.r := 0;
2218   aPixel.Data.g := 0;
2219   aPixel.Data.b := 0;
2220   aPixel.Data.a := aData^;
2221   inc(aData);
2222 end;
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2227 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2228 begin
2229   aData^ := LuminanceWeight(aPixel);
2230   inc(aData);
2231 end;
2232
2233 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2234 begin
2235   aPixel.Data.r := aData^;
2236   aPixel.Data.g := aData^;
2237   aPixel.Data.b := aData^;
2238   aPixel.Data.a := 0;
2239   inc(aData);
2240 end;
2241
2242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2246 var
2247   i: Integer;
2248 begin
2249   aData^ := 0;
2250   for i := 0 to 3 do
2251     if (Range.arr[i] > 0) then
2252       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2253   inc(aData);
2254 end;
2255
2256 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2257 var
2258   i: Integer;
2259 begin
2260   for i := 0 to 3 do
2261     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2262   inc(aData);
2263 end;
2264
2265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2266 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2269 begin
2270   inherited Map(aPixel, aData, aMapData);
2271   aData^ := aPixel.Data.a;
2272   inc(aData);
2273 end;
2274
2275 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2276 begin
2277   inherited Unmap(aData, aPixel, aMapData);
2278   aPixel.Data.a := aData^;
2279   inc(aData);
2280 end;
2281
2282 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2283 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2286 begin
2287   aData^ := aPixel.Data.r;
2288   inc(aData);
2289   aData^ := aPixel.Data.g;
2290   inc(aData);
2291   aData^ := aPixel.Data.b;
2292   inc(aData);
2293 end;
2294
2295 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2296 begin
2297   aPixel.Data.r := aData^;
2298   inc(aData);
2299   aPixel.Data.g := aData^;
2300   inc(aData);
2301   aPixel.Data.b := aData^;
2302   inc(aData);
2303   aPixel.Data.a := 0;
2304 end;
2305
2306 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2307 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2309 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2310 begin
2311   aData^ := aPixel.Data.b;
2312   inc(aData);
2313   aData^ := aPixel.Data.g;
2314   inc(aData);
2315   aData^ := aPixel.Data.r;
2316   inc(aData);
2317 end;
2318
2319 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2320 begin
2321   aPixel.Data.b := aData^;
2322   inc(aData);
2323   aPixel.Data.g := aData^;
2324   inc(aData);
2325   aPixel.Data.r := aData^;
2326   inc(aData);
2327   aPixel.Data.a := 0;
2328 end;
2329
2330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2331 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2334 begin
2335   inherited Map(aPixel, aData, aMapData);
2336   aData^ := aPixel.Data.a;
2337   inc(aData);
2338 end;
2339
2340 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2341 begin
2342   inherited Unmap(aData, aPixel, aMapData);
2343   aPixel.Data.a := aData^;
2344   inc(aData);
2345 end;
2346
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2350 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2351 begin
2352   inherited Map(aPixel, aData, aMapData);
2353   aData^ := aPixel.Data.a;
2354   inc(aData);
2355 end;
2356
2357 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2358 begin
2359   inherited Unmap(aData, aPixel, aMapData);
2360   aPixel.Data.a := aData^;
2361   inc(aData);
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2368 begin
2369   PWord(aData)^ := aPixel.Data.a;
2370   inc(aData, 2);
2371 end;
2372
2373 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2374 begin
2375   aPixel.Data.r := 0;
2376   aPixel.Data.g := 0;
2377   aPixel.Data.b := 0;
2378   aPixel.Data.a := PWord(aData)^;
2379   inc(aData, 2);
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2385 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2386 begin
2387   PWord(aData)^ := LuminanceWeight(aPixel);
2388   inc(aData, 2);
2389 end;
2390
2391 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2392 begin
2393   aPixel.Data.r := PWord(aData)^;
2394   aPixel.Data.g := PWord(aData)^;
2395   aPixel.Data.b := PWord(aData)^;
2396   aPixel.Data.a := 0;
2397   inc(aData, 2);
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2404 var
2405   i: Integer;
2406 begin
2407   PWord(aData)^ := 0;
2408   for i := 0 to 3 do
2409     if (Range.arr[i] > 0) then
2410       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2411   inc(aData, 2);
2412 end;
2413
2414 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2415 var
2416   i: Integer;
2417 begin
2418   for i := 0 to 3 do
2419     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2420   inc(aData, 2);
2421 end;
2422
2423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2424 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2427 begin
2428   PWord(aData)^ := DepthWeight(aPixel);
2429   inc(aData, 2);
2430 end;
2431
2432 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2433 begin
2434   aPixel.Data.r := PWord(aData)^;
2435   aPixel.Data.g := PWord(aData)^;
2436   aPixel.Data.b := PWord(aData)^;
2437   aPixel.Data.a := PWord(aData)^;;
2438   inc(aData, 2);
2439 end;
2440
2441 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2442 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2445 begin
2446   inherited Map(aPixel, aData, aMapData);
2447   PWord(aData)^ := aPixel.Data.a;
2448   inc(aData, 2);
2449 end;
2450
2451 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2452 begin
2453   inherited Unmap(aData, aPixel, aMapData);
2454   aPixel.Data.a := PWord(aData)^;
2455   inc(aData, 2);
2456 end;
2457
2458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2462 begin
2463   PWord(aData)^ := aPixel.Data.r;
2464   inc(aData, 2);
2465   PWord(aData)^ := aPixel.Data.g;
2466   inc(aData, 2);
2467   PWord(aData)^ := aPixel.Data.b;
2468   inc(aData, 2);
2469 end;
2470
2471 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2472 begin
2473   aPixel.Data.r := PWord(aData)^;
2474   inc(aData, 2);
2475   aPixel.Data.g := PWord(aData)^;
2476   inc(aData, 2);
2477   aPixel.Data.b := PWord(aData)^;
2478   inc(aData, 2);
2479   aPixel.Data.a := 0;
2480 end;
2481
2482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2483 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2486 begin
2487   PWord(aData)^ := aPixel.Data.b;
2488   inc(aData, 2);
2489   PWord(aData)^ := aPixel.Data.g;
2490   inc(aData, 2);
2491   PWord(aData)^ := aPixel.Data.r;
2492   inc(aData, 2);
2493 end;
2494
2495 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2496 begin
2497   aPixel.Data.b := PWord(aData)^;
2498   inc(aData, 2);
2499   aPixel.Data.g := PWord(aData)^;
2500   inc(aData, 2);
2501   aPixel.Data.r := PWord(aData)^;
2502   inc(aData, 2);
2503   aPixel.Data.a := 0;
2504 end;
2505
2506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2507 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2509 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2510 begin
2511   inherited Map(aPixel, aData, aMapData);
2512   PWord(aData)^ := aPixel.Data.a;
2513   inc(aData, 2);
2514 end;
2515
2516 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2517 begin
2518   inherited Unmap(aData, aPixel, aMapData);
2519   aPixel.Data.a := PWord(aData)^;
2520   inc(aData, 2);
2521 end;
2522
2523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2527 begin
2528   PWord(aData)^ := aPixel.Data.a;
2529   inc(aData, 2);
2530   inherited Map(aPixel, aData, aMapData);
2531 end;
2532
2533 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2534 begin
2535   aPixel.Data.a := PWord(aData)^;
2536   inc(aData, 2);
2537   inherited Unmap(aData, aPixel, aMapData);
2538 end;
2539
2540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2541 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2544 begin
2545   inherited Map(aPixel, aData, aMapData);
2546   PWord(aData)^ := aPixel.Data.a;
2547   inc(aData, 2);
2548 end;
2549
2550 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2551 begin
2552   inherited Unmap(aData, aPixel, aMapData);
2553   aPixel.Data.a := PWord(aData)^;
2554   inc(aData, 2);
2555 end;
2556
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2561 begin
2562   PWord(aData)^ := aPixel.Data.a;
2563   inc(aData, 2);
2564   inherited Map(aPixel, aData, aMapData);
2565 end;
2566
2567 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2568 begin
2569   aPixel.Data.a := PWord(aData)^;
2570   inc(aData, 2);
2571   inherited Unmap(aData, aPixel, aMapData);
2572 end;
2573
2574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2578 var
2579   i: Integer;
2580 begin
2581   PCardinal(aData)^ := 0;
2582   for i := 0 to 3 do
2583     if (Range.arr[i] > 0) then
2584       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2585   inc(aData, 4);
2586 end;
2587
2588 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2589 var
2590   i: Integer;
2591 begin
2592   for i := 0 to 3 do
2593     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2594   inc(aData, 2);
2595 end;
2596
2597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2601 begin
2602   PCardinal(aData)^ := DepthWeight(aPixel);
2603   inc(aData, 4);
2604 end;
2605
2606 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2607 begin
2608   aPixel.Data.r := PCardinal(aData)^;
2609   aPixel.Data.g := PCardinal(aData)^;
2610   aPixel.Data.b := PCardinal(aData)^;
2611   aPixel.Data.a := PCardinal(aData)^;
2612   inc(aData, 4);
2613 end;
2614
2615 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2616 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2618 procedure TfdAlpha4ub1.SetValues;
2619 begin
2620   inherited SetValues;
2621   fBitsPerPixel     := 8;
2622   fFormat           := tfAlpha4ub1;
2623   fWithAlpha        := tfAlpha4ub1;
2624   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2625   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2626 {$IFNDEF OPENGL_ES}
2627   fOpenGLFormat     := tfAlpha4ub1;
2628   fglFormat         := GL_ALPHA;
2629   fglInternalFormat := GL_ALPHA4;
2630   fglDataFormat     := GL_UNSIGNED_BYTE;
2631 {$ELSE}
2632   fOpenGLFormat     := tfAlpha8ub1;
2633 {$ENDIF}
2634 end;
2635
2636 procedure TfdAlpha8ub1.SetValues;
2637 begin
2638   inherited SetValues;
2639   fBitsPerPixel     := 8;
2640   fFormat           := tfAlpha8ub1;
2641   fWithAlpha        := tfAlpha8ub1;
2642   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2643   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2644   fOpenGLFormat     := tfAlpha8ub1;
2645   fglFormat         := GL_ALPHA;
2646   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2647   fglDataFormat     := GL_UNSIGNED_BYTE;
2648 end;
2649
2650 procedure TfdAlpha16us1.SetValues;
2651 begin
2652   inherited SetValues;
2653   fBitsPerPixel     := 16;
2654   fFormat           := tfAlpha16us1;
2655   fWithAlpha        := tfAlpha16us1;
2656   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2657   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2658 {$IFNDEF OPENGL_ES}
2659   fOpenGLFormat     := tfAlpha16us1;
2660   fglFormat         := GL_ALPHA;
2661   fglInternalFormat := GL_ALPHA16;
2662   fglDataFormat     := GL_UNSIGNED_SHORT;
2663 {$ELSE}
2664   fOpenGLFormat     := tfAlpha8ub1;
2665 {$ENDIF}
2666 end;
2667
2668 procedure TfdLuminance4ub1.SetValues;
2669 begin
2670   inherited SetValues;
2671   fBitsPerPixel     := 8;
2672   fFormat           := tfLuminance4ub1;
2673   fWithAlpha        := tfLuminance4Alpha4ub2;
2674   fWithoutAlpha     := tfLuminance4ub1;
2675   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2676   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2677 {$IFNDEF OPENGL_ES}
2678   fOpenGLFormat     := tfLuminance4ub1;
2679   fglFormat         := GL_LUMINANCE;
2680   fglInternalFormat := GL_LUMINANCE4;
2681   fglDataFormat     := GL_UNSIGNED_BYTE;
2682 {$ELSE}
2683   fOpenGLFormat     := tfLuminance8ub1;
2684 {$ENDIF}
2685 end;
2686
2687 procedure TfdLuminance8ub1.SetValues;
2688 begin
2689   inherited SetValues;
2690   fBitsPerPixel     := 8;
2691   fFormat           := tfLuminance8ub1;
2692   fWithAlpha        := tfLuminance8Alpha8ub2;
2693   fWithoutAlpha     := tfLuminance8ub1;
2694   fOpenGLFormat     := tfLuminance8ub1;
2695   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2696   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2697   fglFormat         := GL_LUMINANCE;
2698   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2699   fglDataFormat     := GL_UNSIGNED_BYTE;
2700 end;
2701
2702 procedure TfdLuminance16us1.SetValues;
2703 begin
2704   inherited SetValues;
2705   fBitsPerPixel     := 16;
2706   fFormat           := tfLuminance16us1;
2707   fWithAlpha        := tfLuminance16Alpha16us2;
2708   fWithoutAlpha     := tfLuminance16us1;
2709   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2710   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2711 {$IFNDEF OPENGL_ES}
2712   fOpenGLFormat     := tfLuminance16us1;
2713   fglFormat         := GL_LUMINANCE;
2714   fglInternalFormat := GL_LUMINANCE16;
2715   fglDataFormat     := GL_UNSIGNED_SHORT;
2716 {$ELSE}
2717   fOpenGLFormat     := tfLuminance8ub1;
2718 {$ENDIF}
2719 end;
2720
2721 procedure TfdLuminance4Alpha4ub2.SetValues;
2722 begin
2723   inherited SetValues;
2724   fBitsPerPixel     := 16;
2725   fFormat           := tfLuminance4Alpha4ub2;
2726   fWithAlpha        := tfLuminance4Alpha4ub2;
2727   fWithoutAlpha     := tfLuminance4ub1;
2728   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2729   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2730 {$IFNDEF OPENGL_ES}
2731   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2732   fglFormat         := GL_LUMINANCE_ALPHA;
2733   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2734   fglDataFormat     := GL_UNSIGNED_BYTE;
2735 {$ELSE}
2736   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2737 {$ENDIF}
2738 end;
2739
2740 procedure TfdLuminance6Alpha2ub2.SetValues;
2741 begin
2742   inherited SetValues;
2743   fBitsPerPixel     := 16;
2744   fFormat           := tfLuminance6Alpha2ub2;
2745   fWithAlpha        := tfLuminance6Alpha2ub2;
2746   fWithoutAlpha     := tfLuminance8ub1;
2747   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2748   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2749 {$IFNDEF OPENGL_ES}
2750   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2751   fglFormat         := GL_LUMINANCE_ALPHA;
2752   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2753   fglDataFormat     := GL_UNSIGNED_BYTE;
2754 {$ELSE}
2755   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2756 {$ENDIF}
2757 end;
2758
2759 procedure TfdLuminance8Alpha8ub2.SetValues;
2760 begin
2761   inherited SetValues;
2762   fBitsPerPixel     := 16;
2763   fFormat           := tfLuminance8Alpha8ub2;
2764   fWithAlpha        := tfLuminance8Alpha8ub2;
2765   fWithoutAlpha     := tfLuminance8ub1;
2766   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2767   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2768   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2769   fglFormat         := GL_LUMINANCE_ALPHA;
2770   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2771   fglDataFormat     := GL_UNSIGNED_BYTE;
2772 end;
2773
2774 procedure TfdLuminance12Alpha4us2.SetValues;
2775 begin
2776   inherited SetValues;
2777   fBitsPerPixel     := 32;
2778   fFormat           := tfLuminance12Alpha4us2;
2779   fWithAlpha        := tfLuminance12Alpha4us2;
2780   fWithoutAlpha     := tfLuminance16us1;
2781   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2782   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2783 {$IFNDEF OPENGL_ES}
2784   fOpenGLFormat     := tfLuminance12Alpha4us2;
2785   fglFormat         := GL_LUMINANCE_ALPHA;
2786   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2787   fglDataFormat     := GL_UNSIGNED_SHORT;
2788 {$ELSE}
2789   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2790 {$ENDIF}
2791 end;
2792
2793 procedure TfdLuminance16Alpha16us2.SetValues;
2794 begin
2795   inherited SetValues;
2796   fBitsPerPixel     := 32;
2797   fFormat           := tfLuminance16Alpha16us2;
2798   fWithAlpha        := tfLuminance16Alpha16us2;
2799   fWithoutAlpha     := tfLuminance16us1;
2800   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2801   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2802 {$IFNDEF OPENGL_ES}
2803   fOpenGLFormat     := tfLuminance16Alpha16us2;
2804   fglFormat         := GL_LUMINANCE_ALPHA;
2805   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2806   fglDataFormat     := GL_UNSIGNED_SHORT;
2807 {$ELSE}
2808   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2809 {$ENDIF}
2810 end;
2811
2812 procedure TfdR3G3B2ub1.SetValues;
2813 begin
2814   inherited SetValues;
2815   fBitsPerPixel     := 8;
2816   fFormat           := tfR3G3B2ub1;
2817   fWithAlpha        := tfRGBA4us1;
2818   fWithoutAlpha     := tfR3G3B2ub1;
2819   fRGBInverted      := tfEmpty;
2820   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2821   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2822 {$IFNDEF OPENGL_ES}
2823   fOpenGLFormat     := tfR3G3B2ub1;
2824   fglFormat         := GL_RGB;
2825   fglInternalFormat := GL_R3_G3_B2;
2826   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2827 {$ELSE}
2828   fOpenGLFormat     := tfR5G6B5us1;
2829 {$ENDIF}
2830 end;
2831
2832 procedure TfdRGBX4us1.SetValues;
2833 begin
2834   inherited SetValues;
2835   fBitsPerPixel     := 16;
2836   fFormat           := tfRGBX4us1;
2837   fWithAlpha        := tfRGBA4us1;
2838   fWithoutAlpha     := tfRGBX4us1;
2839   fRGBInverted      := tfBGRX4us1;
2840   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2841   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2842 {$IFNDEF OPENGL_ES}
2843   fOpenGLFormat     := tfRGBX4us1;
2844   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2845   fglInternalFormat := GL_RGB4;
2846   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2847 {$ELSE}
2848   fOpenGLFormat     := tfR5G6B5us1;
2849 {$ENDIF}
2850 end;
2851
2852 procedure TfdXRGB4us1.SetValues;
2853 begin
2854   inherited SetValues;
2855   fBitsPerPixel     := 16;
2856   fFormat           := tfXRGB4us1;
2857   fWithAlpha        := tfARGB4us1;
2858   fWithoutAlpha     := tfXRGB4us1;
2859   fRGBInverted      := tfXBGR4us1;
2860   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2861   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2862 {$IFNDEF OPENGL_ES}
2863   fOpenGLFormat     := tfXRGB4us1;
2864   fglFormat         := GL_BGRA;
2865   fglInternalFormat := GL_RGB4;
2866   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2867 {$ELSE}
2868   fOpenGLFormat     := tfR5G6B5us1;
2869 {$ENDIF}
2870 end;
2871
2872 procedure TfdR5G6B5us1.SetValues;
2873 begin
2874   inherited SetValues;
2875   fBitsPerPixel     := 16;
2876   fFormat           := tfR5G6B5us1;
2877   fWithAlpha        := tfRGB5A1us1;
2878   fWithoutAlpha     := tfR5G6B5us1;
2879   fRGBInverted      := tfB5G6R5us1;
2880   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2881   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2882 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2883   fOpenGLFormat     := tfR5G6B5us1;
2884   fglFormat         := GL_RGB;
2885   fglInternalFormat := GL_RGB565;
2886   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2887 {$ELSE}
2888   fOpenGLFormat     := tfRGB8ub3;
2889 {$IFEND}
2890 end;
2891
2892 procedure TfdRGB5X1us1.SetValues;
2893 begin
2894   inherited SetValues;
2895   fBitsPerPixel     := 16;
2896   fFormat           := tfRGB5X1us1;
2897   fWithAlpha        := tfRGB5A1us1;
2898   fWithoutAlpha     := tfRGB5X1us1;
2899   fRGBInverted      := tfBGR5X1us1;
2900   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2901   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2902 {$IFNDEF OPENGL_ES}
2903   fOpenGLFormat     := tfRGB5X1us1;
2904   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2905   fglInternalFormat := GL_RGB5;
2906   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2907 {$ELSE}
2908   fOpenGLFormat     := tfR5G6B5us1;
2909 {$ENDIF}
2910 end;
2911
2912 procedure TfdX1RGB5us1.SetValues;
2913 begin
2914   inherited SetValues;
2915   fBitsPerPixel     := 16;
2916   fFormat           := tfX1RGB5us1;
2917   fWithAlpha        := tfA1RGB5us1;
2918   fWithoutAlpha     := tfX1RGB5us1;
2919   fRGBInverted      := tfX1BGR5us1;
2920   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2921   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2922 {$IFNDEF OPENGL_ES}
2923   fOpenGLFormat     := tfX1RGB5us1;
2924   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2925   fglInternalFormat := GL_RGB5;
2926   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2927 {$ELSE}
2928   fOpenGLFormat     := tfR5G6B5us1;
2929 {$ENDIF}
2930 end;
2931
2932 procedure TfdRGB8ub3.SetValues;
2933 begin
2934   inherited SetValues;
2935   fBitsPerPixel     := 24;
2936   fFormat           := tfRGB8ub3;
2937   fWithAlpha        := tfRGBA8ub4;
2938   fWithoutAlpha     := tfRGB8ub3;
2939   fRGBInverted      := tfBGR8ub3;
2940   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2941   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2942   fOpenGLFormat     := tfRGB8ub3;
2943   fglFormat         := GL_RGB;
2944   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2945   fglDataFormat     := GL_UNSIGNED_BYTE;
2946 end;
2947
2948 procedure TfdRGBX8ui1.SetValues;
2949 begin
2950   inherited SetValues;
2951   fBitsPerPixel     := 32;
2952   fFormat           := tfRGBX8ui1;
2953   fWithAlpha        := tfRGBA8ui1;
2954   fWithoutAlpha     := tfRGBX8ui1;
2955   fRGBInverted      := tfBGRX8ui1;
2956   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2957   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2958 {$IFNDEF OPENGL_ES}
2959   fOpenGLFormat     := tfRGBX8ui1;
2960   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2961   fglInternalFormat := GL_RGB8;
2962   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2963 {$ELSE}
2964   fOpenGLFormat     := tfRGB8ub3;
2965 {$ENDIF}
2966 end;
2967
2968 procedure TfdXRGB8ui1.SetValues;
2969 begin
2970   inherited SetValues;
2971   fBitsPerPixel     := 32;
2972   fFormat           := tfXRGB8ui1;
2973   fWithAlpha        := tfXRGB8ui1;
2974   fWithoutAlpha     := tfXRGB8ui1;
2975   fOpenGLFormat     := tfXRGB8ui1;
2976   fRGBInverted      := tfXBGR8ui1;
2977   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2978   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2979 {$IFNDEF OPENGL_ES}
2980   fOpenGLFormat     := tfXRGB8ui1;
2981   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2982   fglInternalFormat := GL_RGB8;
2983   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2984 {$ELSE}
2985   fOpenGLFormat     := tfRGB8ub3;
2986 {$ENDIF}
2987 end;
2988
2989 procedure TfdRGB10X2ui1.SetValues;
2990 begin
2991   inherited SetValues;
2992   fBitsPerPixel     := 32;
2993   fFormat           := tfRGB10X2ui1;
2994   fWithAlpha        := tfRGB10A2ui1;
2995   fWithoutAlpha     := tfRGB10X2ui1;
2996   fRGBInverted      := tfBGR10X2ui1;
2997   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
2998   fShift            := glBitmapRec4ub(22, 12,  2, 0);
2999 {$IFNDEF OPENGL_ES}
3000   fOpenGLFormat     := tfRGB10X2ui1;
3001   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3002   fglInternalFormat := GL_RGB10;
3003   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3004 {$ELSE}
3005   fOpenGLFormat     := tfRGB16us3;
3006 {$ENDIF}
3007 end;
3008
3009 procedure TfdX2RGB10ui1.SetValues;
3010 begin
3011   inherited SetValues;
3012   fBitsPerPixel     := 32;
3013   fFormat           := tfX2RGB10ui1;
3014   fWithAlpha        := tfA2RGB10ui1;
3015   fWithoutAlpha     := tfX2RGB10ui1;
3016   fRGBInverted      := tfX2BGR10ui1;
3017   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3018   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3019 {$IFNDEF OPENGL_ES}
3020   fOpenGLFormat     := tfX2RGB10ui1;
3021   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3022   fglInternalFormat := GL_RGB10;
3023   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3024 {$ELSE}
3025   fOpenGLFormat     := tfRGB16us3;
3026 {$ENDIF}
3027 end;
3028
3029 procedure TfdRGB16us3.SetValues;
3030 begin
3031   inherited SetValues;
3032   fBitsPerPixel     := 48;
3033   fFormat           := tfRGB16us3;
3034   fWithAlpha        := tfRGBA16us4;
3035   fWithoutAlpha     := tfRGB16us3;
3036   fRGBInverted      := tfBGR16us3;
3037   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3038   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3039 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3040   fOpenGLFormat     := tfRGB16us3;
3041   fglFormat         := GL_RGB;
3042   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3043   fglDataFormat     := GL_UNSIGNED_SHORT;
3044 {$ELSE}
3045   fOpenGLFormat     := tfRGB8ub3;
3046 {$IFEND}
3047 end;
3048
3049 procedure TfdRGBA4us1.SetValues;
3050 begin
3051   inherited SetValues;
3052   fBitsPerPixel     := 16;
3053   fFormat           := tfRGBA4us1;
3054   fWithAlpha        := tfRGBA4us1;
3055   fWithoutAlpha     := tfRGBX4us1;
3056   fOpenGLFormat     := tfRGBA4us1;
3057   fRGBInverted      := tfBGRA4us1;
3058   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3059   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3060   fglFormat         := GL_RGBA;
3061   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3062   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3063 end;
3064
3065 procedure TfdARGB4us1.SetValues;
3066 begin
3067   inherited SetValues;
3068   fBitsPerPixel     := 16;
3069   fFormat           := tfARGB4us1;
3070   fWithAlpha        := tfARGB4us1;
3071   fWithoutAlpha     := tfXRGB4us1;
3072   fRGBInverted      := tfABGR4us1;
3073   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3074   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3075 {$IFNDEF OPENGL_ES}
3076   fOpenGLFormat     := tfARGB4us1;
3077   fglFormat         := GL_BGRA;
3078   fglInternalFormat := GL_RGBA4;
3079   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3080 {$ELSE}
3081   fOpenGLFormat     := tfRGBA4us1;
3082 {$ENDIF}
3083 end;
3084
3085 procedure TfdRGB5A1us1.SetValues;
3086 begin
3087   inherited SetValues;
3088   fBitsPerPixel     := 16;
3089   fFormat           := tfRGB5A1us1;
3090   fWithAlpha        := tfRGB5A1us1;
3091   fWithoutAlpha     := tfRGB5X1us1;
3092   fOpenGLFormat     := tfRGB5A1us1;
3093   fRGBInverted      := tfBGR5A1us1;
3094   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3095   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3096   fglFormat         := GL_RGBA;
3097   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3098   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3099 end;
3100
3101 procedure TfdA1RGB5us1.SetValues;
3102 begin
3103   inherited SetValues;
3104   fBitsPerPixel     := 16;
3105   fFormat           := tfA1RGB5us1;
3106   fWithAlpha        := tfA1RGB5us1;
3107   fWithoutAlpha     := tfX1RGB5us1;
3108   fRGBInverted      := tfA1BGR5us1;
3109   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3110   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3111 {$IFNDEF OPENGL_ES}
3112   fOpenGLFormat     := tfA1RGB5us1;
3113   fglFormat         := GL_BGRA;
3114   fglInternalFormat := GL_RGB5_A1;
3115   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3116 {$ELSE}
3117   fOpenGLFormat     := tfRGB5A1us1;
3118 {$ENDIF}
3119 end;
3120
3121 procedure TfdRGBA8ui1.SetValues;
3122 begin
3123   inherited SetValues;
3124   fBitsPerPixel     := 32;
3125   fFormat           := tfRGBA8ui1;
3126   fWithAlpha        := tfRGBA8ui1;
3127   fWithoutAlpha     := tfRGBX8ui1;
3128   fRGBInverted      := tfBGRA8ui1;
3129   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3130   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3131 {$IFNDEF OPENGL_ES}
3132   fOpenGLFormat     := tfRGBA8ui1;
3133   fglFormat         := GL_RGBA;
3134   fglInternalFormat := GL_RGBA8;
3135   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3136 {$ELSE}
3137   fOpenGLFormat     := tfRGBA8ub4;
3138 {$ENDIF}
3139 end;
3140
3141 procedure TfdARGB8ui1.SetValues;
3142 begin
3143   inherited SetValues;
3144   fBitsPerPixel     := 32;
3145   fFormat           := tfARGB8ui1;
3146   fWithAlpha        := tfARGB8ui1;
3147   fWithoutAlpha     := tfXRGB8ui1;
3148   fRGBInverted      := tfABGR8ui1;
3149   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3150   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3151 {$IFNDEF OPENGL_ES}
3152   fOpenGLFormat     := tfARGB8ui1;
3153   fglFormat         := GL_BGRA;
3154   fglInternalFormat := GL_RGBA8;
3155   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3156 {$ELSE}
3157   fOpenGLFormat     := tfRGBA8ub4;
3158 {$ENDIF}
3159 end;
3160
3161 procedure TfdRGBA8ub4.SetValues;
3162 begin
3163   inherited SetValues;
3164   fBitsPerPixel     := 32;
3165   fFormat           := tfRGBA8ub4;
3166   fWithAlpha        := tfRGBA8ub4;
3167   fWithoutAlpha     := tfRGB8ub3;
3168   fOpenGLFormat     := tfRGBA8ub4;
3169   fRGBInverted      := tfBGRA8ub4;
3170   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3171   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3172   fglFormat         := GL_RGBA;
3173   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3174   fglDataFormat     := GL_UNSIGNED_BYTE;
3175 end;
3176
3177 procedure TfdRGB10A2ui1.SetValues;
3178 begin
3179   inherited SetValues;
3180   fBitsPerPixel     := 32;
3181   fFormat           := tfRGB10A2ui1;
3182   fWithAlpha        := tfRGB10A2ui1;
3183   fWithoutAlpha     := tfRGB10X2ui1;
3184   fRGBInverted      := tfBGR10A2ui1;
3185   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3186   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3187 {$IFNDEF OPENGL_ES}
3188   fOpenGLFormat     := tfRGB10A2ui1;
3189   fglFormat         := GL_RGBA;
3190   fglInternalFormat := GL_RGB10_A2;
3191   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3192 {$ELSE}
3193   fOpenGLFormat     := tfA2RGB10ui1;
3194 {$ENDIF}
3195 end;
3196
3197 procedure TfdA2RGB10ui1.SetValues;
3198 begin
3199   inherited SetValues;
3200   fBitsPerPixel     := 32;
3201   fFormat           := tfA2RGB10ui1;
3202   fWithAlpha        := tfA2RGB10ui1;
3203   fWithoutAlpha     := tfX2RGB10ui1;
3204   fRGBInverted      := tfA2BGR10ui1;
3205   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3206   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3207 {$IF NOT DEFINED(OPENGL_ES)}
3208   fOpenGLFormat     := tfA2RGB10ui1;
3209   fglFormat         := GL_BGRA;
3210   fglInternalFormat := GL_RGB10_A2;
3211   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3212 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3213   fOpenGLFormat     := tfA2RGB10ui1;
3214   fglFormat         := GL_RGBA;
3215   fglInternalFormat := GL_RGB10_A2;
3216   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3217 {$ELSE}
3218   fOpenGLFormat     := tfRGBA8ui1;
3219 {$IFEND}
3220 end;
3221
3222 procedure TfdRGBA16us4.SetValues;
3223 begin
3224   inherited SetValues;
3225   fBitsPerPixel     := 64;
3226   fFormat           := tfRGBA16us4;
3227   fWithAlpha        := tfRGBA16us4;
3228   fWithoutAlpha     := tfRGB16us3;
3229   fRGBInverted      := tfBGRA16us4;
3230   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3231   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3232 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3233   fOpenGLFormat     := tfRGBA16us4;
3234   fglFormat         := GL_RGBA;
3235   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3236   fglDataFormat     := GL_UNSIGNED_SHORT;
3237 {$ELSE}
3238   fOpenGLFormat     := tfRGBA8ub4;
3239 {$IFEND}
3240 end;
3241
3242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3245 procedure TfdBGRX4us1.SetValues;
3246 begin
3247   inherited SetValues;
3248   fBitsPerPixel     := 16;
3249   fFormat           := tfBGRX4us1;
3250   fWithAlpha        := tfBGRA4us1;
3251   fWithoutAlpha     := tfBGRX4us1;
3252   fRGBInverted      := tfRGBX4us1;
3253   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3254   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3255 {$IFNDEF OPENGL_ES}
3256   fOpenGLFormat     := tfBGRX4us1;
3257   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3258   fglInternalFormat := GL_RGB4;
3259   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3260 {$ELSE}
3261   fOpenGLFormat     := tfR5G6B5us1;
3262 {$ENDIF}
3263 end;
3264
3265 procedure TfdXBGR4us1.SetValues;
3266 begin
3267   inherited SetValues;
3268   fBitsPerPixel     := 16;
3269   fFormat           := tfXBGR4us1;
3270   fWithAlpha        := tfABGR4us1;
3271   fWithoutAlpha     := tfXBGR4us1;
3272   fRGBInverted      := tfXRGB4us1;
3273   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3274   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3275 {$IFNDEF OPENGL_ES}
3276   fOpenGLFormat     := tfXBGR4us1;
3277   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3278   fglInternalFormat := GL_RGB4;
3279   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3280 {$ELSE}
3281   fOpenGLFormat     := tfR5G6B5us1;
3282 {$ENDIF}
3283 end;
3284
3285 procedure TfdB5G6R5us1.SetValues;
3286 begin
3287   inherited SetValues;
3288   fBitsPerPixel     := 16;
3289   fFormat           := tfB5G6R5us1;
3290   fWithAlpha        := tfBGR5A1us1;
3291   fWithoutAlpha     := tfB5G6R5us1;
3292   fRGBInverted      := tfR5G6B5us1;
3293   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3294   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3295 {$IFNDEF OPENGL_ES}
3296   fOpenGLFormat     := tfB5G6R5us1;
3297   fglFormat         := GL_RGB;
3298   fglInternalFormat := GL_RGB565;
3299   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3300 {$ELSE}
3301   fOpenGLFormat     := tfR5G6B5us1;
3302 {$ENDIF}
3303 end;
3304
3305 procedure TfdBGR5X1us1.SetValues;
3306 begin
3307   inherited SetValues;
3308   fBitsPerPixel     := 16;
3309   fFormat           := tfBGR5X1us1;
3310   fWithAlpha        := tfBGR5A1us1;
3311   fWithoutAlpha     := tfBGR5X1us1;
3312   fRGBInverted      := tfRGB5X1us1;
3313   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3314   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3315 {$IFNDEF OPENGL_ES}
3316   fOpenGLFormat     := tfBGR5X1us1;
3317   fglFormat         := GL_BGRA;
3318   fglInternalFormat := GL_RGB5;
3319   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3320 {$ELSE}
3321   fOpenGLFormat     := tfR5G6B5us1;
3322 {$ENDIF}
3323 end;
3324
3325 procedure TfdX1BGR5us1.SetValues;
3326 begin
3327   inherited SetValues;
3328   fBitsPerPixel     := 16;
3329   fFormat           := tfX1BGR5us1;
3330   fWithAlpha        := tfA1BGR5us1;
3331   fWithoutAlpha     := tfX1BGR5us1;
3332   fRGBInverted      := tfX1RGB5us1;
3333   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3334   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3335 {$IFNDEF OPENGL_ES}
3336   fOpenGLFormat     := tfX1BGR5us1;
3337   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3338   fglInternalFormat := GL_RGB5;
3339   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3340 {$ELSE}
3341   fOpenGLFormat     := tfR5G6B5us1;
3342 {$ENDIF}
3343 end;
3344
3345 procedure TfdBGR8ub3.SetValues;
3346 begin
3347   inherited SetValues;
3348   fBitsPerPixel     := 24;
3349   fFormat           := tfBGR8ub3;
3350   fWithAlpha        := tfBGRA8ub4;
3351   fWithoutAlpha     := tfBGR8ub3;
3352   fRGBInverted      := tfRGB8ub3;
3353   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3354   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3355 {$IFNDEF OPENGL_ES}
3356   fOpenGLFormat     := tfBGR8ub3;
3357   fglFormat         := GL_BGR;
3358   fglInternalFormat := GL_RGB8;
3359   fglDataFormat     := GL_UNSIGNED_BYTE;
3360 {$ELSE}
3361   fOpenGLFormat     := tfRGB8ub3;
3362 {$ENDIF}
3363 end;
3364
3365 procedure TfdBGRX8ui1.SetValues;
3366 begin
3367   inherited SetValues;
3368   fBitsPerPixel     := 32;
3369   fFormat           := tfBGRX8ui1;
3370   fWithAlpha        := tfBGRA8ui1;
3371   fWithoutAlpha     := tfBGRX8ui1;
3372   fRGBInverted      := tfRGBX8ui1;
3373   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3374   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3375 {$IFNDEF OPENGL_ES}
3376   fOpenGLFormat     := tfBGRX8ui1;
3377   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3378   fglInternalFormat := GL_RGB8;
3379   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3380 {$ELSE}
3381   fOpenGLFormat     := tfRGB8ub3;
3382 {$ENDIF}
3383 end;
3384
3385 procedure TfdXBGR8ui1.SetValues;
3386 begin
3387   inherited SetValues;
3388   fBitsPerPixel     := 32;
3389   fFormat           := tfXBGR8ui1;
3390   fWithAlpha        := tfABGR8ui1;
3391   fWithoutAlpha     := tfXBGR8ui1;
3392   fRGBInverted      := tfXRGB8ui1;
3393   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3394   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3395 {$IFNDEF OPENGL_ES}
3396   fOpenGLFormat     := tfXBGR8ui1;
3397   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3398   fglInternalFormat := GL_RGB8;
3399   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3400 {$ELSE}
3401   fOpenGLFormat     := tfRGB8ub3;
3402 {$ENDIF}
3403 end;
3404
3405 procedure TfdBGR10X2ui1.SetValues;
3406 begin
3407   inherited SetValues;
3408   fBitsPerPixel     := 32;
3409   fFormat           := tfBGR10X2ui1;
3410   fWithAlpha        := tfBGR10A2ui1;
3411   fWithoutAlpha     := tfBGR10X2ui1;
3412   fRGBInverted      := tfRGB10X2ui1;
3413   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3414   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3415 {$IFNDEF OPENGL_ES}
3416   fOpenGLFormat     := tfBGR10X2ui1;
3417   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3418   fglInternalFormat := GL_RGB10;
3419   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3420 {$ELSE}
3421   fOpenGLFormat     := tfRGB16us3;
3422 {$ENDIF}
3423 end;
3424
3425 procedure TfdX2BGR10ui1.SetValues;
3426 begin
3427   inherited SetValues;
3428   fBitsPerPixel     := 32;
3429   fFormat           := tfX2BGR10ui1;
3430   fWithAlpha        := tfA2BGR10ui1;
3431   fWithoutAlpha     := tfX2BGR10ui1;
3432   fRGBInverted      := tfX2RGB10ui1;
3433   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3434   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3435 {$IFNDEF OPENGL_ES}
3436   fOpenGLFormat     := tfX2BGR10ui1;
3437   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3438   fglInternalFormat := GL_RGB10;
3439   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3440 {$ELSE}
3441   fOpenGLFormat     := tfRGB16us3;
3442 {$ENDIF}
3443 end;
3444
3445 procedure TfdBGR16us3.SetValues;
3446 begin
3447   inherited SetValues;
3448   fBitsPerPixel     := 48;
3449   fFormat           := tfBGR16us3;
3450   fWithAlpha        := tfBGRA16us4;
3451   fWithoutAlpha     := tfBGR16us3;
3452   fRGBInverted      := tfRGB16us3;
3453   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3454   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3455 {$IFNDEF OPENGL_ES}
3456   fOpenGLFormat     := tfBGR16us3;
3457   fglFormat         := GL_BGR;
3458   fglInternalFormat := GL_RGB16;
3459   fglDataFormat     := GL_UNSIGNED_SHORT;
3460 {$ELSE}
3461   fOpenGLFormat     := tfRGB16us3;
3462 {$ENDIF}
3463 end;
3464
3465 procedure TfdBGRA4us1.SetValues;
3466 begin
3467   inherited SetValues;
3468   fBitsPerPixel     := 16;
3469   fFormat           := tfBGRA4us1;
3470   fWithAlpha        := tfBGRA4us1;
3471   fWithoutAlpha     := tfBGRX4us1;
3472   fRGBInverted      := tfRGBA4us1;
3473   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3474   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3475 {$IFNDEF OPENGL_ES}
3476   fOpenGLFormat     := tfBGRA4us1;
3477   fglFormat         := GL_BGRA;
3478   fglInternalFormat := GL_RGBA4;
3479   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3480 {$ELSE}
3481   fOpenGLFormat     := tfRGBA4us1;
3482 {$ENDIF}
3483 end;
3484
3485 procedure TfdABGR4us1.SetValues;
3486 begin
3487   inherited SetValues;
3488   fBitsPerPixel     := 16;
3489   fFormat           := tfABGR4us1;
3490   fWithAlpha        := tfABGR4us1;
3491   fWithoutAlpha     := tfXBGR4us1;
3492   fRGBInverted      := tfARGB4us1;
3493   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3494   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3495 {$IFNDEF OPENGL_ES}
3496   fOpenGLFormat     := tfABGR4us1;
3497   fglFormat         := GL_RGBA;
3498   fglInternalFormat := GL_RGBA4;
3499   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3500 {$ELSE}
3501   fOpenGLFormat     := tfRGBA4us1;
3502 {$ENDIF}
3503 end;
3504
3505 procedure TfdBGR5A1us1.SetValues;
3506 begin
3507   inherited SetValues;
3508   fBitsPerPixel     := 16;
3509   fFormat           := tfBGR5A1us1;
3510   fWithAlpha        := tfBGR5A1us1;
3511   fWithoutAlpha     := tfBGR5X1us1;
3512   fRGBInverted      := tfRGB5A1us1;
3513   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3514   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3515 {$IFNDEF OPENGL_ES}
3516   fOpenGLFormat     := tfBGR5A1us1;
3517   fglFormat         := GL_BGRA;
3518   fglInternalFormat := GL_RGB5_A1;
3519   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3520 {$ELSE}
3521   fOpenGLFormat     := tfRGB5A1us1;
3522 {$ENDIF}
3523 end;
3524
3525 procedure TfdA1BGR5us1.SetValues;
3526 begin
3527   inherited SetValues;
3528   fBitsPerPixel     := 16;
3529   fFormat           := tfA1BGR5us1;
3530   fWithAlpha        := tfA1BGR5us1;
3531   fWithoutAlpha     := tfX1BGR5us1;
3532   fRGBInverted      := tfA1RGB5us1;
3533   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3534   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3535 {$IFNDEF OPENGL_ES}
3536   fOpenGLFormat     := tfA1BGR5us1;
3537   fglFormat         := GL_RGBA;
3538   fglInternalFormat := GL_RGB5_A1;
3539   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3540 {$ELSE}
3541   fOpenGLFormat     := tfRGB5A1us1;
3542 {$ENDIF}
3543 end;
3544
3545 procedure TfdBGRA8ui1.SetValues;
3546 begin
3547   inherited SetValues;
3548   fBitsPerPixel     := 32;
3549   fFormat           := tfBGRA8ui1;
3550   fWithAlpha        := tfBGRA8ui1;
3551   fWithoutAlpha     := tfBGRX8ui1;
3552   fRGBInverted      := tfRGBA8ui1;
3553   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3554   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3555 {$IFNDEF OPENGL_ES}
3556   fOpenGLFormat     := tfBGRA8ui1;
3557   fglFormat         := GL_BGRA;
3558   fglInternalFormat := GL_RGBA8;
3559   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3560 {$ELSE}
3561   fOpenGLFormat     := tfRGBA8ub4;
3562 {$ENDIF}
3563 end;
3564
3565 procedure TfdABGR8ui1.SetValues;
3566 begin
3567   inherited SetValues;
3568   fBitsPerPixel     := 32;
3569   fFormat           := tfABGR8ui1;
3570   fWithAlpha        := tfABGR8ui1;
3571   fWithoutAlpha     := tfXBGR8ui1;
3572   fRGBInverted      := tfARGB8ui1;
3573   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3574   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3575 {$IFNDEF OPENGL_ES}
3576   fOpenGLFormat     := tfABGR8ui1;
3577   fglFormat         := GL_RGBA;
3578   fglInternalFormat := GL_RGBA8;
3579   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3580 {$ELSE}
3581   fOpenGLFormat     := tfRGBA8ub4
3582 {$ENDIF}
3583 end;
3584
3585 procedure TfdBGRA8ub4.SetValues;
3586 begin
3587   inherited SetValues;
3588   fBitsPerPixel     := 32;
3589   fFormat           := tfBGRA8ub4;
3590   fWithAlpha        := tfBGRA8ub4;
3591   fWithoutAlpha     := tfBGR8ub3;
3592   fRGBInverted      := tfRGBA8ub4;
3593   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3594   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3595 {$IFNDEF OPENGL_ES}
3596   fOpenGLFormat     := tfBGRA8ub4;
3597   fglFormat         := GL_BGRA;
3598   fglInternalFormat := GL_RGBA8;
3599   fglDataFormat     := GL_UNSIGNED_BYTE;
3600 {$ELSE}
3601   fOpenGLFormat     := tfRGBA8ub4;
3602 {$ENDIF}
3603 end;
3604
3605 procedure TfdBGR10A2ui1.SetValues;
3606 begin
3607   inherited SetValues;
3608   fBitsPerPixel     := 32;
3609   fFormat           := tfBGR10A2ui1;
3610   fWithAlpha        := tfBGR10A2ui1;
3611   fWithoutAlpha     := tfBGR10X2ui1;
3612   fRGBInverted      := tfRGB10A2ui1;
3613   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3614   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3615 {$IFNDEF OPENGL_ES}
3616   fOpenGLFormat     := tfBGR10A2ui1;
3617   fglFormat         := GL_BGRA;
3618   fglInternalFormat := GL_RGB10_A2;
3619   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3620 {$ELSE}
3621   fOpenGLFormat     := tfA2RGB10ui1;
3622 {$ENDIF}
3623 end;
3624
3625 procedure TfdA2BGR10ui1.SetValues;
3626 begin
3627   inherited SetValues;
3628   fBitsPerPixel     := 32;
3629   fFormat           := tfA2BGR10ui1;
3630   fWithAlpha        := tfA2BGR10ui1;
3631   fWithoutAlpha     := tfX2BGR10ui1;
3632   fRGBInverted      := tfA2RGB10ui1;
3633   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3634   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3635 {$IFNDEF OPENGL_ES}
3636   fOpenGLFormat     := tfA2BGR10ui1;
3637   fglFormat         := GL_RGBA;
3638   fglInternalFormat := GL_RGB10_A2;
3639   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3640 {$ELSE}
3641   fOpenGLFormat     := tfA2RGB10ui1;
3642 {$ENDIF}
3643 end;
3644
3645 procedure TfdBGRA16us4.SetValues;
3646 begin
3647   inherited SetValues;
3648   fBitsPerPixel     := 64;
3649   fFormat           := tfBGRA16us4;
3650   fWithAlpha        := tfBGRA16us4;
3651   fWithoutAlpha     := tfBGR16us3;
3652   fRGBInverted      := tfRGBA16us4;
3653   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3654   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3655 {$IFNDEF OPENGL_ES}
3656   fOpenGLFormat     := tfBGRA16us4;
3657   fglFormat         := GL_BGRA;
3658   fglInternalFormat := GL_RGBA16;
3659   fglDataFormat     := GL_UNSIGNED_SHORT;
3660 {$ELSE}
3661   fOpenGLFormat     := tfRGBA16us4;
3662 {$ENDIF}
3663 end;
3664
3665 procedure TfdDepth16us1.SetValues;
3666 begin
3667   inherited SetValues;
3668   fBitsPerPixel     := 16;
3669   fFormat           := tfDepth16us1;
3670   fWithoutAlpha     := tfDepth16us1;
3671   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3672   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3673 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3674   fOpenGLFormat     := tfDepth16us1;
3675   fglFormat         := GL_DEPTH_COMPONENT;
3676   fglInternalFormat := GL_DEPTH_COMPONENT16;
3677   fglDataFormat     := GL_UNSIGNED_SHORT;
3678 {$IFEND}
3679 end;
3680
3681 procedure TfdDepth24ui1.SetValues;
3682 begin
3683   inherited SetValues;
3684   fBitsPerPixel     := 32;
3685   fFormat           := tfDepth24ui1;
3686   fWithoutAlpha     := tfDepth24ui1;
3687   fOpenGLFormat     := tfDepth24ui1;
3688   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3689   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3690 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3691   fOpenGLFormat     := tfDepth24ui1;
3692   fglFormat         := GL_DEPTH_COMPONENT;
3693   fglInternalFormat := GL_DEPTH_COMPONENT24;
3694   fglDataFormat     := GL_UNSIGNED_INT;
3695 {$IFEND}
3696 end;
3697
3698 procedure TfdDepth32ui1.SetValues;
3699 begin
3700   inherited SetValues;
3701   fBitsPerPixel     := 32;
3702   fFormat           := tfDepth32ui1;
3703   fWithoutAlpha     := tfDepth32ui1;
3704   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3705   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3706 {$IF NOT DEFINED(OPENGL_ES)}
3707   fOpenGLFormat     := tfDepth32ui1;
3708   fglFormat         := GL_DEPTH_COMPONENT;
3709   fglInternalFormat := GL_DEPTH_COMPONENT32;
3710   fglDataFormat     := GL_UNSIGNED_INT;
3711 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3712   fOpenGLFormat     := tfDepth24ui1;
3713 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3714   fOpenGLFormat     := tfDepth16us1;
3715 {$IFEND}
3716 end;
3717
3718 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3719 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3721 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3722 begin
3723   raise EglBitmap.Create('mapping for compressed formats is not supported');
3724 end;
3725
3726 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3727 begin
3728   raise EglBitmap.Create('mapping for compressed formats is not supported');
3729 end;
3730
3731 procedure TfdS3tcDtx1RGBA.SetValues;
3732 begin
3733   inherited SetValues;
3734   fFormat           := tfS3tcDtx1RGBA;
3735   fWithAlpha        := tfS3tcDtx1RGBA;
3736   fUncompressed     := tfRGB5A1us1;
3737   fBitsPerPixel     := 4;
3738   fIsCompressed     := true;
3739 {$IFNDEF OPENGL_ES}
3740   fOpenGLFormat     := tfS3tcDtx1RGBA;
3741   fglFormat         := GL_COMPRESSED_RGBA;
3742   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3743   fglDataFormat     := GL_UNSIGNED_BYTE;
3744 {$ELSE}
3745   fOpenGLFormat     := fUncompressed;
3746 {$ENDIF}
3747 end;
3748
3749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3750 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3752 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3753 begin
3754   raise EglBitmap.Create('mapping for compressed formats is not supported');
3755 end;
3756
3757 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3758 begin
3759   raise EglBitmap.Create('mapping for compressed formats is not supported');
3760 end;
3761
3762 procedure TfdS3tcDtx3RGBA.SetValues;
3763 begin
3764   inherited SetValues;
3765   fFormat           := tfS3tcDtx3RGBA;
3766   fWithAlpha        := tfS3tcDtx3RGBA;
3767   fUncompressed     := tfRGBA8ub4;
3768   fBitsPerPixel     := 8;
3769   fIsCompressed     := true;
3770 {$IFNDEF OPENGL_ES}
3771   fOpenGLFormat     := tfS3tcDtx3RGBA;
3772   fglFormat         := GL_COMPRESSED_RGBA;
3773   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3774   fglDataFormat     := GL_UNSIGNED_BYTE;
3775 {$ELSE}
3776   fOpenGLFormat     := fUncompressed;
3777 {$ENDIF}
3778 end;
3779
3780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3781 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3784 begin
3785   raise EglBitmap.Create('mapping for compressed formats is not supported');
3786 end;
3787
3788 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3789 begin
3790   raise EglBitmap.Create('mapping for compressed formats is not supported');
3791 end;
3792
3793 procedure TfdS3tcDtx5RGBA.SetValues;
3794 begin
3795   inherited SetValues;
3796   fFormat           := tfS3tcDtx3RGBA;
3797   fWithAlpha        := tfS3tcDtx3RGBA;
3798   fUncompressed     := tfRGBA8ub4;
3799   fBitsPerPixel     := 8;
3800   fIsCompressed     := true;
3801 {$IFNDEF OPENGL_ES}
3802   fOpenGLFormat     := tfS3tcDtx3RGBA;
3803   fglFormat         := GL_COMPRESSED_RGBA;
3804   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3805   fglDataFormat     := GL_UNSIGNED_BYTE;
3806 {$ELSE}
3807   fOpenGLFormat     := fUncompressed;
3808 {$ENDIF}
3809 end;
3810
3811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3812 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3814 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3815 begin
3816   result := (fPrecision.r > 0);
3817 end;
3818
3819 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3820 begin
3821   result := (fPrecision.g > 0);
3822 end;
3823
3824 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3825 begin
3826   result := (fPrecision.b > 0);
3827 end;
3828
3829 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3830 begin
3831   result := (fPrecision.a > 0);
3832 end;
3833
3834 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3835 begin
3836   result := HasRed or HasGreen or HasBlue;
3837 end;
3838
3839 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3840 begin
3841   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3842 end;
3843
3844 function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
3845 begin
3846   result := (OpenGLFormat = Format);
3847 end;
3848
3849 procedure TglBitmapFormatDescriptor.SetValues;
3850 begin
3851   fFormat       := tfEmpty;
3852   fWithAlpha    := tfEmpty;
3853   fWithoutAlpha := tfEmpty;
3854   fOpenGLFormat := tfEmpty;
3855   fRGBInverted  := tfEmpty;
3856   fUncompressed := tfEmpty;
3857
3858   fBitsPerPixel := 0;
3859   fIsCompressed := false;
3860
3861   fglFormat         := 0;
3862   fglInternalFormat := 0;
3863   fglDataFormat     := 0;
3864
3865   FillChar(fPrecision, 0, SizeOf(fPrecision));
3866   FillChar(fShift,     0, SizeOf(fShift));
3867 end;
3868
3869 procedure TglBitmapFormatDescriptor.CalcValues;
3870 var
3871   i: Integer;
3872 begin
3873   fBytesPerPixel := fBitsPerPixel / 8;
3874   fChannelCount  := 0;
3875   for i := 0 to 3 do begin
3876     if (fPrecision.arr[i] > 0) then
3877       inc(fChannelCount);
3878     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3879     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3880   end;
3881 end;
3882
3883 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3884 var
3885   w, h: Integer;
3886 begin
3887   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3888     w := Max(1, aSize.X);
3889     h := Max(1, aSize.Y);
3890     result := GetSize(w, h);
3891   end else
3892     result := 0;
3893 end;
3894
3895 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3896 begin
3897   result := 0;
3898   if (aWidth <= 0) or (aHeight <= 0) then
3899     exit;
3900   result := Ceil(aWidth * aHeight * BytesPerPixel);
3901 end;
3902
3903 constructor TglBitmapFormatDescriptor.Create;
3904 begin
3905   inherited Create;
3906   SetValues;
3907   CalcValues;
3908 end;
3909
3910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3912 var
3913   f: TglBitmapFormat;
3914 begin
3915   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3916     result := TFormatDescriptor.Get(f);
3917     if (result.glInternalFormat = aInternalFormat) then
3918       exit;
3919   end;
3920   result := TFormatDescriptor.Get(tfEmpty);
3921 end;
3922
3923 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3924 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3926 class procedure TFormatDescriptor.Init;
3927 begin
3928   if not Assigned(FormatDescriptorCS) then
3929     FormatDescriptorCS := TCriticalSection.Create;
3930 end;
3931
3932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3933 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3934 begin
3935   FormatDescriptorCS.Enter;
3936   try
3937     result := FormatDescriptors[aFormat];
3938     if not Assigned(result) then begin
3939       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3940       FormatDescriptors[aFormat] := result;
3941     end;
3942   finally
3943     FormatDescriptorCS.Leave;
3944   end;
3945 end;
3946
3947 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3948 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3949 begin
3950   result := Get(Get(aFormat).WithAlpha);
3951 end;
3952
3953 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3954 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3955 var
3956   ft: TglBitmapFormat;
3957 begin
3958   // find matching format with OpenGL support
3959   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3960     result := Get(ft);
3961     if (result.MaskMatch(aMask))      and
3962        (result.glFormat <> 0)         and
3963        (result.glInternalFormat <> 0) and
3964        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3965     then
3966       exit;
3967   end;
3968
3969   // find matching format without OpenGL Support
3970   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3971     result := Get(ft);
3972     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3973       exit;
3974   end;
3975
3976   result := TFormatDescriptor.Get(tfEmpty);
3977 end;
3978
3979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3980 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3981 var
3982   ft: TglBitmapFormat;
3983 begin
3984   // find matching format with OpenGL support
3985   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3986     result := Get(ft);
3987     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3988        glBitmapRec4ubCompare(result.Precision, aPrec) and
3989        (result.glFormat <> 0)         and
3990        (result.glInternalFormat <> 0) and
3991        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3992     then
3993       exit;
3994   end;
3995
3996   // find matching format without 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        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4002       exit;
4003   end;
4004
4005   result := TFormatDescriptor.Get(tfEmpty);
4006 end;
4007
4008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4009 class procedure TFormatDescriptor.Clear;
4010 var
4011   f: TglBitmapFormat;
4012 begin
4013   FormatDescriptorCS.Enter;
4014   try
4015     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4016       FreeAndNil(FormatDescriptors[f]);
4017   finally
4018     FormatDescriptorCS.Leave;
4019   end;
4020 end;
4021
4022 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4023 class procedure TFormatDescriptor.Finalize;
4024 begin
4025   Clear;
4026   FreeAndNil(FormatDescriptorCS);
4027 end;
4028
4029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4030 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4032 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4033 var
4034   i: Integer;
4035 begin
4036   for i := 0 to 3 do begin
4037     fShift.arr[i] := 0;
4038     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4039       aMask.arr[i] := aMask.arr[i] shr 1;
4040       inc(fShift.arr[i]);
4041     end;
4042     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4043   end;
4044   fBitsPerPixel := aBPP;
4045   CalcValues;
4046 end;
4047
4048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4049 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4050 begin
4051   fBitsPerPixel := aBBP;
4052   fPrecision    := aPrec;
4053   fShift        := aShift;
4054   CalcValues;
4055 end;
4056
4057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4058 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4059 var
4060   data: QWord;
4061 begin
4062   data :=
4063     ((aPixel.Data.r and Range.r) shl Shift.r) or
4064     ((aPixel.Data.g and Range.g) shl Shift.g) or
4065     ((aPixel.Data.b and Range.b) shl Shift.b) or
4066     ((aPixel.Data.a and Range.a) shl Shift.a);
4067   case BitsPerPixel of
4068     8:           aData^  := data;
4069    16:     PWord(aData)^ := data;
4070    32: PCardinal(aData)^ := data;
4071    64:    PQWord(aData)^ := data;
4072   else
4073     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4074   end;
4075   inc(aData, Round(BytesPerPixel));
4076 end;
4077
4078 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4079 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4080 var
4081   data: QWord;
4082   i: Integer;
4083 begin
4084   case BitsPerPixel of
4085      8: data :=           aData^;
4086     16: data :=     PWord(aData)^;
4087     32: data := PCardinal(aData)^;
4088     64: data :=    PQWord(aData)^;
4089   else
4090     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4091   end;
4092   for i := 0 to 3 do
4093     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4094   inc(aData, Round(BytesPerPixel));
4095 end;
4096
4097 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4098 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4100 procedure TbmpColorTableFormat.SetValues;
4101 begin
4102   inherited SetValues;
4103   fShift := glBitmapRec4ub(8, 8, 8, 0);
4104 end;
4105
4106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4107 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4108 begin
4109   fFormat       := aFormat;
4110   fBitsPerPixel := aBPP;
4111   fPrecision    := aPrec;
4112   fShift        := aShift;
4113   CalcValues;
4114 end;
4115
4116 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4117 procedure TbmpColorTableFormat.CalcValues;
4118 begin
4119   inherited CalcValues;
4120 end;
4121
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 procedure TbmpColorTableFormat.CreateColorTable;
4124 var
4125   i: Integer;
4126 begin
4127   SetLength(fColorTable, 256);
4128   if not HasColor then begin
4129     // alpha
4130     for i := 0 to High(fColorTable) do begin
4131       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4132       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4133       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4134       fColorTable[i].a := 0;
4135     end;
4136   end else begin
4137     // normal
4138     for i := 0 to High(fColorTable) do begin
4139       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4140       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4141       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4142       fColorTable[i].a := 0;
4143     end;
4144   end;
4145 end;
4146
4147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4148 function TbmpColorTableFormat.CreateMappingData: Pointer;
4149 begin
4150   result := Pointer(0);
4151 end;
4152
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4155 begin
4156   if (BitsPerPixel <> 8) then
4157     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4158   if not HasColor then
4159     // alpha
4160     aData^ := aPixel.Data.a
4161   else
4162     // normal
4163     aData^ := Round(
4164       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4165       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4166       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4167   inc(aData);
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4172
4173   function ReadValue: Byte;
4174   var
4175     i: PtrUInt;
4176   begin
4177     if (BitsPerPixel = 8) then begin
4178       result := aData^;
4179       inc(aData);
4180     end else begin
4181       i := {%H-}PtrUInt(aMapData);
4182       if (BitsPerPixel > 1) then
4183         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4184       else
4185         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4186       inc(i, BitsPerPixel);
4187       while (i >= 8) do begin
4188         inc(aData);
4189         dec(i, 8);
4190       end;
4191       aMapData := {%H-}Pointer(i);
4192     end;
4193   end;
4194
4195 begin
4196   if (BitsPerPixel > 8) then
4197     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4198   with fColorTable[ReadValue] do begin
4199     aPixel.Data.r := r;
4200     aPixel.Data.g := g;
4201     aPixel.Data.b := b;
4202     aPixel.Data.a := a;
4203   end;
4204 end;
4205
4206 destructor TbmpColorTableFormat.Destroy;
4207 begin
4208   SetLength(fColorTable, 0);
4209   inherited Destroy;
4210 end;
4211
4212 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4213 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4215 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4216 var
4217   i: Integer;
4218 begin
4219   for i := 0 to 3 do begin
4220     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4221       if (aSourceFD.Range.arr[i] > 0) then
4222         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4223       else
4224         aPixel.Data.arr[i] := 0;
4225     end;
4226   end;
4227 end;
4228
4229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4230 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4231 begin
4232   with aFuncRec do begin
4233     if (Source.Range.r   > 0) then
4234       Dest.Data.r := Source.Data.r;
4235     if (Source.Range.g > 0) then
4236       Dest.Data.g := Source.Data.g;
4237     if (Source.Range.b  > 0) then
4238       Dest.Data.b := Source.Data.b;
4239     if (Source.Range.a > 0) then
4240       Dest.Data.a := Source.Data.a;
4241   end;
4242 end;
4243
4244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4245 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4246 var
4247   i: Integer;
4248 begin
4249   with aFuncRec do begin
4250     for i := 0 to 3 do
4251       if (Source.Range.arr[i] > 0) then
4252         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4253   end;
4254 end;
4255
4256 type
4257   TShiftData = packed record
4258     case Integer of
4259       0: (r, g, b, a: SmallInt);
4260       1: (arr: array[0..3] of SmallInt);
4261   end;
4262   PShiftData = ^TShiftData;
4263
4264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4265 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4266 var
4267   i: Integer;
4268 begin
4269   with aFuncRec do
4270     for i := 0 to 3 do
4271       if (Source.Range.arr[i] > 0) then
4272         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4273 end;
4274
4275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4276 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4277 var
4278   i: Integer;
4279 begin
4280   with aFuncRec do begin
4281     Dest.Data := Source.Data;
4282     for i := 0 to 3 do
4283       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4284         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4285   end;
4286 end;
4287
4288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4289 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4290 var
4291   i: Integer;
4292 begin
4293   with aFuncRec do begin
4294     for i := 0 to 3 do
4295       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4296   end;
4297 end;
4298
4299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4300 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4301 var
4302   Temp: Single;
4303 begin
4304   with FuncRec do begin
4305     if (FuncRec.Args = nil) then begin //source has no alpha
4306       Temp :=
4307         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4308         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4309         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4310       Dest.Data.a := Round(Dest.Range.a * Temp);
4311     end else
4312       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4313   end;
4314 end;
4315
4316 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4317 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4318 type
4319   PglBitmapPixelData = ^TglBitmapPixelData;
4320 begin
4321   with FuncRec do begin
4322     Dest.Data.r := Source.Data.r;
4323     Dest.Data.g := Source.Data.g;
4324     Dest.Data.b := Source.Data.b;
4325
4326     with PglBitmapPixelData(Args)^ do
4327       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4328           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4329           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4330         Dest.Data.a := 0
4331       else
4332         Dest.Data.a := Dest.Range.a;
4333   end;
4334 end;
4335
4336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4337 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4338 begin
4339   with FuncRec do begin
4340     Dest.Data.r := Source.Data.r;
4341     Dest.Data.g := Source.Data.g;
4342     Dest.Data.b := Source.Data.b;
4343     Dest.Data.a := PCardinal(Args)^;
4344   end;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4349 type
4350   PRGBPix = ^TRGBPix;
4351   TRGBPix = array [0..2] of byte;
4352 var
4353   Temp: Byte;
4354 begin
4355   while aWidth > 0 do begin
4356     Temp := PRGBPix(aData)^[0];
4357     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4358     PRGBPix(aData)^[2] := Temp;
4359
4360     if aHasAlpha then
4361       Inc(aData, 4)
4362     else
4363       Inc(aData, 3);
4364     dec(aWidth);
4365   end;
4366 end;
4367
4368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4369 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4371 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4372 begin
4373   result := TFormatDescriptor.Get(fFormat);
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmapData.GetWidth: Integer;
4378 begin
4379   if (ffX in fDimension.Fields) then
4380     result := fDimension.X
4381   else
4382     result := -1;
4383 end;
4384
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 function TglBitmapData.GetHeight: Integer;
4387 begin
4388   if (ffY in fDimension.Fields) then
4389     result := fDimension.Y
4390   else
4391     result := -1;
4392 end;
4393
4394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4395 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4396 begin
4397   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4398     result := fScanlines[aIndex]
4399   else
4400     result := nil;
4401 end;
4402
4403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4404 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4405 begin
4406   if fFormat = aValue then
4407     exit;
4408   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4409     raise EglBitmapUnsupportedFormat.Create(Format);
4410   SetData(fData, aValue, Width, Height);
4411 end;
4412
4413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4414 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4415 var
4416   TempPos: Integer;
4417 begin
4418   if not Assigned(aResType) then begin
4419     TempPos   := Pos('.', aResource);
4420     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4421     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4422   end;
4423 end;
4424
4425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4426 procedure TglBitmapData.UpdateScanlines;
4427 var
4428   w, h, i, LineWidth: Integer;
4429 begin
4430   w := Width;
4431   h := Height;
4432   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4433   if fHasScanlines then begin
4434     SetLength(fScanlines, h);
4435     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4436     for i := 0 to h-1 do begin
4437       fScanlines[i] := fData;
4438       Inc(fScanlines[i], i * LineWidth);
4439     end;
4440   end else
4441     SetLength(fScanlines, 0);
4442 end;
4443
4444 {$IFDEF GLB_SUPPORT_PNG_READ}
4445 {$IF DEFINED(GLB_LAZ_PNG)}
4446 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4447 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4450 const
4451   MAGIC_LEN = 8;
4452   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4453 var
4454   reader: TLazReaderPNG;
4455   intf: TLazIntfImage;
4456   StreamPos: Int64;
4457   magic: String[MAGIC_LEN];
4458 begin
4459   result := true;
4460   StreamPos := aStream.Position;
4461
4462   SetLength(magic, MAGIC_LEN);
4463   aStream.Read(magic[1], MAGIC_LEN);
4464   aStream.Position := StreamPos;
4465   if (magic <> PNG_MAGIC) then begin
4466     result := false;
4467     exit;
4468   end;
4469
4470   intf   := TLazIntfImage.Create(0, 0);
4471   reader := TLazReaderPNG.Create;
4472   try try
4473     reader.UpdateDescription := true;
4474     reader.ImageRead(aStream, intf);
4475     AssignFromLazIntfImage(intf);
4476   except
4477     result := false;
4478     aStream.Position := StreamPos;
4479     exit;
4480   end;
4481   finally
4482     reader.Free;
4483     intf.Free;
4484   end;
4485 end;
4486
4487 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4489 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4490 var
4491   Surface: PSDL_Surface;
4492   RWops: PSDL_RWops;
4493 begin
4494   result := false;
4495   RWops := glBitmapCreateRWops(aStream);
4496   try
4497     if IMG_isPNG(RWops) > 0 then begin
4498       Surface := IMG_LoadPNG_RW(RWops);
4499       try
4500         AssignFromSurface(Surface);
4501         result := true;
4502       finally
4503         SDL_FreeSurface(Surface);
4504       end;
4505     end;
4506   finally
4507     SDL_FreeRW(RWops);
4508   end;
4509 end;
4510
4511 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4513 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4514 begin
4515   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4516 end;
4517
4518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4519 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4520 var
4521   StreamPos: Int64;
4522   signature: array [0..7] of byte;
4523   png: png_structp;
4524   png_info: png_infop;
4525
4526   TempHeight, TempWidth: Integer;
4527   Format: TglBitmapFormat;
4528
4529   png_data: pByte;
4530   png_rows: array of pByte;
4531   Row, LineSize: Integer;
4532 begin
4533   result := false;
4534
4535   if not init_libPNG then
4536     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4537
4538   try
4539     // signature
4540     StreamPos := aStream.Position;
4541     aStream.Read(signature{%H-}, 8);
4542     aStream.Position := StreamPos;
4543
4544     if png_check_sig(@signature, 8) <> 0 then begin
4545       // png read struct
4546       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4547       if png = nil then
4548         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4549
4550       // png info
4551       png_info := png_create_info_struct(png);
4552       if png_info = nil then begin
4553         png_destroy_read_struct(@png, nil, nil);
4554         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4555       end;
4556
4557       // set read callback
4558       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4559
4560       // read informations
4561       png_read_info(png, png_info);
4562
4563       // size
4564       TempHeight := png_get_image_height(png, png_info);
4565       TempWidth := png_get_image_width(png, png_info);
4566
4567       // format
4568       case png_get_color_type(png, png_info) of
4569         PNG_COLOR_TYPE_GRAY:
4570           Format := tfLuminance8ub1;
4571         PNG_COLOR_TYPE_GRAY_ALPHA:
4572           Format := tfLuminance8Alpha8us1;
4573         PNG_COLOR_TYPE_RGB:
4574           Format := tfRGB8ub3;
4575         PNG_COLOR_TYPE_RGB_ALPHA:
4576           Format := tfRGBA8ub4;
4577         else
4578           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4579       end;
4580
4581       // cut upper 8 bit from 16 bit formats
4582       if png_get_bit_depth(png, png_info) > 8 then
4583         png_set_strip_16(png);
4584
4585       // expand bitdepth smaller than 8
4586       if png_get_bit_depth(png, png_info) < 8 then
4587         png_set_expand(png);
4588
4589       // allocating mem for scanlines
4590       LineSize := png_get_rowbytes(png, png_info);
4591       GetMem(png_data, TempHeight * LineSize);
4592       try
4593         SetLength(png_rows, TempHeight);
4594         for Row := Low(png_rows) to High(png_rows) do begin
4595           png_rows[Row] := png_data;
4596           Inc(png_rows[Row], Row * LineSize);
4597         end;
4598
4599         // read complete image into scanlines
4600         png_read_image(png, @png_rows[0]);
4601
4602         // read end
4603         png_read_end(png, png_info);
4604
4605         // destroy read struct
4606         png_destroy_read_struct(@png, @png_info, nil);
4607
4608         SetLength(png_rows, 0);
4609
4610         // set new data
4611         SetData(png_data, Format, TempWidth, TempHeight);
4612
4613         result := true;
4614       except
4615         if Assigned(png_data) then
4616           FreeMem(png_data);
4617         raise;
4618       end;
4619     end;
4620   finally
4621     quit_libPNG;
4622   end;
4623 end;
4624
4625 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4627 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4628 var
4629   StreamPos: Int64;
4630   Png: TPNGObject;
4631   Header: String[8];
4632   Row, Col, PixSize, LineSize: Integer;
4633   NewImage, pSource, pDest, pAlpha: pByte;
4634   PngFormat: TglBitmapFormat;
4635   FormatDesc: TFormatDescriptor;
4636
4637 const
4638   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4639
4640 begin
4641   result := false;
4642
4643   StreamPos := aStream.Position;
4644   aStream.Read(Header[0], SizeOf(Header));
4645   aStream.Position := StreamPos;
4646
4647   {Test if the header matches}
4648   if Header = PngHeader then begin
4649     Png := TPNGObject.Create;
4650     try
4651       Png.LoadFromStream(aStream);
4652
4653       case Png.Header.ColorType of
4654         COLOR_GRAYSCALE:
4655           PngFormat := tfLuminance8ub1;
4656         COLOR_GRAYSCALEALPHA:
4657           PngFormat := tfLuminance8Alpha8us1;
4658         COLOR_RGB:
4659           PngFormat := tfBGR8ub3;
4660         COLOR_RGBALPHA:
4661           PngFormat := tfBGRA8ub4;
4662         else
4663           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4664       end;
4665
4666       FormatDesc := TFormatDescriptor.Get(PngFormat);
4667       PixSize    := Round(FormatDesc.PixelSize);
4668       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4669
4670       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4671       try
4672         pDest := NewImage;
4673
4674         case Png.Header.ColorType of
4675           COLOR_RGB, COLOR_GRAYSCALE:
4676             begin
4677               for Row := 0 to Png.Height -1 do begin
4678                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4679                 Inc(pDest, LineSize);
4680               end;
4681             end;
4682           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4683             begin
4684               PixSize := PixSize -1;
4685
4686               for Row := 0 to Png.Height -1 do begin
4687                 pSource := Png.Scanline[Row];
4688                 pAlpha := pByte(Png.AlphaScanline[Row]);
4689
4690                 for Col := 0 to Png.Width -1 do begin
4691                   Move (pSource^, pDest^, PixSize);
4692                   Inc(pSource, PixSize);
4693                   Inc(pDest, PixSize);
4694
4695                   pDest^ := pAlpha^;
4696                   inc(pAlpha);
4697                   Inc(pDest);
4698                 end;
4699               end;
4700             end;
4701           else
4702             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4703         end;
4704
4705         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4706
4707         result := true;
4708       except
4709         if Assigned(NewImage) then
4710           FreeMem(NewImage);
4711         raise;
4712       end;
4713     finally
4714       Png.Free;
4715     end;
4716   end;
4717 end;
4718 {$IFEND}
4719 {$ENDIF}
4720
4721 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4722 {$IFDEF GLB_LIB_PNG}
4723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4724 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4725 begin
4726   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4727 end;
4728 {$ENDIF}
4729
4730 {$IF DEFINED(GLB_LAZ_PNG)}
4731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4732 procedure TglBitmapData.SavePNG(const aStream: TStream);
4733 var
4734   png: TPortableNetworkGraphic;
4735   intf: TLazIntfImage;
4736   raw: TRawImage;
4737 begin
4738   png  := TPortableNetworkGraphic.Create;
4739   intf := TLazIntfImage.Create(0, 0);
4740   try
4741     if not AssignToLazIntfImage(intf) then
4742       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4743     intf.GetRawImage(raw);
4744     png.LoadFromRawImage(raw, false);
4745     png.SaveToStream(aStream);
4746   finally
4747     png.Free;
4748     intf.Free;
4749   end;
4750 end;
4751
4752 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4754 procedure TglBitmapData.SavePNG(const aStream: TStream);
4755 var
4756   png: png_structp;
4757   png_info: png_infop;
4758   png_rows: array of pByte;
4759   LineSize: Integer;
4760   ColorType: Integer;
4761   Row: Integer;
4762   FormatDesc: TFormatDescriptor;
4763 begin
4764   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4765     raise EglBitmapUnsupportedFormat.Create(Format);
4766
4767   if not init_libPNG then
4768     raise Exception.Create('unable to initialize libPNG.');
4769
4770   try
4771     case Format of
4772       tfAlpha8ub1, tfLuminance8ub1:
4773         ColorType := PNG_COLOR_TYPE_GRAY;
4774       tfLuminance8Alpha8us1:
4775         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4776       tfBGR8ub3, tfRGB8ub3:
4777         ColorType := PNG_COLOR_TYPE_RGB;
4778       tfBGRA8ub4, tfRGBA8ub4:
4779         ColorType := PNG_COLOR_TYPE_RGBA;
4780       else
4781         raise EglBitmapUnsupportedFormat.Create(Format);
4782     end;
4783
4784     FormatDesc := TFormatDescriptor.Get(Format);
4785     LineSize := FormatDesc.GetSize(Width, 1);
4786
4787     // creating array for scanline
4788     SetLength(png_rows, Height);
4789     try
4790       for Row := 0 to Height - 1 do begin
4791         png_rows[Row] := Data;
4792         Inc(png_rows[Row], Row * LineSize)
4793       end;
4794
4795       // write struct
4796       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4797       if png = nil then
4798         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4799
4800       // create png info
4801       png_info := png_create_info_struct(png);
4802       if png_info = nil then begin
4803         png_destroy_write_struct(@png, nil);
4804         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4805       end;
4806
4807       // set read callback
4808       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4809
4810       // set compression
4811       png_set_compression_level(png, 6);
4812
4813       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4814         png_set_bgr(png);
4815
4816       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4817       png_write_info(png, png_info);
4818       png_write_image(png, @png_rows[0]);
4819       png_write_end(png, png_info);
4820       png_destroy_write_struct(@png, @png_info);
4821     finally
4822       SetLength(png_rows, 0);
4823     end;
4824   finally
4825     quit_libPNG;
4826   end;
4827 end;
4828
4829 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4831 procedure TglBitmapData.SavePNG(const aStream: TStream);
4832 var
4833   Png: TPNGObject;
4834
4835   pSource, pDest: pByte;
4836   X, Y, PixSize: Integer;
4837   ColorType: Cardinal;
4838   Alpha: Boolean;
4839
4840   pTemp: pByte;
4841   Temp: Byte;
4842 begin
4843   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4844     raise EglBitmapUnsupportedFormat.Create(Format);
4845
4846   case Format of
4847     tfAlpha8ub1, tfLuminance8ub1: begin
4848       ColorType := COLOR_GRAYSCALE;
4849       PixSize   := 1;
4850       Alpha     := false;
4851     end;
4852     tfLuminance8Alpha8us1: begin
4853       ColorType := COLOR_GRAYSCALEALPHA;
4854       PixSize   := 1;
4855       Alpha     := true;
4856     end;
4857     tfBGR8ub3, tfRGB8ub3: begin
4858       ColorType := COLOR_RGB;
4859       PixSize   := 3;
4860       Alpha     := false;
4861     end;
4862     tfBGRA8ub4, tfRGBA8ub4: begin
4863       ColorType := COLOR_RGBALPHA;
4864       PixSize   := 3;
4865       Alpha     := true
4866     end;
4867   else
4868     raise EglBitmapUnsupportedFormat.Create(Format);
4869   end;
4870
4871   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4872   try
4873     // Copy ImageData
4874     pSource := Data;
4875     for Y := 0 to Height -1 do begin
4876       pDest := png.ScanLine[Y];
4877       for X := 0 to Width -1 do begin
4878         Move(pSource^, pDest^, PixSize);
4879         Inc(pDest, PixSize);
4880         Inc(pSource, PixSize);
4881         if Alpha then begin
4882           png.AlphaScanline[Y]^[X] := pSource^;
4883           Inc(pSource);
4884         end;
4885       end;
4886
4887       // convert RGB line to BGR
4888       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4889         pTemp := png.ScanLine[Y];
4890         for X := 0 to Width -1 do begin
4891           Temp := pByteArray(pTemp)^[0];
4892           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4893           pByteArray(pTemp)^[2] := Temp;
4894           Inc(pTemp, 3);
4895         end;
4896       end;
4897     end;
4898
4899     // Save to Stream
4900     Png.CompressionLevel := 6;
4901     Png.SaveToStream(aStream);
4902   finally
4903     FreeAndNil(Png);
4904   end;
4905 end;
4906 {$IFEND}
4907 {$ENDIF}
4908
4909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4910 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4912 {$IFDEF GLB_LIB_JPEG}
4913 type
4914   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4915   glBitmap_libJPEG_source_mgr = record
4916     pub: jpeg_source_mgr;
4917
4918     SrcStream: TStream;
4919     SrcBuffer: array [1..4096] of byte;
4920   end;
4921
4922   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4923   glBitmap_libJPEG_dest_mgr = record
4924     pub: jpeg_destination_mgr;
4925
4926     DestStream: TStream;
4927     DestBuffer: array [1..4096] of byte;
4928   end;
4929
4930 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4931 begin
4932   //DUMMY
4933 end;
4934
4935
4936 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4937 begin
4938   //DUMMY
4939 end;
4940
4941
4942 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4943 begin
4944   //DUMMY
4945 end;
4946
4947 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4948 begin
4949   //DUMMY
4950 end;
4951
4952
4953 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4954 begin
4955   //DUMMY
4956 end;
4957
4958
4959 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4960 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4961 var
4962   src: glBitmap_libJPEG_source_mgr_ptr;
4963   bytes: integer;
4964 begin
4965   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4966
4967   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4968         if (bytes <= 0) then begin
4969                 src^.SrcBuffer[1] := $FF;
4970                 src^.SrcBuffer[2] := JPEG_EOI;
4971                 bytes := 2;
4972         end;
4973
4974         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4975         src^.pub.bytes_in_buffer := bytes;
4976
4977   result := true;
4978 end;
4979
4980 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4981 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4982 var
4983   src: glBitmap_libJPEG_source_mgr_ptr;
4984 begin
4985   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4986
4987   if num_bytes > 0 then begin
4988     // wanted byte isn't in buffer so set stream position and read buffer
4989     if num_bytes > src^.pub.bytes_in_buffer then begin
4990       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
4991       src^.pub.fill_input_buffer(cinfo);
4992     end else begin
4993       // wanted byte is in buffer so only skip
4994                 inc(src^.pub.next_input_byte, num_bytes);
4995                 dec(src^.pub.bytes_in_buffer, num_bytes);
4996     end;
4997   end;
4998 end;
4999
5000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5001 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5002 var
5003   dest: glBitmap_libJPEG_dest_mgr_ptr;
5004 begin
5005   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5006
5007   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5008     // write complete buffer
5009     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5010
5011     // reset buffer
5012     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5013     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5014   end;
5015
5016   result := true;
5017 end;
5018
5019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5020 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5021 var
5022   Idx: Integer;
5023   dest: glBitmap_libJPEG_dest_mgr_ptr;
5024 begin
5025   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5026
5027   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5028     // check for endblock
5029     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5030       // write endblock
5031       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5032
5033       // leave
5034       break;
5035     end else
5036       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5037   end;
5038 end;
5039 {$ENDIF}
5040
5041 {$IFDEF GLB_SUPPORT_JPEG_READ}
5042 {$IF DEFINED(GLB_LAZ_JPEG)}
5043 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5044 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5045 const
5046   MAGIC_LEN = 2;
5047   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5048 var
5049   intf: TLazIntfImage;
5050   reader: TFPReaderJPEG;
5051   StreamPos: Int64;
5052   magic: String[MAGIC_LEN];
5053 begin
5054   result := true;
5055   StreamPos := aStream.Position;
5056
5057   SetLength(magic, MAGIC_LEN);
5058   aStream.Read(magic[1], MAGIC_LEN);
5059   aStream.Position := StreamPos;
5060   if (magic <> JPEG_MAGIC) then begin
5061     result := false;
5062     exit;
5063   end;
5064
5065   reader := TFPReaderJPEG.Create;
5066   intf := TLazIntfImage.Create(0, 0);
5067   try try
5068     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5069     reader.ImageRead(aStream, intf);
5070     AssignFromLazIntfImage(intf);
5071   except
5072     result := false;
5073     aStream.Position := StreamPos;
5074     exit;
5075   end;
5076   finally
5077     reader.Free;
5078     intf.Free;
5079   end;
5080 end;
5081
5082 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5083 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5084 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5085 var
5086   Surface: PSDL_Surface;
5087   RWops: PSDL_RWops;
5088 begin
5089   result := false;
5090
5091   RWops := glBitmapCreateRWops(aStream);
5092   try
5093     if IMG_isJPG(RWops) > 0 then begin
5094       Surface := IMG_LoadJPG_RW(RWops);
5095       try
5096         AssignFromSurface(Surface);
5097         result := true;
5098       finally
5099         SDL_FreeSurface(Surface);
5100       end;
5101     end;
5102   finally
5103     SDL_FreeRW(RWops);
5104   end;
5105 end;
5106
5107 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5109 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5110 var
5111   StreamPos: Int64;
5112   Temp: array[0..1]of Byte;
5113
5114   jpeg: jpeg_decompress_struct;
5115   jpeg_err: jpeg_error_mgr;
5116
5117   IntFormat: TglBitmapFormat;
5118   pImage: pByte;
5119   TempHeight, TempWidth: Integer;
5120
5121   pTemp: pByte;
5122   Row: Integer;
5123
5124   FormatDesc: TFormatDescriptor;
5125 begin
5126   result := false;
5127
5128   if not init_libJPEG then
5129     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5130
5131   try
5132     // reading first two bytes to test file and set cursor back to begin
5133     StreamPos := aStream.Position;
5134     aStream.Read({%H-}Temp[0], 2);
5135     aStream.Position := StreamPos;
5136
5137     // if Bitmap then read file.
5138     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5139       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5140       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5141
5142       // error managment
5143       jpeg.err := jpeg_std_error(@jpeg_err);
5144       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5145       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5146
5147       // decompression struct
5148       jpeg_create_decompress(@jpeg);
5149
5150       // allocation space for streaming methods
5151       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5152
5153       // seeting up custom functions
5154       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5155         pub.init_source       := glBitmap_libJPEG_init_source;
5156         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5157         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5158         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5159         pub.term_source       := glBitmap_libJPEG_term_source;
5160
5161         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5162         pub.next_input_byte := nil;   // until buffer loaded
5163
5164         SrcStream := aStream;
5165       end;
5166
5167       // set global decoding state
5168       jpeg.global_state := DSTATE_START;
5169
5170       // read header of jpeg
5171       jpeg_read_header(@jpeg, false);
5172
5173       // setting output parameter
5174       case jpeg.jpeg_color_space of
5175         JCS_GRAYSCALE:
5176           begin
5177             jpeg.out_color_space := JCS_GRAYSCALE;
5178             IntFormat := tfLuminance8ub1;
5179           end;
5180         else
5181           jpeg.out_color_space := JCS_RGB;
5182           IntFormat := tfRGB8ub3;
5183       end;
5184
5185       // reading image
5186       jpeg_start_decompress(@jpeg);
5187
5188       TempHeight := jpeg.output_height;
5189       TempWidth := jpeg.output_width;
5190
5191       FormatDesc := TFormatDescriptor.Get(IntFormat);
5192
5193       // creating new image
5194       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5195       try
5196         pTemp := pImage;
5197
5198         for Row := 0 to TempHeight -1 do begin
5199           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5200           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5201         end;
5202
5203         // finish decompression
5204         jpeg_finish_decompress(@jpeg);
5205
5206         // destroy decompression
5207         jpeg_destroy_decompress(@jpeg);
5208
5209         SetData(pImage, IntFormat, TempWidth, TempHeight);
5210
5211         result := true;
5212       except
5213         if Assigned(pImage) then
5214           FreeMem(pImage);
5215         raise;
5216       end;
5217     end;
5218   finally
5219     quit_libJPEG;
5220   end;
5221 end;
5222
5223 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5225 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5226 var
5227   bmp: TBitmap;
5228   jpg: TJPEGImage;
5229   StreamPos: Int64;
5230   Temp: array[0..1]of Byte;
5231 begin
5232   result := false;
5233
5234   // reading first two bytes to test file and set cursor back to begin
5235   StreamPos := aStream.Position;
5236   aStream.Read(Temp[0], 2);
5237   aStream.Position := StreamPos;
5238
5239   // if Bitmap then read file.
5240   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5241     bmp := TBitmap.Create;
5242     try
5243       jpg := TJPEGImage.Create;
5244       try
5245         jpg.LoadFromStream(aStream);
5246         bmp.Assign(jpg);
5247         result := AssignFromBitmap(bmp);
5248       finally
5249         jpg.Free;
5250       end;
5251     finally
5252       bmp.Free;
5253     end;
5254   end;
5255 end;
5256 {$IFEND}
5257 {$ENDIF}
5258
5259 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5260 {$IF DEFINED(GLB_LAZ_JPEG)}
5261 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5262 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5263 var
5264   jpeg: TJPEGImage;
5265   intf: TLazIntfImage;
5266   raw: TRawImage;
5267 begin
5268   jpeg := TJPEGImage.Create;
5269   intf := TLazIntfImage.Create(0, 0);
5270   try
5271     if not AssignToLazIntfImage(intf) then
5272       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5273     intf.GetRawImage(raw);
5274     jpeg.LoadFromRawImage(raw, false);
5275     jpeg.SaveToStream(aStream);
5276   finally
5277     intf.Free;
5278     jpeg.Free;
5279   end;
5280 end;
5281
5282 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5285 var
5286   jpeg: jpeg_compress_struct;
5287   jpeg_err: jpeg_error_mgr;
5288   Row: Integer;
5289   pTemp, pTemp2: pByte;
5290
5291   procedure CopyRow(pDest, pSource: pByte);
5292   var
5293     X: Integer;
5294   begin
5295     for X := 0 to Width - 1 do begin
5296       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5297       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5298       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5299       Inc(pDest, 3);
5300       Inc(pSource, 3);
5301     end;
5302   end;
5303
5304 begin
5305   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5306     raise EglBitmapUnsupportedFormat.Create(Format);
5307
5308   if not init_libJPEG then
5309     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5310
5311   try
5312     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5313     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5314
5315     // error managment
5316     jpeg.err := jpeg_std_error(@jpeg_err);
5317     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5318     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5319
5320     // compression struct
5321     jpeg_create_compress(@jpeg);
5322
5323     // allocation space for streaming methods
5324     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5325
5326     // seeting up custom functions
5327     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5328       pub.init_destination    := glBitmap_libJPEG_init_destination;
5329       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5330       pub.term_destination    := glBitmap_libJPEG_term_destination;
5331
5332       pub.next_output_byte  := @DestBuffer[1];
5333       pub.free_in_buffer    := Length(DestBuffer);
5334
5335       DestStream := aStream;
5336     end;
5337
5338     // very important state
5339     jpeg.global_state := CSTATE_START;
5340     jpeg.image_width  := Width;
5341     jpeg.image_height := Height;
5342     case Format of
5343       tfAlpha8ub1, tfLuminance8ub1: begin
5344         jpeg.input_components := 1;
5345         jpeg.in_color_space   := JCS_GRAYSCALE;
5346       end;
5347       tfRGB8ub3, tfBGR8ub3: begin
5348         jpeg.input_components := 3;
5349         jpeg.in_color_space   := JCS_RGB;
5350       end;
5351     end;
5352
5353     jpeg_set_defaults(@jpeg);
5354     jpeg_set_quality(@jpeg, 95, true);
5355     jpeg_start_compress(@jpeg, true);
5356     pTemp := Data;
5357
5358     if Format = tfBGR8ub3 then
5359       GetMem(pTemp2, fRowSize)
5360     else
5361       pTemp2 := pTemp;
5362
5363     try
5364       for Row := 0 to jpeg.image_height -1 do begin
5365         // prepare row
5366         if Format = tfBGR8ub3 then
5367           CopyRow(pTemp2, pTemp)
5368         else
5369           pTemp2 := pTemp;
5370
5371         // write row
5372         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5373         inc(pTemp, fRowSize);
5374       end;
5375     finally
5376       // free memory
5377       if Format = tfBGR8ub3 then
5378         FreeMem(pTemp2);
5379     end;
5380     jpeg_finish_compress(@jpeg);
5381     jpeg_destroy_compress(@jpeg);
5382   finally
5383     quit_libJPEG;
5384   end;
5385 end;
5386
5387 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5389 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5390 var
5391   Bmp: TBitmap;
5392   Jpg: TJPEGImage;
5393 begin
5394   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5395     raise EglBitmapUnsupportedFormat.Create(Format);
5396
5397   Bmp := TBitmap.Create;
5398   try
5399     Jpg := TJPEGImage.Create;
5400     try
5401       AssignToBitmap(Bmp);
5402       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5403         Jpg.Grayscale   := true;
5404         Jpg.PixelFormat := jf8Bit;
5405       end;
5406       Jpg.Assign(Bmp);
5407       Jpg.SaveToStream(aStream);
5408     finally
5409       FreeAndNil(Jpg);
5410     end;
5411   finally
5412     FreeAndNil(Bmp);
5413   end;
5414 end;
5415 {$IFEND}
5416 {$ENDIF}
5417
5418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5419 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5421 type
5422   RawHeader = packed record
5423     Magic:        String[5];
5424     Version:      Byte;
5425     Width:        Integer;
5426     Height:       Integer;
5427     DataSize:     Integer;
5428     BitsPerPixel: Integer;
5429     Precision:    TglBitmapRec4ub;
5430     Shift:        TglBitmapRec4ub;
5431   end;
5432
5433 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5434 var
5435   header: RawHeader;
5436   StartPos: Int64;
5437   fd: TFormatDescriptor;
5438   buf: PByte;
5439 begin
5440   result := false;
5441   StartPos := aStream.Position;
5442   aStream.Read(header{%H-}, SizeOf(header));
5443   if (header.Magic <> 'glBMP') then begin
5444     aStream.Position := StartPos;
5445     exit;
5446   end;
5447
5448   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5449   if (fd.Format = tfEmpty) then
5450     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5451
5452   buf := GetMemory(header.DataSize);
5453   aStream.Read(buf^, header.DataSize);
5454   SetData(buf, fd.Format, header.Width, header.Height);
5455
5456   result := true;
5457 end;
5458
5459 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5460 var
5461   header: RawHeader;
5462   fd: TFormatDescriptor;
5463 begin
5464   fd := TFormatDescriptor.Get(Format);
5465   header.Magic        := 'glBMP';
5466   header.Version      := 1;
5467   header.Width        := Width;
5468   header.Height       := Height;
5469   header.DataSize     := fd.GetSize(fDimension);
5470   header.BitsPerPixel := fd.BitsPerPixel;
5471   header.Precision    := fd.Precision;
5472   header.Shift        := fd.Shift;
5473   aStream.Write(header, SizeOf(header));
5474   aStream.Write(Data^,  header.DataSize);
5475 end;
5476
5477 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5478 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5480 const
5481   BMP_MAGIC          = $4D42;
5482
5483   BMP_COMP_RGB       = 0;
5484   BMP_COMP_RLE8      = 1;
5485   BMP_COMP_RLE4      = 2;
5486   BMP_COMP_BITFIELDS = 3;
5487
5488 type
5489   TBMPHeader = packed record
5490     bfType: Word;
5491     bfSize: Cardinal;
5492     bfReserved1: Word;
5493     bfReserved2: Word;
5494     bfOffBits: Cardinal;
5495   end;
5496
5497   TBMPInfo = packed record
5498     biSize: Cardinal;
5499     biWidth: Longint;
5500     biHeight: Longint;
5501     biPlanes: Word;
5502     biBitCount: Word;
5503     biCompression: Cardinal;
5504     biSizeImage: Cardinal;
5505     biXPelsPerMeter: Longint;
5506     biYPelsPerMeter: Longint;
5507     biClrUsed: Cardinal;
5508     biClrImportant: Cardinal;
5509   end;
5510
5511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5512 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5513
5514   //////////////////////////////////////////////////////////////////////////////////////////////////
5515   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5516   var
5517     tmp, i: Cardinal;
5518   begin
5519     result := tfEmpty;
5520     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5521     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5522
5523     //Read Compression
5524     case aInfo.biCompression of
5525       BMP_COMP_RLE4,
5526       BMP_COMP_RLE8: begin
5527         raise EglBitmap.Create('RLE compression is not supported');
5528       end;
5529       BMP_COMP_BITFIELDS: begin
5530         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5531           for i := 0 to 2 do begin
5532             aStream.Read(tmp{%H-}, SizeOf(tmp));
5533             aMask.arr[i] := tmp;
5534           end;
5535         end else
5536           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5537       end;
5538     end;
5539
5540     //get suitable format
5541     case aInfo.biBitCount of
5542        8: result := tfLuminance8ub1;
5543       16: result := tfX1RGB5us1;
5544       24: result := tfBGR8ub3;
5545       32: result := tfXRGB8ui1;
5546     end;
5547   end;
5548
5549   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5550   var
5551     i, c: Integer;
5552     fd: TFormatDescriptor;
5553     ColorTable: TbmpColorTable;
5554   begin
5555     result := nil;
5556     if (aInfo.biBitCount >= 16) then
5557       exit;
5558     aFormat := tfLuminance8ub1;
5559     c := aInfo.biClrUsed;
5560     if (c = 0) then
5561       c := 1 shl aInfo.biBitCount;
5562     SetLength(ColorTable, c);
5563     for i := 0 to c-1 do begin
5564       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5565       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5566         aFormat := tfRGB8ub3;
5567     end;
5568
5569     fd := TFormatDescriptor.Get(aFormat);
5570     result := TbmpColorTableFormat.Create;
5571     result.ColorTable   := ColorTable;
5572     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5573   end;
5574
5575   //////////////////////////////////////////////////////////////////////////////////////////////////
5576   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5577   var
5578     fd: TFormatDescriptor;
5579   begin
5580     result := nil;
5581     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5582
5583       // find suitable format ...
5584       fd := TFormatDescriptor.GetFromMask(aMask);
5585       if (fd.Format <> tfEmpty) then begin
5586         aFormat := fd.Format;
5587         exit;
5588       end;
5589
5590       // or create custom bitfield format
5591       result := TbmpBitfieldFormat.Create;
5592       result.SetCustomValues(aInfo.biBitCount, aMask);
5593     end;
5594   end;
5595
5596 var
5597   //simple types
5598   StartPos: Int64;
5599   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5600   PaddingBuff: Cardinal;
5601   LineBuf, ImageData, TmpData: PByte;
5602   SourceMD, DestMD: Pointer;
5603   BmpFormat: TglBitmapFormat;
5604
5605   //records
5606   Mask: TglBitmapRec4ul;
5607   Header: TBMPHeader;
5608   Info: TBMPInfo;
5609
5610   //classes
5611   SpecialFormat: TFormatDescriptor;
5612   FormatDesc: TFormatDescriptor;
5613
5614   //////////////////////////////////////////////////////////////////////////////////////////////////
5615   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5616   var
5617     i: Integer;
5618     Pixel: TglBitmapPixelData;
5619   begin
5620     aStream.Read(aLineBuf^, rbLineSize);
5621     SpecialFormat.PreparePixel(Pixel);
5622     for i := 0 to Info.biWidth-1 do begin
5623       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5624       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5625       FormatDesc.Map(Pixel, aData, DestMD);
5626     end;
5627   end;
5628
5629 begin
5630   result        := false;
5631   BmpFormat     := tfEmpty;
5632   SpecialFormat := nil;
5633   LineBuf       := nil;
5634   SourceMD      := nil;
5635   DestMD        := nil;
5636
5637   // Header
5638   StartPos := aStream.Position;
5639   aStream.Read(Header{%H-}, SizeOf(Header));
5640
5641   if Header.bfType = BMP_MAGIC then begin
5642     try try
5643       BmpFormat        := ReadInfo(Info, Mask);
5644       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5645       if not Assigned(SpecialFormat) then
5646         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5647       aStream.Position := StartPos + Header.bfOffBits;
5648
5649       if (BmpFormat <> tfEmpty) then begin
5650         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5651         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5652         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5653         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5654
5655         //get Memory
5656         DestMD    := FormatDesc.CreateMappingData;
5657         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5658         GetMem(ImageData, ImageSize);
5659         if Assigned(SpecialFormat) then begin
5660           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5661           SourceMD := SpecialFormat.CreateMappingData;
5662         end;
5663
5664         //read Data
5665         try try
5666           FillChar(ImageData^, ImageSize, $FF);
5667           TmpData := ImageData;
5668           if (Info.biHeight > 0) then
5669             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5670           for i := 0 to Abs(Info.biHeight)-1 do begin
5671             if Assigned(SpecialFormat) then
5672               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5673             else
5674               aStream.Read(TmpData^, wbLineSize);   //else only read data
5675             if (Info.biHeight > 0) then
5676               dec(TmpData, wbLineSize)
5677             else
5678               inc(TmpData, wbLineSize);
5679             aStream.Read(PaddingBuff{%H-}, Padding);
5680           end;
5681           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5682           result := true;
5683         finally
5684           if Assigned(LineBuf) then
5685             FreeMem(LineBuf);
5686           if Assigned(SourceMD) then
5687             SpecialFormat.FreeMappingData(SourceMD);
5688           FormatDesc.FreeMappingData(DestMD);
5689         end;
5690         except
5691           if Assigned(ImageData) then
5692             FreeMem(ImageData);
5693           raise;
5694         end;
5695       end else
5696         raise EglBitmap.Create('LoadBMP - No suitable format found');
5697     except
5698       aStream.Position := StartPos;
5699       raise;
5700     end;
5701     finally
5702       FreeAndNil(SpecialFormat);
5703     end;
5704   end
5705     else aStream.Position := StartPos;
5706 end;
5707
5708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5709 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5710 var
5711   Header: TBMPHeader;
5712   Info: TBMPInfo;
5713   Converter: TFormatDescriptor;
5714   FormatDesc: TFormatDescriptor;
5715   SourceFD, DestFD: Pointer;
5716   pData, srcData, dstData, ConvertBuffer: pByte;
5717
5718   Pixel: TglBitmapPixelData;
5719   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5720   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5721
5722   PaddingBuff: Cardinal;
5723
5724   function GetLineWidth : Integer;
5725   begin
5726     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5727   end;
5728
5729 begin
5730   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5731     raise EglBitmapUnsupportedFormat.Create(Format);
5732
5733   Converter  := nil;
5734   FormatDesc := TFormatDescriptor.Get(Format);
5735   ImageSize  := FormatDesc.GetSize(Dimension);
5736
5737   FillChar(Header{%H-}, SizeOf(Header), 0);
5738   Header.bfType      := BMP_MAGIC;
5739   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5740   Header.bfReserved1 := 0;
5741   Header.bfReserved2 := 0;
5742   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5743
5744   FillChar(Info{%H-}, SizeOf(Info), 0);
5745   Info.biSize        := SizeOf(Info);
5746   Info.biWidth       := Width;
5747   Info.biHeight      := Height;
5748   Info.biPlanes      := 1;
5749   Info.biCompression := BMP_COMP_RGB;
5750   Info.biSizeImage   := ImageSize;
5751
5752   try
5753     case Format of
5754       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5755       begin
5756         Info.biBitCount  :=  8;
5757         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5758         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5759         Converter := TbmpColorTableFormat.Create;
5760         with (Converter as TbmpColorTableFormat) do begin
5761           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5762           CreateColorTable;
5763         end;
5764       end;
5765
5766       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5767       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5768       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5769       begin
5770         Info.biBitCount    := 16;
5771         Info.biCompression := BMP_COMP_BITFIELDS;
5772       end;
5773
5774       tfBGR8ub3, tfRGB8ub3:
5775       begin
5776         Info.biBitCount := 24;
5777         if (Format = tfRGB8ub3) then
5778           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5779       end;
5780
5781       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5782       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5783       begin
5784         Info.biBitCount    := 32;
5785         Info.biCompression := BMP_COMP_BITFIELDS;
5786       end;
5787     else
5788       raise EglBitmapUnsupportedFormat.Create(Format);
5789     end;
5790     Info.biXPelsPerMeter := 2835;
5791     Info.biYPelsPerMeter := 2835;
5792
5793     // prepare bitmasks
5794     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5795       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5796       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5797
5798       RedMask    := FormatDesc.Mask.r;
5799       GreenMask  := FormatDesc.Mask.g;
5800       BlueMask   := FormatDesc.Mask.b;
5801       AlphaMask  := FormatDesc.Mask.a;
5802     end;
5803
5804     // headers
5805     aStream.Write(Header, SizeOf(Header));
5806     aStream.Write(Info, SizeOf(Info));
5807
5808     // colortable
5809     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5810       with (Converter as TbmpColorTableFormat) do
5811         aStream.Write(ColorTable[0].b,
5812           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5813
5814     // bitmasks
5815     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5816       aStream.Write(RedMask,   SizeOf(Cardinal));
5817       aStream.Write(GreenMask, SizeOf(Cardinal));
5818       aStream.Write(BlueMask,  SizeOf(Cardinal));
5819       aStream.Write(AlphaMask, SizeOf(Cardinal));
5820     end;
5821
5822     // image data
5823     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5824     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5825     Padding     := GetLineWidth - wbLineSize;
5826     PaddingBuff := 0;
5827
5828     pData := Data;
5829     inc(pData, (Height-1) * rbLineSize);
5830
5831     // prepare row buffer. But only for RGB because RGBA supports color masks
5832     // so it's possible to change color within the image.
5833     if Assigned(Converter) then begin
5834       FormatDesc.PreparePixel(Pixel);
5835       GetMem(ConvertBuffer, wbLineSize);
5836       SourceFD := FormatDesc.CreateMappingData;
5837       DestFD   := Converter.CreateMappingData;
5838     end else
5839       ConvertBuffer := nil;
5840
5841     try
5842       for LineIdx := 0 to Height - 1 do begin
5843         // preparing row
5844         if Assigned(Converter) then begin
5845           srcData := pData;
5846           dstData := ConvertBuffer;
5847           for PixelIdx := 0 to Info.biWidth-1 do begin
5848             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5849             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5850             Converter.Map(Pixel, dstData, DestFD);
5851           end;
5852           aStream.Write(ConvertBuffer^, wbLineSize);
5853         end else begin
5854           aStream.Write(pData^, rbLineSize);
5855         end;
5856         dec(pData, rbLineSize);
5857         if (Padding > 0) then
5858           aStream.Write(PaddingBuff, Padding);
5859       end;
5860     finally
5861       // destroy row buffer
5862       if Assigned(ConvertBuffer) then begin
5863         FormatDesc.FreeMappingData(SourceFD);
5864         Converter.FreeMappingData(DestFD);
5865         FreeMem(ConvertBuffer);
5866       end;
5867     end;
5868   finally
5869     if Assigned(Converter) then
5870       Converter.Free;
5871   end;
5872 end;
5873
5874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5875 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5877 type
5878   TTGAHeader = packed record
5879     ImageID: Byte;
5880     ColorMapType: Byte;
5881     ImageType: Byte;
5882     //ColorMapSpec: Array[0..4] of Byte;
5883     ColorMapStart: Word;
5884     ColorMapLength: Word;
5885     ColorMapEntrySize: Byte;
5886     OrigX: Word;
5887     OrigY: Word;
5888     Width: Word;
5889     Height: Word;
5890     Bpp: Byte;
5891     ImageDesc: Byte;
5892   end;
5893
5894 const
5895   TGA_UNCOMPRESSED_RGB  =  2;
5896   TGA_UNCOMPRESSED_GRAY =  3;
5897   TGA_COMPRESSED_RGB    = 10;
5898   TGA_COMPRESSED_GRAY   = 11;
5899
5900   TGA_NONE_COLOR_TABLE  = 0;
5901
5902 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5903 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5904 var
5905   Header: TTGAHeader;
5906   ImageData: System.PByte;
5907   StartPosition: Int64;
5908   PixelSize, LineSize: Integer;
5909   tgaFormat: TglBitmapFormat;
5910   FormatDesc: TFormatDescriptor;
5911   Counter: packed record
5912     X, Y: packed record
5913       low, high, dir: Integer;
5914     end;
5915   end;
5916
5917 const
5918   CACHE_SIZE = $4000;
5919
5920   ////////////////////////////////////////////////////////////////////////////////////////
5921   procedure ReadUncompressed;
5922   var
5923     i, j: Integer;
5924     buf, tmp1, tmp2: System.PByte;
5925   begin
5926     buf := nil;
5927     if (Counter.X.dir < 0) then
5928       GetMem(buf, LineSize);
5929     try
5930       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5931         tmp1 := ImageData;
5932         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5933         if (Counter.X.dir < 0) then begin               //flip X
5934           aStream.Read(buf^, LineSize);
5935           tmp2 := buf;
5936           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5937           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5938             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5939               tmp1^ := tmp2^;
5940               inc(tmp1);
5941               inc(tmp2);
5942             end;
5943             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5944           end;
5945         end else
5946           aStream.Read(tmp1^, LineSize);
5947         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5948       end;
5949     finally
5950       if Assigned(buf) then
5951         FreeMem(buf);
5952     end;
5953   end;
5954
5955   ////////////////////////////////////////////////////////////////////////////////////////
5956   procedure ReadCompressed;
5957
5958     /////////////////////////////////////////////////////////////////
5959     var
5960       TmpData: System.PByte;
5961       LinePixelsRead: Integer;
5962     procedure CheckLine;
5963     begin
5964       if (LinePixelsRead >= Header.Width) then begin
5965         LinePixelsRead := 0;
5966         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5967         TmpData := ImageData;
5968         inc(TmpData, Counter.Y.low * LineSize);           //set line
5969         if (Counter.X.dir < 0) then                       //if x flipped then
5970           inc(TmpData, LineSize - PixelSize);             //set last pixel
5971       end;
5972     end;
5973
5974     /////////////////////////////////////////////////////////////////
5975     var
5976       Cache: PByte;
5977       CacheSize, CachePos: Integer;
5978     procedure CachedRead(out Buffer; Count: Integer);
5979     var
5980       BytesRead: Integer;
5981     begin
5982       if (CachePos + Count > CacheSize) then begin
5983         //if buffer overflow save non read bytes
5984         BytesRead := 0;
5985         if (CacheSize - CachePos > 0) then begin
5986           BytesRead := CacheSize - CachePos;
5987           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
5988           inc(CachePos, BytesRead);
5989         end;
5990
5991         //load cache from file
5992         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
5993         aStream.Read(Cache^, CacheSize);
5994         CachePos := 0;
5995
5996         //read rest of requested bytes
5997         if (Count - BytesRead > 0) then begin
5998           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
5999           inc(CachePos, Count - BytesRead);
6000         end;
6001       end else begin
6002         //if no buffer overflow just read the data
6003         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6004         inc(CachePos, Count);
6005       end;
6006     end;
6007
6008     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6009     begin
6010       case PixelSize of
6011         1: begin
6012           aBuffer^ := aData^;
6013           inc(aBuffer, Counter.X.dir);
6014         end;
6015         2: begin
6016           PWord(aBuffer)^ := PWord(aData)^;
6017           inc(aBuffer, 2 * Counter.X.dir);
6018         end;
6019         3: begin
6020           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6021           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6022           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6023           inc(aBuffer, 3 * Counter.X.dir);
6024         end;
6025         4: begin
6026           PCardinal(aBuffer)^ := PCardinal(aData)^;
6027           inc(aBuffer, 4 * Counter.X.dir);
6028         end;
6029       end;
6030     end;
6031
6032   var
6033     TotalPixelsToRead, TotalPixelsRead: Integer;
6034     Temp: Byte;
6035     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6036     PixelRepeat: Boolean;
6037     PixelsToRead, PixelCount: Integer;
6038   begin
6039     CacheSize := 0;
6040     CachePos  := 0;
6041
6042     TotalPixelsToRead := Header.Width * Header.Height;
6043     TotalPixelsRead   := 0;
6044     LinePixelsRead    := 0;
6045
6046     GetMem(Cache, CACHE_SIZE);
6047     try
6048       TmpData := ImageData;
6049       inc(TmpData, Counter.Y.low * LineSize);           //set line
6050       if (Counter.X.dir < 0) then                       //if x flipped then
6051         inc(TmpData, LineSize - PixelSize);             //set last pixel
6052
6053       repeat
6054         //read CommandByte
6055         CachedRead(Temp, 1);
6056         PixelRepeat  := (Temp and $80) > 0;
6057         PixelsToRead := (Temp and $7F) + 1;
6058         inc(TotalPixelsRead, PixelsToRead);
6059
6060         if PixelRepeat then
6061           CachedRead(buf[0], PixelSize);
6062         while (PixelsToRead > 0) do begin
6063           CheckLine;
6064           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6065           while (PixelCount > 0) do begin
6066             if not PixelRepeat then
6067               CachedRead(buf[0], PixelSize);
6068             PixelToBuffer(@buf[0], TmpData);
6069             inc(LinePixelsRead);
6070             dec(PixelsToRead);
6071             dec(PixelCount);
6072           end;
6073         end;
6074       until (TotalPixelsRead >= TotalPixelsToRead);
6075     finally
6076       FreeMem(Cache);
6077     end;
6078   end;
6079
6080   function IsGrayFormat: Boolean;
6081   begin
6082     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6083   end;
6084
6085 begin
6086   result := false;
6087
6088   // reading header to test file and set cursor back to begin
6089   StartPosition := aStream.Position;
6090   aStream.Read(Header{%H-}, SizeOf(Header));
6091
6092   // no colormapped files
6093   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6094     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6095   begin
6096     try
6097       if Header.ImageID <> 0 then       // skip image ID
6098         aStream.Position := aStream.Position + Header.ImageID;
6099
6100       tgaFormat := tfEmpty;
6101       case Header.Bpp of
6102          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6103                0: tgaFormat := tfLuminance8ub1;
6104                8: tgaFormat := tfAlpha8ub1;
6105             end;
6106
6107         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6108                0: tgaFormat := tfLuminance16us1;
6109                8: tgaFormat := tfLuminance8Alpha8ub2;
6110             end else case (Header.ImageDesc and $F) of
6111                0: tgaFormat := tfX1RGB5us1;
6112                1: tgaFormat := tfA1RGB5us1;
6113                4: tgaFormat := tfARGB4us1;
6114             end;
6115
6116         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6117                0: tgaFormat := tfBGR8ub3;
6118             end;
6119
6120         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6121                0: tgaFormat := tfDepth32ui1;
6122             end else case (Header.ImageDesc and $F) of
6123                0: tgaFormat := tfX2RGB10ui1;
6124                2: tgaFormat := tfA2RGB10ui1;
6125                8: tgaFormat := tfARGB8ui1;
6126             end;
6127       end;
6128
6129       if (tgaFormat = tfEmpty) then
6130         raise EglBitmap.Create('LoadTga - unsupported format');
6131
6132       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6133       PixelSize  := FormatDesc.GetSize(1, 1);
6134       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6135
6136       GetMem(ImageData, LineSize * Header.Height);
6137       try
6138         //column direction
6139         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6140           Counter.X.low  := Header.Height-1;;
6141           Counter.X.high := 0;
6142           Counter.X.dir  := -1;
6143         end else begin
6144           Counter.X.low  := 0;
6145           Counter.X.high := Header.Height-1;
6146           Counter.X.dir  := 1;
6147         end;
6148
6149         // Row direction
6150         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6151           Counter.Y.low  := 0;
6152           Counter.Y.high := Header.Height-1;
6153           Counter.Y.dir  := 1;
6154         end else begin
6155           Counter.Y.low  := Header.Height-1;;
6156           Counter.Y.high := 0;
6157           Counter.Y.dir  := -1;
6158         end;
6159
6160         // Read Image
6161         case Header.ImageType of
6162           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6163             ReadUncompressed;
6164           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6165             ReadCompressed;
6166         end;
6167
6168         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6169         result := true;
6170       except
6171         if Assigned(ImageData) then
6172           FreeMem(ImageData);
6173         raise;
6174       end;
6175     finally
6176       aStream.Position := StartPosition;
6177     end;
6178   end
6179     else aStream.Position := StartPosition;
6180 end;
6181
6182 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6183 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6184 var
6185   Header: TTGAHeader;
6186   Size: Integer;
6187   FormatDesc: TFormatDescriptor;
6188 begin
6189   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6190     raise EglBitmapUnsupportedFormat.Create(Format);
6191
6192   //prepare header
6193   FormatDesc := TFormatDescriptor.Get(Format);
6194   FillChar(Header{%H-}, SizeOf(Header), 0);
6195   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6196   Header.Bpp       := FormatDesc.BitsPerPixel;
6197   Header.Width     := Width;
6198   Header.Height    := Height;
6199   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6200   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6201     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6202   else
6203     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6204   aStream.Write(Header, SizeOf(Header));
6205
6206   // write Data
6207   Size := FormatDesc.GetSize(Dimension);
6208   aStream.Write(Data^, Size);
6209 end;
6210
6211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6212 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6214 const
6215   DDS_MAGIC: Cardinal         = $20534444;
6216
6217   // DDS_header.dwFlags
6218   DDSD_CAPS                   = $00000001;
6219   DDSD_HEIGHT                 = $00000002;
6220   DDSD_WIDTH                  = $00000004;
6221   DDSD_PIXELFORMAT            = $00001000;
6222
6223   // DDS_header.sPixelFormat.dwFlags
6224   DDPF_ALPHAPIXELS            = $00000001;
6225   DDPF_ALPHA                  = $00000002;
6226   DDPF_FOURCC                 = $00000004;
6227   DDPF_RGB                    = $00000040;
6228   DDPF_LUMINANCE              = $00020000;
6229
6230   // DDS_header.sCaps.dwCaps1
6231   DDSCAPS_TEXTURE             = $00001000;
6232
6233   // DDS_header.sCaps.dwCaps2
6234   DDSCAPS2_CUBEMAP            = $00000200;
6235
6236   D3DFMT_DXT1                 = $31545844;
6237   D3DFMT_DXT3                 = $33545844;
6238   D3DFMT_DXT5                 = $35545844;
6239
6240 type
6241   TDDSPixelFormat = packed record
6242     dwSize: Cardinal;
6243     dwFlags: Cardinal;
6244     dwFourCC: Cardinal;
6245     dwRGBBitCount: Cardinal;
6246     dwRBitMask: Cardinal;
6247     dwGBitMask: Cardinal;
6248     dwBBitMask: Cardinal;
6249     dwABitMask: Cardinal;
6250   end;
6251
6252   TDDSCaps = packed record
6253     dwCaps1: Cardinal;
6254     dwCaps2: Cardinal;
6255     dwDDSX: Cardinal;
6256     dwReserved: Cardinal;
6257   end;
6258
6259   TDDSHeader = packed record
6260     dwSize: Cardinal;
6261     dwFlags: Cardinal;
6262     dwHeight: Cardinal;
6263     dwWidth: Cardinal;
6264     dwPitchOrLinearSize: Cardinal;
6265     dwDepth: Cardinal;
6266     dwMipMapCount: Cardinal;
6267     dwReserved: array[0..10] of Cardinal;
6268     PixelFormat: TDDSPixelFormat;
6269     Caps: TDDSCaps;
6270     dwReserved2: Cardinal;
6271   end;
6272
6273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6274 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6275 var
6276   Header: TDDSHeader;
6277   Converter: TbmpBitfieldFormat;
6278
6279   function GetDDSFormat: TglBitmapFormat;
6280   var
6281     fd: TFormatDescriptor;
6282     i: Integer;
6283     Mask: TglBitmapRec4ul;
6284     Range: TglBitmapRec4ui;
6285     match: Boolean;
6286   begin
6287     result := tfEmpty;
6288     with Header.PixelFormat do begin
6289       // Compresses
6290       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6291         case Header.PixelFormat.dwFourCC of
6292           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6293           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6294           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6295         end;
6296       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6297         // prepare masks
6298         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6299           Mask.r := dwRBitMask;
6300           Mask.g := dwGBitMask;
6301           Mask.b := dwBBitMask;
6302         end else begin
6303           Mask.r := dwRBitMask;
6304           Mask.g := dwRBitMask;
6305           Mask.b := dwRBitMask;
6306         end;
6307         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6308           Mask.a := dwABitMask
6309         else
6310           Mask.a := 0;;
6311
6312         //find matching format
6313         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6314         result := fd.Format;
6315         if (result <> tfEmpty) then
6316           exit;
6317
6318         //find format with same Range
6319         for i := 0 to 3 do
6320           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6321         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6322           fd := TFormatDescriptor.Get(result);
6323           match := true;
6324           for i := 0 to 3 do
6325             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6326               match := false;
6327               break;
6328             end;
6329           if match then
6330             break;
6331         end;
6332
6333         //no format with same range found -> use default
6334         if (result = tfEmpty) then begin
6335           if (dwABitMask > 0) then
6336             result := tfRGBA8ui1
6337           else
6338             result := tfRGB8ub3;
6339         end;
6340
6341         Converter := TbmpBitfieldFormat.Create;
6342         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6343       end;
6344     end;
6345   end;
6346
6347 var
6348   StreamPos: Int64;
6349   x, y, LineSize, RowSize, Magic: Cardinal;
6350   NewImage, TmpData, RowData, SrcData: System.PByte;
6351   SourceMD, DestMD: Pointer;
6352   Pixel: TglBitmapPixelData;
6353   ddsFormat: TglBitmapFormat;
6354   FormatDesc: TFormatDescriptor;
6355
6356 begin
6357   result    := false;
6358   Converter := nil;
6359   StreamPos := aStream.Position;
6360
6361   // Magic
6362   aStream.Read(Magic{%H-}, sizeof(Magic));
6363   if (Magic <> DDS_MAGIC) then begin
6364     aStream.Position := StreamPos;
6365     exit;
6366   end;
6367
6368   //Header
6369   aStream.Read(Header{%H-}, sizeof(Header));
6370   if (Header.dwSize <> SizeOf(Header)) or
6371      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6372         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6373   begin
6374     aStream.Position := StreamPos;
6375     exit;
6376   end;
6377
6378   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6379     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6380
6381   ddsFormat := GetDDSFormat;
6382   try
6383     if (ddsFormat = tfEmpty) then
6384       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6385
6386     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6387     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6388     GetMem(NewImage, Header.dwHeight * LineSize);
6389     try
6390       TmpData := NewImage;
6391
6392       //Converter needed
6393       if Assigned(Converter) then begin
6394         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6395         GetMem(RowData, RowSize);
6396         SourceMD := Converter.CreateMappingData;
6397         DestMD   := FormatDesc.CreateMappingData;
6398         try
6399           for y := 0 to Header.dwHeight-1 do begin
6400             TmpData := NewImage;
6401             inc(TmpData, y * LineSize);
6402             SrcData := RowData;
6403             aStream.Read(SrcData^, RowSize);
6404             for x := 0 to Header.dwWidth-1 do begin
6405               Converter.Unmap(SrcData, Pixel, SourceMD);
6406               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6407               FormatDesc.Map(Pixel, TmpData, DestMD);
6408             end;
6409           end;
6410         finally
6411           Converter.FreeMappingData(SourceMD);
6412           FormatDesc.FreeMappingData(DestMD);
6413           FreeMem(RowData);
6414         end;
6415       end else
6416
6417       // Compressed
6418       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6419         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6420         for Y := 0 to Header.dwHeight-1 do begin
6421           aStream.Read(TmpData^, RowSize);
6422           Inc(TmpData, LineSize);
6423         end;
6424       end else
6425
6426       // Uncompressed
6427       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6428         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6429         for Y := 0 to Header.dwHeight-1 do begin
6430           aStream.Read(TmpData^, RowSize);
6431           Inc(TmpData, LineSize);
6432         end;
6433       end else
6434         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6435
6436       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6437       result := true;
6438     except
6439       if Assigned(NewImage) then
6440         FreeMem(NewImage);
6441       raise;
6442     end;
6443   finally
6444     FreeAndNil(Converter);
6445   end;
6446 end;
6447
6448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6449 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6450 var
6451   Header: TDDSHeader;
6452   FormatDesc: TFormatDescriptor;
6453 begin
6454   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6455     raise EglBitmapUnsupportedFormat.Create(Format);
6456
6457   FormatDesc := TFormatDescriptor.Get(Format);
6458
6459   // Generell
6460   FillChar(Header{%H-}, SizeOf(Header), 0);
6461   Header.dwSize  := SizeOf(Header);
6462   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6463
6464   Header.dwWidth  := Max(1, Width);
6465   Header.dwHeight := Max(1, Height);
6466
6467   // Caps
6468   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6469
6470   // Pixelformat
6471   Header.PixelFormat.dwSize := sizeof(Header);
6472   if (FormatDesc.IsCompressed) then begin
6473     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6474     case Format of
6475       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6476       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6477       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6478     end;
6479   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6480     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6481     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6482     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6483   end else if FormatDesc.IsGrayscale then begin
6484     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6485     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6486     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6487     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6488   end else begin
6489     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6490     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6491     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6492     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6493     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6494     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6495   end;
6496
6497   if (FormatDesc.HasAlpha) then
6498     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6499
6500   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6501   aStream.Write(Header, SizeOf(Header));
6502   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6503 end;
6504
6505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6506 function TglBitmapData.FlipHorz: Boolean;
6507 var
6508   fd: TglBitmapFormatDescriptor;
6509   Col, RowSize, PixelSize: Integer;
6510   pTempDest, pDest, pSource: PByte;
6511 begin
6512   result    := false;
6513   fd        := FormatDescriptor;
6514   PixelSize := Ceil(fd.BytesPerPixel);
6515   RowSize   := fd.GetSize(Width, 1);
6516   if Assigned(Data) and not fd.IsCompressed then begin
6517     pSource := Data;
6518     GetMem(pDest, RowSize);
6519     try
6520       pTempDest := pDest;
6521       Inc(pTempDest, RowSize);
6522       for Col := 0 to Width-1 do begin
6523         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6524         Move(pSource^, pTempDest^, PixelSize);
6525         Inc(pSource, PixelSize);
6526       end;
6527       SetData(pDest, Format, Width);
6528       result := true;
6529     except
6530       if Assigned(pDest) then
6531         FreeMem(pDest);
6532       raise;
6533     end;
6534   end;
6535 end;
6536
6537 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6538 function TglBitmapData.FlipVert: Boolean;
6539 var
6540   fd: TglBitmapFormatDescriptor;
6541   Row, RowSize, PixelSize: Integer;
6542   TempDestData, DestData, SourceData: PByte;
6543 begin
6544   result    := false;
6545   fd        := FormatDescriptor;
6546   PixelSize := Ceil(fd.BytesPerPixel);
6547   RowSize   := fd.GetSize(Width, 1);
6548   if Assigned(Data) then begin
6549     SourceData := Data;
6550     GetMem(DestData, Height * RowSize);
6551     try
6552       TempDestData := DestData;
6553       Inc(TempDestData, Width * (Height -1) * PixelSize);
6554       for Row := 0 to Height -1 do begin
6555         Move(SourceData^, TempDestData^, RowSize);
6556         Dec(TempDestData, RowSize);
6557         Inc(SourceData, RowSize);
6558       end;
6559       SetData(DestData, Format, Width, Height);
6560       result := true;
6561     except
6562       if Assigned(DestData) then
6563         FreeMem(DestData);
6564       raise;
6565     end;
6566   end;
6567 end;
6568
6569 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6570 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6571 var
6572   fs: TFileStream;
6573 begin
6574   if not FileExists(aFilename) then
6575     raise EglBitmap.Create('file does not exist: ' + aFilename);
6576   fs := TFileStream.Create(aFilename, fmOpenRead);
6577   try
6578     fs.Position := 0;
6579     LoadFromStream(fs);
6580     fFilename := aFilename;
6581   finally
6582     fs.Free;
6583   end;
6584 end;
6585
6586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6587 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6588 begin
6589   {$IFDEF GLB_SUPPORT_PNG_READ}
6590   if not LoadPNG(aStream) then
6591   {$ENDIF}
6592   {$IFDEF GLB_SUPPORT_JPEG_READ}
6593   if not LoadJPEG(aStream) then
6594   {$ENDIF}
6595   if not LoadDDS(aStream) then
6596   if not LoadTGA(aStream) then
6597   if not LoadBMP(aStream) then
6598   if not LoadRAW(aStream) then
6599     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6600 end;
6601
6602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6603 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6604   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6605 var
6606   tmpData: PByte;
6607   size: Integer;
6608 begin
6609   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6610   GetMem(tmpData, size);
6611   try
6612     FillChar(tmpData^, size, #$FF);
6613     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6614   except
6615     if Assigned(tmpData) then
6616       FreeMem(tmpData);
6617     raise;
6618   end;
6619   Convert(Self, aFunc, false, aFormat, aArgs);
6620 end;
6621
6622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6623 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6624 var
6625   rs: TResourceStream;
6626 begin
6627   PrepareResType(aResource, aResType);
6628   rs := TResourceStream.Create(aInstance, aResource, aResType);
6629   try
6630     LoadFromStream(rs);
6631   finally
6632     rs.Free;
6633   end;
6634 end;
6635
6636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6637 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6638 var
6639   rs: TResourceStream;
6640 begin
6641   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6642   try
6643     LoadFromStream(rs);
6644   finally
6645     rs.Free;
6646   end;
6647 end;
6648
6649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6650 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6651 var
6652   fs: TFileStream;
6653 begin
6654   fs := TFileStream.Create(aFileName, fmCreate);
6655   try
6656     fs.Position := 0;
6657     SaveToStream(fs, aFileType);
6658   finally
6659     fs.Free;
6660   end;
6661 end;
6662
6663 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6664 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6665 begin
6666   case aFileType of
6667     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6668     ftPNG:  SavePNG(aStream);
6669     {$ENDIF}
6670     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6671     ftJPEG: SaveJPEG(aStream);
6672     {$ENDIF}
6673     ftDDS:  SaveDDS(aStream);
6674     ftTGA:  SaveTGA(aStream);
6675     ftBMP:  SaveBMP(aStream);
6676     ftRAW:  SaveRAW(aStream);
6677   end;
6678 end;
6679
6680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6681 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6682 begin
6683   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6684 end;
6685
6686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6687 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6688   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6689 var
6690   DestData, TmpData, SourceData: pByte;
6691   TempHeight, TempWidth: Integer;
6692   SourceFD, DestFD: TFormatDescriptor;
6693   SourceMD, DestMD: Pointer;
6694
6695   FuncRec: TglBitmapFunctionRec;
6696 begin
6697   Assert(Assigned(Data));
6698   Assert(Assigned(aSource));
6699   Assert(Assigned(aSource.Data));
6700
6701   result := false;
6702   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6703     SourceFD := TFormatDescriptor.Get(aSource.Format);
6704     DestFD   := TFormatDescriptor.Get(aFormat);
6705
6706     if (SourceFD.IsCompressed) then
6707       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6708     if (DestFD.IsCompressed) then
6709       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6710
6711     // inkompatible Formats so CreateTemp
6712     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6713       aCreateTemp := true;
6714
6715     // Values
6716     TempHeight := Max(1, aSource.Height);
6717     TempWidth  := Max(1, aSource.Width);
6718
6719     FuncRec.Sender := Self;
6720     FuncRec.Args   := aArgs;
6721
6722     TmpData := nil;
6723     if aCreateTemp then begin
6724       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6725       DestData := TmpData;
6726     end else
6727       DestData := Data;
6728
6729     try
6730       SourceFD.PreparePixel(FuncRec.Source);
6731       DestFD.PreparePixel  (FuncRec.Dest);
6732
6733       SourceMD := SourceFD.CreateMappingData;
6734       DestMD   := DestFD.CreateMappingData;
6735
6736       FuncRec.Size            := aSource.Dimension;
6737       FuncRec.Position.Fields := FuncRec.Size.Fields;
6738
6739       try
6740         SourceData := aSource.Data;
6741         FuncRec.Position.Y := 0;
6742         while FuncRec.Position.Y < TempHeight do begin
6743           FuncRec.Position.X := 0;
6744           while FuncRec.Position.X < TempWidth do begin
6745             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6746             aFunc(FuncRec);
6747             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6748             inc(FuncRec.Position.X);
6749           end;
6750           inc(FuncRec.Position.Y);
6751         end;
6752
6753         // Updating Image or InternalFormat
6754         if aCreateTemp then
6755           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6756         else if (aFormat <> fFormat) then
6757           Format := aFormat;
6758
6759         result := true;
6760       finally
6761         SourceFD.FreeMappingData(SourceMD);
6762         DestFD.FreeMappingData(DestMD);
6763       end;
6764     except
6765       if aCreateTemp and Assigned(TmpData) then
6766         FreeMem(TmpData);
6767       raise;
6768     end;
6769   end;
6770 end;
6771
6772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6773 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6774 var
6775   SourceFD, DestFD: TFormatDescriptor;
6776   SourcePD, DestPD: TglBitmapPixelData;
6777   ShiftData: TShiftData;
6778
6779   function DataIsIdentical: Boolean;
6780   begin
6781     result := SourceFD.MaskMatch(DestFD.Mask);
6782   end;
6783
6784   function CanCopyDirect: Boolean;
6785   begin
6786     result :=
6787       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6788       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6789       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6790       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6791   end;
6792
6793   function CanShift: Boolean;
6794   begin
6795     result :=
6796       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6797       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6798       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6799       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6800   end;
6801
6802   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6803   begin
6804     result := 0;
6805     while (aSource > aDest) and (aSource > 0) do begin
6806       inc(result);
6807       aSource := aSource shr 1;
6808     end;
6809   end;
6810
6811 begin
6812   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6813     SourceFD := TFormatDescriptor.Get(Format);
6814     DestFD   := TFormatDescriptor.Get(aFormat);
6815
6816     if DataIsIdentical then begin
6817       result := true;
6818       Format := aFormat;
6819       exit;
6820     end;
6821
6822     SourceFD.PreparePixel(SourcePD);
6823     DestFD.PreparePixel  (DestPD);
6824
6825     if CanCopyDirect then
6826       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6827     else if CanShift then begin
6828       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6829       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6830       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6831       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6832       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6833     end else
6834       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6835   end else
6836     result := true;
6837 end;
6838
6839 {$IFDEF GLB_SDL}
6840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6841 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6842 var
6843   Row, RowSize: Integer;
6844   SourceData, TmpData: PByte;
6845   TempDepth: Integer;
6846   FormatDesc: TFormatDescriptor;
6847
6848   function GetRowPointer(Row: Integer): pByte;
6849   begin
6850     result := aSurface.pixels;
6851     Inc(result, Row * RowSize);
6852   end;
6853
6854 begin
6855   result := false;
6856
6857   FormatDesc := TFormatDescriptor.Get(Format);
6858   if FormatDesc.IsCompressed then
6859     raise EglBitmapUnsupportedFormat.Create(Format);
6860
6861   if Assigned(Data) then begin
6862     case Trunc(FormatDesc.PixelSize) of
6863       1: TempDepth :=  8;
6864       2: TempDepth := 16;
6865       3: TempDepth := 24;
6866       4: TempDepth := 32;
6867     else
6868       raise EglBitmapUnsupportedFormat.Create(Format);
6869     end;
6870
6871     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6872       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6873     SourceData := Data;
6874     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6875
6876     for Row := 0 to FileHeight-1 do begin
6877       TmpData := GetRowPointer(Row);
6878       if Assigned(TmpData) then begin
6879         Move(SourceData^, TmpData^, RowSize);
6880         inc(SourceData, RowSize);
6881       end;
6882     end;
6883     result := true;
6884   end;
6885 end;
6886
6887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6888 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6889 var
6890   pSource, pData, pTempData: PByte;
6891   Row, RowSize, TempWidth, TempHeight: Integer;
6892   IntFormat: TglBitmapFormat;
6893   fd: TFormatDescriptor;
6894   Mask: TglBitmapMask;
6895
6896   function GetRowPointer(Row: Integer): pByte;
6897   begin
6898     result := aSurface^.pixels;
6899     Inc(result, Row * RowSize);
6900   end;
6901
6902 begin
6903   result := false;
6904   if (Assigned(aSurface)) then begin
6905     with aSurface^.format^ do begin
6906       Mask.r := RMask;
6907       Mask.g := GMask;
6908       Mask.b := BMask;
6909       Mask.a := AMask;
6910       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6911       if (IntFormat = tfEmpty) then
6912         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6913     end;
6914
6915     fd := TFormatDescriptor.Get(IntFormat);
6916     TempWidth  := aSurface^.w;
6917     TempHeight := aSurface^.h;
6918     RowSize := fd.GetSize(TempWidth, 1);
6919     GetMem(pData, TempHeight * RowSize);
6920     try
6921       pTempData := pData;
6922       for Row := 0 to TempHeight -1 do begin
6923         pSource := GetRowPointer(Row);
6924         if (Assigned(pSource)) then begin
6925           Move(pSource^, pTempData^, RowSize);
6926           Inc(pTempData, RowSize);
6927         end;
6928       end;
6929       SetData(pData, IntFormat, TempWidth, TempHeight);
6930       result := true;
6931     except
6932       if Assigned(pData) then
6933         FreeMem(pData);
6934       raise;
6935     end;
6936   end;
6937 end;
6938
6939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6940 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6941 var
6942   Row, Col, AlphaInterleave: Integer;
6943   pSource, pDest: PByte;
6944
6945   function GetRowPointer(Row: Integer): pByte;
6946   begin
6947     result := aSurface.pixels;
6948     Inc(result, Row * Width);
6949   end;
6950
6951 begin
6952   result := false;
6953   if Assigned(Data) then begin
6954     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6955       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6956
6957       AlphaInterleave := 0;
6958       case Format of
6959         tfLuminance8Alpha8ub2:
6960           AlphaInterleave := 1;
6961         tfBGRA8ub4, tfRGBA8ub4:
6962           AlphaInterleave := 3;
6963       end;
6964
6965       pSource := Data;
6966       for Row := 0 to Height -1 do begin
6967         pDest := GetRowPointer(Row);
6968         if Assigned(pDest) then begin
6969           for Col := 0 to Width -1 do begin
6970             Inc(pSource, AlphaInterleave);
6971             pDest^ := pSource^;
6972             Inc(pDest);
6973             Inc(pSource);
6974           end;
6975         end;
6976       end;
6977       result := true;
6978     end;
6979   end;
6980 end;
6981
6982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6983 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6984 var
6985   bmp: TglBitmap2D;
6986 begin
6987   bmp := TglBitmap2D.Create;
6988   try
6989     bmp.AssignFromSurface(aSurface);
6990     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
6991   finally
6992     bmp.Free;
6993   end;
6994 end;
6995 {$ENDIF}
6996
6997 {$IFDEF GLB_DELPHI}
6998 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6999 function CreateGrayPalette: HPALETTE;
7000 var
7001   Idx: Integer;
7002   Pal: PLogPalette;
7003 begin
7004   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
7005
7006   Pal.palVersion := $300;
7007   Pal.palNumEntries := 256;
7008
7009   for Idx := 0 to Pal.palNumEntries - 1 do begin
7010     Pal.palPalEntry[Idx].peRed   := Idx;
7011     Pal.palPalEntry[Idx].peGreen := Idx;
7012     Pal.palPalEntry[Idx].peBlue  := Idx;
7013     Pal.palPalEntry[Idx].peFlags := 0;
7014   end;
7015   Result := CreatePalette(Pal^);
7016   FreeMem(Pal);
7017 end;
7018
7019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7020 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7021 var
7022   Row, RowSize: Integer;
7023   pSource, pData: PByte;
7024 begin
7025   result := false;
7026   if Assigned(Data) then begin
7027     if Assigned(aBitmap) then begin
7028       aBitmap.Width  := Width;
7029       aBitmap.Height := Height;
7030
7031       case Format of
7032         tfAlpha8ub1, tfLuminance8ub1: begin
7033           aBitmap.PixelFormat := pf8bit;
7034           aBitmap.Palette     := CreateGrayPalette;
7035         end;
7036         tfRGB5A1us1:
7037           aBitmap.PixelFormat := pf15bit;
7038         tfR5G6B5us1:
7039           aBitmap.PixelFormat := pf16bit;
7040         tfRGB8ub3, tfBGR8ub3:
7041           aBitmap.PixelFormat := pf24bit;
7042         tfRGBA8ub4, tfBGRA8ub4:
7043           aBitmap.PixelFormat := pf32bit;
7044       else
7045         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7046       end;
7047
7048       RowSize := FormatDescriptor.GetSize(Width, 1);
7049       pSource := Data;
7050       for Row := 0 to Height-1 do begin
7051         pData := aBitmap.Scanline[Row];
7052         Move(pSource^, pData^, RowSize);
7053         Inc(pSource, RowSize);
7054         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7055           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7056       end;
7057       result := true;
7058     end;
7059   end;
7060 end;
7061
7062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7063 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7064 var
7065   pSource, pData, pTempData: PByte;
7066   Row, RowSize, TempWidth, TempHeight: Integer;
7067   IntFormat: TglBitmapFormat;
7068 begin
7069   result := false;
7070
7071   if (Assigned(aBitmap)) then begin
7072     case aBitmap.PixelFormat of
7073       pf8bit:
7074         IntFormat := tfLuminance8ub1;
7075       pf15bit:
7076         IntFormat := tfRGB5A1us1;
7077       pf16bit:
7078         IntFormat := tfR5G6B5us1;
7079       pf24bit:
7080         IntFormat := tfBGR8ub3;
7081       pf32bit:
7082         IntFormat := tfBGRA8ub4;
7083     else
7084       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7085     end;
7086
7087     TempWidth  := aBitmap.Width;
7088     TempHeight := aBitmap.Height;
7089     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7090     GetMem(pData, TempHeight * RowSize);
7091     try
7092       pTempData := pData;
7093       for Row := 0 to TempHeight -1 do begin
7094         pSource := aBitmap.Scanline[Row];
7095         if (Assigned(pSource)) then begin
7096           Move(pSource^, pTempData^, RowSize);
7097           Inc(pTempData, RowSize);
7098         end;
7099       end;
7100       SetData(pData, IntFormat, TempWidth, TempHeight);
7101       result := true;
7102     except
7103       if Assigned(pData) then
7104         FreeMem(pData);
7105       raise;
7106     end;
7107   end;
7108 end;
7109
7110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7111 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7112 var
7113   Row, Col, AlphaInterleave: Integer;
7114   pSource, pDest: PByte;
7115 begin
7116   result := false;
7117
7118   if Assigned(Data) then begin
7119     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7120       if Assigned(aBitmap) then begin
7121         aBitmap.PixelFormat := pf8bit;
7122         aBitmap.Palette     := CreateGrayPalette;
7123         aBitmap.Width       := Width;
7124         aBitmap.Height      := Height;
7125
7126         case Format of
7127           tfLuminance8Alpha8ub2:
7128             AlphaInterleave := 1;
7129           tfRGBA8ub4, tfBGRA8ub4:
7130             AlphaInterleave := 3;
7131           else
7132             AlphaInterleave := 0;
7133         end;
7134
7135         // Copy Data
7136         pSource := Data;
7137
7138         for Row := 0 to Height -1 do begin
7139           pDest := aBitmap.Scanline[Row];
7140           if Assigned(pDest) then begin
7141             for Col := 0 to Width -1 do begin
7142               Inc(pSource, AlphaInterleave);
7143               pDest^ := pSource^;
7144               Inc(pDest);
7145               Inc(pSource);
7146             end;
7147           end;
7148         end;
7149         result := true;
7150       end;
7151     end;
7152   end;
7153 end;
7154
7155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7156 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7157 var
7158   data: TglBitmapData;
7159 begin
7160   data := TglBitmapData.Create;
7161   try
7162     data.AssignFromBitmap(aBitmap);
7163     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7164   finally
7165     data.Free;
7166   end;
7167 end;
7168 {$ENDIF}
7169
7170 {$IFDEF GLB_LAZARUS}
7171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7172 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7173 var
7174   rid: TRawImageDescription;
7175   FormatDesc: TFormatDescriptor;
7176 begin
7177   if not Assigned(Data) then
7178     raise EglBitmap.Create('no pixel data assigned. load data before save');
7179
7180   result := false;
7181   if not Assigned(aImage) or (Format = tfEmpty) then
7182     exit;
7183   FormatDesc := TFormatDescriptor.Get(Format);
7184   if FormatDesc.IsCompressed then
7185     exit;
7186
7187   FillChar(rid{%H-}, SizeOf(rid), 0);
7188   if FormatDesc.IsGrayscale then
7189     rid.Format := ricfGray
7190   else
7191     rid.Format := ricfRGBA;
7192
7193   rid.Width        := Width;
7194   rid.Height       := Height;
7195   rid.Depth        := FormatDesc.BitsPerPixel;
7196   rid.BitOrder     := riboBitsInOrder;
7197   rid.ByteOrder    := riboLSBFirst;
7198   rid.LineOrder    := riloTopToBottom;
7199   rid.LineEnd      := rileTight;
7200   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7201   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7202   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7203   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7204   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7205   rid.RedShift     := FormatDesc.Shift.r;
7206   rid.GreenShift   := FormatDesc.Shift.g;
7207   rid.BlueShift    := FormatDesc.Shift.b;
7208   rid.AlphaShift   := FormatDesc.Shift.a;
7209
7210   rid.MaskBitsPerPixel  := 0;
7211   rid.PaletteColorCount := 0;
7212
7213   aImage.DataDescription := rid;
7214   aImage.CreateData;
7215
7216   if not Assigned(aImage.PixelData) then
7217     raise EglBitmap.Create('error while creating LazIntfImage');
7218   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7219
7220   result := true;
7221 end;
7222
7223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7224 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7225 var
7226   f: TglBitmapFormat;
7227   FormatDesc: TFormatDescriptor;
7228   ImageData: PByte;
7229   ImageSize: Integer;
7230   CanCopy: Boolean;
7231   Mask: TglBitmapRec4ul;
7232
7233   procedure CopyConvert;
7234   var
7235     bfFormat: TbmpBitfieldFormat;
7236     pSourceLine, pDestLine: PByte;
7237     pSourceMD, pDestMD: Pointer;
7238     Shift, Prec: TglBitmapRec4ub;
7239     x, y: Integer;
7240     pixel: TglBitmapPixelData;
7241   begin
7242     bfFormat  := TbmpBitfieldFormat.Create;
7243     with aImage.DataDescription do begin
7244       Prec.r := RedPrec;
7245       Prec.g := GreenPrec;
7246       Prec.b := BluePrec;
7247       Prec.a := AlphaPrec;
7248       Shift.r := RedShift;
7249       Shift.g := GreenShift;
7250       Shift.b := BlueShift;
7251       Shift.a := AlphaShift;
7252       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7253     end;
7254     pSourceMD := bfFormat.CreateMappingData;
7255     pDestMD   := FormatDesc.CreateMappingData;
7256     try
7257       for y := 0 to aImage.Height-1 do begin
7258         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7259         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7260         for x := 0 to aImage.Width-1 do begin
7261           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7262           FormatDesc.Map(pixel, pDestLine, pDestMD);
7263         end;
7264       end;
7265     finally
7266       FormatDesc.FreeMappingData(pDestMD);
7267       bfFormat.FreeMappingData(pSourceMD);
7268       bfFormat.Free;
7269     end;
7270   end;
7271
7272 begin
7273   result := false;
7274   if not Assigned(aImage) then
7275     exit;
7276
7277   with aImage.DataDescription do begin
7278     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7279     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7280     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7281     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7282   end;
7283   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7284   f          := FormatDesc.Format;
7285   if (f = tfEmpty) then
7286     exit;
7287
7288   CanCopy :=
7289     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7290     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7291
7292   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7293   ImageData := GetMem(ImageSize);
7294   try
7295     if CanCopy then
7296       Move(aImage.PixelData^, ImageData^, ImageSize)
7297     else
7298       CopyConvert;
7299     SetData(ImageData, f, aImage.Width, aImage.Height);
7300   except
7301     if Assigned(ImageData) then
7302       FreeMem(ImageData);
7303     raise;
7304   end;
7305
7306   result := true;
7307 end;
7308
7309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7310 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7311 var
7312   rid: TRawImageDescription;
7313   FormatDesc: TFormatDescriptor;
7314   Pixel: TglBitmapPixelData;
7315   x, y: Integer;
7316   srcMD: Pointer;
7317   src, dst: PByte;
7318 begin
7319   result := false;
7320   if not Assigned(aImage) or (Format = tfEmpty) then
7321     exit;
7322   FormatDesc := TFormatDescriptor.Get(Format);
7323   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7324     exit;
7325
7326   FillChar(rid{%H-}, SizeOf(rid), 0);
7327   rid.Format       := ricfGray;
7328   rid.Width        := Width;
7329   rid.Height       := Height;
7330   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7331   rid.BitOrder     := riboBitsInOrder;
7332   rid.ByteOrder    := riboLSBFirst;
7333   rid.LineOrder    := riloTopToBottom;
7334   rid.LineEnd      := rileTight;
7335   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7336   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7337   rid.GreenPrec    := 0;
7338   rid.BluePrec     := 0;
7339   rid.AlphaPrec    := 0;
7340   rid.RedShift     := 0;
7341   rid.GreenShift   := 0;
7342   rid.BlueShift    := 0;
7343   rid.AlphaShift   := 0;
7344
7345   rid.MaskBitsPerPixel  := 0;
7346   rid.PaletteColorCount := 0;
7347
7348   aImage.DataDescription := rid;
7349   aImage.CreateData;
7350
7351   srcMD := FormatDesc.CreateMappingData;
7352   try
7353     FormatDesc.PreparePixel(Pixel);
7354     src := Data;
7355     dst := aImage.PixelData;
7356     for y := 0 to Height-1 do
7357       for x := 0 to Width-1 do begin
7358         FormatDesc.Unmap(src, Pixel, srcMD);
7359         case rid.BitsPerPixel of
7360            8: begin
7361             dst^ := Pixel.Data.a;
7362             inc(dst);
7363           end;
7364           16: begin
7365             PWord(dst)^ := Pixel.Data.a;
7366             inc(dst, 2);
7367           end;
7368           24: begin
7369             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7370             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7371             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7372             inc(dst, 3);
7373           end;
7374           32: begin
7375             PCardinal(dst)^ := Pixel.Data.a;
7376             inc(dst, 4);
7377           end;
7378         else
7379           raise EglBitmapUnsupportedFormat.Create(Format);
7380         end;
7381       end;
7382   finally
7383     FormatDesc.FreeMappingData(srcMD);
7384   end;
7385   result := true;
7386 end;
7387
7388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7389 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7390 var
7391   data: TglBitmapData;
7392 begin
7393   data := TglBitmapData.Create;
7394   try
7395     data.AssignFromLazIntfImage(aImage);
7396     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7397   finally
7398     data.Free;
7399   end;
7400 end;
7401 {$ENDIF}
7402
7403 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7404 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7405   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7406 var
7407   rs: TResourceStream;
7408 begin
7409   PrepareResType(aResource, aResType);
7410   rs := TResourceStream.Create(aInstance, aResource, aResType);
7411   try
7412     result := AddAlphaFromStream(rs, aFunc, aArgs);
7413   finally
7414     rs.Free;
7415   end;
7416 end;
7417
7418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7419 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7420   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7421 var
7422   rs: TResourceStream;
7423 begin
7424   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7425   try
7426     result := AddAlphaFromStream(rs, aFunc, aArgs);
7427   finally
7428     rs.Free;
7429   end;
7430 end;
7431
7432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7433 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7434 begin
7435   if TFormatDescriptor.Get(Format).IsCompressed then
7436     raise EglBitmapUnsupportedFormat.Create(Format);
7437   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7438 end;
7439
7440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7441 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7442 var
7443   FS: TFileStream;
7444 begin
7445   FS := TFileStream.Create(aFileName, fmOpenRead);
7446   try
7447     result := AddAlphaFromStream(FS, aFunc, aArgs);
7448   finally
7449     FS.Free;
7450   end;
7451 end;
7452
7453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7454 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7455 var
7456   data: TglBitmapData;
7457 begin
7458   data := TglBitmapData.Create(aStream);
7459   try
7460     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7461   finally
7462     data.Free;
7463   end;
7464 end;
7465
7466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7467 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7468 var
7469   DestData, DestData2, SourceData: pByte;
7470   TempHeight, TempWidth: Integer;
7471   SourceFD, DestFD: TFormatDescriptor;
7472   SourceMD, DestMD, DestMD2: Pointer;
7473
7474   FuncRec: TglBitmapFunctionRec;
7475 begin
7476   result := false;
7477
7478   Assert(Assigned(Data));
7479   Assert(Assigned(aDataObj));
7480   Assert(Assigned(aDataObj.Data));
7481
7482   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7483     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7484
7485     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7486     DestFD   := TFormatDescriptor.Get(Format);
7487
7488     if not Assigned(aFunc) then begin
7489       aFunc        := glBitmapAlphaFunc;
7490       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7491     end else
7492       FuncRec.Args := aArgs;
7493
7494     // Values
7495     TempWidth  := aDataObj.Width;
7496     TempHeight := aDataObj.Height;
7497     if (TempWidth <= 0) or (TempHeight <= 0) then
7498       exit;
7499
7500     FuncRec.Sender          := Self;
7501     FuncRec.Size            := Dimension;
7502     FuncRec.Position.Fields := FuncRec.Size.Fields;
7503
7504     DestData   := Data;
7505     DestData2  := Data;
7506     SourceData := aDataObj.Data;
7507
7508     // Mapping
7509     SourceFD.PreparePixel(FuncRec.Source);
7510     DestFD.PreparePixel  (FuncRec.Dest);
7511
7512     SourceMD := SourceFD.CreateMappingData;
7513     DestMD   := DestFD.CreateMappingData;
7514     DestMD2  := DestFD.CreateMappingData;
7515     try
7516       FuncRec.Position.Y := 0;
7517       while FuncRec.Position.Y < TempHeight do begin
7518         FuncRec.Position.X := 0;
7519         while FuncRec.Position.X < TempWidth do begin
7520           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7521           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7522           aFunc(FuncRec);
7523           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7524           inc(FuncRec.Position.X);
7525         end;
7526         inc(FuncRec.Position.Y);
7527       end;
7528     finally
7529       SourceFD.FreeMappingData(SourceMD);
7530       DestFD.FreeMappingData(DestMD);
7531       DestFD.FreeMappingData(DestMD2);
7532     end;
7533   end;
7534 end;
7535
7536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7537 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7538 begin
7539   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7540 end;
7541
7542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7543 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7544 var
7545   PixelData: TglBitmapPixelData;
7546 begin
7547   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7548   result := AddAlphaFromColorKeyFloat(
7549     aRed   / PixelData.Range.r,
7550     aGreen / PixelData.Range.g,
7551     aBlue  / PixelData.Range.b,
7552     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7553 end;
7554
7555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7556 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7557 var
7558   values: array[0..2] of Single;
7559   tmp: Cardinal;
7560   i: Integer;
7561   PixelData: TglBitmapPixelData;
7562 begin
7563   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7564   with PixelData do begin
7565     values[0] := aRed;
7566     values[1] := aGreen;
7567     values[2] := aBlue;
7568
7569     for i := 0 to 2 do begin
7570       tmp          := Trunc(Range.arr[i] * aDeviation);
7571       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7572       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7573     end;
7574     Data.a  := 0;
7575     Range.a := 0;
7576   end;
7577   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7578 end;
7579
7580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7581 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7582 begin
7583   result := AddAlphaFromValueFloat(aAlpha / $FF);
7584 end;
7585
7586 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7587 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7588 var
7589   PixelData: TglBitmapPixelData;
7590 begin
7591   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7592   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7593 end;
7594
7595 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7596 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7597 var
7598   PixelData: TglBitmapPixelData;
7599 begin
7600   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7601   with PixelData do
7602     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7603   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7604 end;
7605
7606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7607 function TglBitmapData.RemoveAlpha: Boolean;
7608 var
7609   FormatDesc: TFormatDescriptor;
7610 begin
7611   result := false;
7612   FormatDesc := TFormatDescriptor.Get(Format);
7613   if Assigned(Data) then begin
7614     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7615       raise EglBitmapUnsupportedFormat.Create(Format);
7616     result := ConvertTo(FormatDesc.WithoutAlpha);
7617   end;
7618 end;
7619
7620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7621 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7622   const aAlpha: Byte);
7623 begin
7624   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7625 end;
7626
7627 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7628 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7629 var
7630   PixelData: TglBitmapPixelData;
7631 begin
7632   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7633   FillWithColorFloat(
7634     aRed   / PixelData.Range.r,
7635     aGreen / PixelData.Range.g,
7636     aBlue  / PixelData.Range.b,
7637     aAlpha / PixelData.Range.a);
7638 end;
7639
7640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7641 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7642 var
7643   PixelData: TglBitmapPixelData;
7644 begin
7645   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7646   with PixelData do begin
7647     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7648     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7649     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7650     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7651   end;
7652   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7653 end;
7654
7655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7656 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7657 begin
7658   if (Data <> aData) then begin
7659     if (Assigned(Data)) then
7660       FreeMem(Data);
7661     fData := aData;
7662   end;
7663
7664   if Assigned(fData) then begin
7665     FillChar(fDimension, SizeOf(fDimension), 0);
7666     if aWidth <> -1 then begin
7667       fDimension.Fields := fDimension.Fields + [ffX];
7668       fDimension.X := aWidth;
7669     end;
7670
7671     if aHeight <> -1 then begin
7672       fDimension.Fields := fDimension.Fields + [ffY];
7673       fDimension.Y := aHeight;
7674     end;
7675
7676     fFormat := aFormat;
7677   end else
7678     fFormat := tfEmpty;
7679
7680   UpdateScanlines;
7681 end;
7682
7683 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7684 function TglBitmapData.Clone: TglBitmapData;
7685 var
7686   Temp: TglBitmapData;
7687   TempPtr: PByte;
7688   Size: Integer;
7689 begin
7690   result := nil;
7691   Temp := (ClassType.Create as TglBitmapData);
7692   try
7693     // copy texture data if assigned
7694     if Assigned(Data) then begin
7695       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7696       GetMem(TempPtr, Size);
7697       try
7698         Move(Data^, TempPtr^, Size);
7699         Temp.SetData(TempPtr, Format, Width, Height);
7700       except
7701         if Assigned(TempPtr) then
7702           FreeMem(TempPtr);
7703         raise;
7704       end;
7705     end else begin
7706       TempPtr := nil;
7707       Temp.SetData(TempPtr, Format, Width, Height);
7708     end;
7709
7710           // copy properties
7711     Temp.fFormat := Format;
7712     result := Temp;
7713   except
7714     FreeAndNil(Temp);
7715     raise;
7716   end;
7717 end;
7718
7719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7720 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7721 var
7722   mask: PtrInt;
7723 begin
7724   mask :=
7725      (Byte(aRed)   and 1)        or
7726     ((Byte(aGreen) and 1) shl 1) or
7727     ((Byte(aBlue)  and 1) shl 2) or
7728     ((Byte(aAlpha) and 1) shl 3);
7729   if (mask > 0) then
7730     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7731 end;
7732
7733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7734 type
7735   TMatrixItem = record
7736     X, Y: Integer;
7737     W: Single;
7738   end;
7739
7740   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7741   TglBitmapToNormalMapRec = Record
7742     Scale: Single;
7743     Heights: array of Single;
7744     MatrixU : array of TMatrixItem;
7745     MatrixV : array of TMatrixItem;
7746   end;
7747
7748 const
7749   ONE_OVER_255 = 1 / 255;
7750
7751   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7752 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7753 var
7754   Val: Single;
7755 begin
7756   with FuncRec do begin
7757     Val :=
7758       Source.Data.r * LUMINANCE_WEIGHT_R +
7759       Source.Data.g * LUMINANCE_WEIGHT_G +
7760       Source.Data.b * LUMINANCE_WEIGHT_B;
7761     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7762   end;
7763 end;
7764
7765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7766 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7767 begin
7768   with FuncRec do
7769     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7770 end;
7771
7772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7773 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7774 type
7775   TVec = Array[0..2] of Single;
7776 var
7777   Idx: Integer;
7778   du, dv: Double;
7779   Len: Single;
7780   Vec: TVec;
7781
7782   function GetHeight(X, Y: Integer): Single;
7783   begin
7784     with FuncRec do begin
7785       X := Max(0, Min(Size.X -1, X));
7786       Y := Max(0, Min(Size.Y -1, Y));
7787       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7788     end;
7789   end;
7790
7791 begin
7792   with FuncRec do begin
7793     with PglBitmapToNormalMapRec(Args)^ do begin
7794       du := 0;
7795       for Idx := Low(MatrixU) to High(MatrixU) do
7796         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7797
7798       dv := 0;
7799       for Idx := Low(MatrixU) to High(MatrixU) do
7800         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7801
7802       Vec[0] := -du * Scale;
7803       Vec[1] := -dv * Scale;
7804       Vec[2] := 1;
7805     end;
7806
7807     // Normalize
7808     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7809     if Len <> 0 then begin
7810       Vec[0] := Vec[0] * Len;
7811       Vec[1] := Vec[1] * Len;
7812       Vec[2] := Vec[2] * Len;
7813     end;
7814
7815     // Farbe zuweisem
7816     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7817     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7818     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7819   end;
7820 end;
7821
7822 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7823 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7824 var
7825   Rec: TglBitmapToNormalMapRec;
7826
7827   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7828   begin
7829     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7830       Matrix[Index].X := X;
7831       Matrix[Index].Y := Y;
7832       Matrix[Index].W := W;
7833     end;
7834   end;
7835
7836 begin
7837   if TFormatDescriptor.Get(Format).IsCompressed then
7838     raise EglBitmapUnsupportedFormat.Create(Format);
7839
7840   if aScale > 100 then
7841     Rec.Scale := 100
7842   else if aScale < -100 then
7843     Rec.Scale := -100
7844   else
7845     Rec.Scale := aScale;
7846
7847   SetLength(Rec.Heights, Width * Height);
7848   try
7849     case aFunc of
7850       nm4Samples: begin
7851         SetLength(Rec.MatrixU, 2);
7852         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7853         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7854
7855         SetLength(Rec.MatrixV, 2);
7856         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7857         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7858       end;
7859
7860       nmSobel: begin
7861         SetLength(Rec.MatrixU, 6);
7862         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7863         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7864         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7865         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7866         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7867         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7868
7869         SetLength(Rec.MatrixV, 6);
7870         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7871         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7872         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7873         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7874         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7875         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7876       end;
7877
7878       nm3x3: begin
7879         SetLength(Rec.MatrixU, 6);
7880         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7881         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7882         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7883         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7884         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7885         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7886
7887         SetLength(Rec.MatrixV, 6);
7888         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7889         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7890         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7891         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7892         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7893         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7894       end;
7895
7896       nm5x5: begin
7897         SetLength(Rec.MatrixU, 20);
7898         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7899         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7900         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7901         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7902         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7903         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7904         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7905         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7906         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7907         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7908         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7909         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7910         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7911         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7912         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7913         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7914         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7915         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7916         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7917         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7918
7919         SetLength(Rec.MatrixV, 20);
7920         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7921         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7922         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7923         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7924         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7925         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7926         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7927         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7928         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7929         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7930         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7931         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7932         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7933         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7934         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7935         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7936         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7937         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7938         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7939         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7940       end;
7941     end;
7942
7943     // Daten Sammeln
7944     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7945       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7946     else
7947       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7948     Convert(glBitmapToNormalMapFunc, false, @Rec);
7949   finally
7950     SetLength(Rec.Heights, 0);
7951   end;
7952 end;
7953
7954 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7955 constructor TglBitmapData.Create;
7956 begin
7957   inherited Create;
7958   fFormat := glBitmapDefaultFormat;
7959 end;
7960
7961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7962 constructor TglBitmapData.Create(const aFileName: String);
7963 begin
7964   Create;
7965   LoadFromFile(aFileName);
7966 end;
7967
7968 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7969 constructor TglBitmapData.Create(const aStream: TStream);
7970 begin
7971   Create;
7972   LoadFromStream(aStream);
7973 end;
7974
7975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7976 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7977 var
7978   ImageSize: Integer;
7979 begin
7980   Create;
7981   if not Assigned(aData) then begin
7982     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7983     GetMem(aData, ImageSize);
7984     try
7985       FillChar(aData^, ImageSize, #$FF);
7986       SetData(aData, aFormat, aSize.X, aSize.Y);
7987     except
7988       if Assigned(aData) then
7989         FreeMem(aData);
7990       raise;
7991     end;
7992   end else begin
7993     SetData(aData, aFormat, aSize.X, aSize.Y);
7994   end;
7995 end;
7996
7997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7998 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
7999 begin
8000   Create;
8001   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
8002 end;
8003
8004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8005 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
8006 begin
8007   Create;
8008   LoadFromResource(aInstance, aResource, aResType);
8009 end;
8010
8011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8012 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8013 begin
8014   Create;
8015   LoadFromResourceID(aInstance, aResourceID, aResType);
8016 end;
8017
8018 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8019 destructor TglBitmapData.Destroy;
8020 begin
8021   SetData(nil, tfEmpty);
8022   inherited Destroy;
8023 end;
8024
8025 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8026 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8028 function TglBitmap.GetWidth: Integer;
8029 begin
8030   if (ffX in fDimension.Fields) then
8031     result := fDimension.X
8032   else
8033     result := -1;
8034 end;
8035
8036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8037 function TglBitmap.GetHeight: Integer;
8038 begin
8039   if (ffY in fDimension.Fields) then
8040     result := fDimension.Y
8041   else
8042     result := -1;
8043 end;
8044
8045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8046 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8047 begin
8048   if fCustomData = aValue then
8049     exit;
8050   fCustomData := aValue;
8051 end;
8052
8053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8054 procedure TglBitmap.SetCustomName(const aValue: String);
8055 begin
8056   if fCustomName = aValue then
8057     exit;
8058   fCustomName := aValue;
8059 end;
8060
8061 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8062 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8063 begin
8064   if fCustomNameW = aValue then
8065     exit;
8066   fCustomNameW := aValue;
8067 end;
8068
8069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8070 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8071 begin
8072   if fDeleteTextureOnFree = aValue then
8073     exit;
8074   fDeleteTextureOnFree := aValue;
8075 end;
8076
8077 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8078 procedure TglBitmap.SetID(const aValue: Cardinal);
8079 begin
8080   if fID = aValue then
8081     exit;
8082   fID := aValue;
8083 end;
8084
8085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8086 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8087 begin
8088   if fMipMap = aValue then
8089     exit;
8090   fMipMap := aValue;
8091 end;
8092
8093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8094 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8095 begin
8096   if fTarget = aValue then
8097     exit;
8098   fTarget := aValue;
8099 end;
8100
8101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8102 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8103 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8104 var
8105   MaxAnisotropic: Integer;
8106 {$IFEND}
8107 begin
8108   fAnisotropic := aValue;
8109   if (ID > 0) then begin
8110 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8111     if GL_EXT_texture_filter_anisotropic then begin
8112       if fAnisotropic > 0 then begin
8113         Bind(false);
8114         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8115         if aValue > MaxAnisotropic then
8116           fAnisotropic := MaxAnisotropic;
8117         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8118       end;
8119     end else begin
8120       fAnisotropic := 0;
8121     end;
8122 {$ELSE}
8123     fAnisotropic := 0;
8124 {$IFEND}
8125   end;
8126 end;
8127
8128 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8129 procedure TglBitmap.CreateID;
8130 begin
8131   if (ID <> 0) then
8132     glDeleteTextures(1, @fID);
8133   glGenTextures(1, @fID);
8134   Bind(false);
8135 end;
8136
8137 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8138 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8139 begin
8140   // Set Up Parameters
8141   SetWrap(fWrapS, fWrapT, fWrapR);
8142   SetFilter(fFilterMin, fFilterMag);
8143   SetAnisotropic(fAnisotropic);
8144
8145 {$IFNDEF OPENGL_ES}
8146   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8147   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8148     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8149 {$ENDIF}
8150
8151 {$IFNDEF OPENGL_ES}
8152   // Mip Maps Generation Mode
8153   aBuildWithGlu := false;
8154   if (MipMap = mmMipmap) then begin
8155     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8156       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
8157     else
8158       aBuildWithGlu := true;
8159   end else if (MipMap = mmMipmapGlu) then
8160     aBuildWithGlu := true;
8161 {$ELSE}
8162   if (MipMap = mmMipmap) then
8163     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
8164 {$ENDIF}
8165 end;
8166
8167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8168 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8170 procedure TglBitmap.AfterConstruction;
8171 begin
8172   inherited AfterConstruction;
8173
8174   fID         := 0;
8175   fTarget     := 0;
8176 {$IFNDEF OPENGL_ES}
8177   fIsResident := false;
8178 {$ENDIF}
8179
8180   fMipMap              := glBitmapDefaultMipmap;
8181   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8182
8183   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8184   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8185 {$IFNDEF OPENGL_ES}
8186   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8187 {$ENDIF}
8188 end;
8189
8190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8191 procedure TglBitmap.BeforeDestruction;
8192 begin
8193   if (fID > 0) and fDeleteTextureOnFree then
8194     glDeleteTextures(1, @fID);
8195   inherited BeforeDestruction;
8196 end;
8197
8198 {$IFNDEF OPENGL_ES}
8199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8200 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8201 begin
8202   fBorderColor[0] := aRed;
8203   fBorderColor[1] := aGreen;
8204   fBorderColor[2] := aBlue;
8205   fBorderColor[3] := aAlpha;
8206   if (ID > 0) then begin
8207     Bind(false);
8208     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8209   end;
8210 end;
8211 {$ENDIF}
8212
8213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8214 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8215 begin
8216   //check MIN filter
8217   case aMin of
8218     GL_NEAREST:
8219       fFilterMin := GL_NEAREST;
8220     GL_LINEAR:
8221       fFilterMin := GL_LINEAR;
8222     GL_NEAREST_MIPMAP_NEAREST:
8223       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8224     GL_LINEAR_MIPMAP_NEAREST:
8225       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8226     GL_NEAREST_MIPMAP_LINEAR:
8227       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8228     GL_LINEAR_MIPMAP_LINEAR:
8229       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8230     else
8231       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8232   end;
8233
8234   //check MAG filter
8235   case aMag of
8236     GL_NEAREST:
8237       fFilterMag := GL_NEAREST;
8238     GL_LINEAR:
8239       fFilterMag := GL_LINEAR;
8240     else
8241       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8242   end;
8243
8244   //apply filter
8245   if (ID > 0) then begin
8246     Bind(false);
8247     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8248
8249     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8250       case fFilterMin of
8251         GL_NEAREST, GL_LINEAR:
8252           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8253         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8254           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8255         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8256           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8257       end;
8258     end else
8259       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8260   end;
8261 end;
8262
8263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8264 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8265
8266   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8267   begin
8268     case aValue of
8269 {$IFNDEF OPENGL_ES}
8270       GL_CLAMP:
8271         aTarget := GL_CLAMP;
8272 {$ENDIF}
8273
8274       GL_REPEAT:
8275         aTarget := GL_REPEAT;
8276
8277       GL_CLAMP_TO_EDGE: begin
8278 {$IFNDEF OPENGL_ES}
8279         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8280           aTarget := GL_CLAMP
8281         else
8282 {$ENDIF}
8283           aTarget := GL_CLAMP_TO_EDGE;
8284       end;
8285
8286 {$IFNDEF OPENGL_ES}
8287       GL_CLAMP_TO_BORDER: begin
8288         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8289           aTarget := GL_CLAMP_TO_BORDER
8290         else
8291           aTarget := GL_CLAMP;
8292       end;
8293 {$ENDIF}
8294
8295 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8296       GL_MIRRORED_REPEAT: begin
8297   {$IFNDEF OPENGL_ES}
8298         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8299   {$ELSE}
8300         if GL_VERSION_2_0 then
8301   {$ENDIF}
8302           aTarget := GL_MIRRORED_REPEAT
8303         else
8304           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8305       end;
8306 {$IFEND}
8307     else
8308       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8309     end;
8310   end;
8311
8312 begin
8313   CheckAndSetWrap(S, fWrapS);
8314   CheckAndSetWrap(T, fWrapT);
8315   CheckAndSetWrap(R, fWrapR);
8316
8317   if (ID > 0) then begin
8318     Bind(false);
8319     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8320     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8321 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8322     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8323     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8324 {$IFEND}
8325   end;
8326 end;
8327
8328 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8330 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8331
8332   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8333   begin
8334     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8335        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8336       fSwizzle[aIndex] := aValue
8337     else
8338       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8339   end;
8340
8341 begin
8342 {$IFNDEF OPENGL_ES}
8343   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8344     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8345 {$ELSE}
8346   if not GL_VERSION_3_0 then
8347     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8348 {$ENDIF}
8349   CheckAndSetValue(r, 0);
8350   CheckAndSetValue(g, 1);
8351   CheckAndSetValue(b, 2);
8352   CheckAndSetValue(a, 3);
8353
8354   if (ID > 0) then begin
8355     Bind(false);
8356 {$IFNDEF OPENGL_ES}
8357     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8358 {$ELSE}
8359     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8360     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8361     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8362     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8363 {$ENDIF}
8364   end;
8365 end;
8366 {$IFEND}
8367
8368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8369 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
8370 begin
8371   if aEnableTextureUnit then
8372     glEnable(Target);
8373   if (ID > 0) then
8374     glBindTexture(Target, ID);
8375 end;
8376
8377 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8378 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
8379 begin
8380   if aDisableTextureUnit then
8381     glDisable(Target);
8382   glBindTexture(Target, 0);
8383 end;
8384
8385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8386 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8387 var
8388   w, h: Integer;
8389 begin
8390   w := aDataObj.Width;
8391   h := aDataObj.Height;
8392   fDimension.Fields := [];
8393   if (w > 0) then
8394     fDimension.Fields := fDimension.Fields + [ffX];
8395   if (h > 0) then
8396     fDimension.Fields := fDimension.Fields + [ffY];
8397   fDimension.X := w;
8398   fDimension.Y := h;
8399 end;
8400
8401 {$IFNDEF OPENGL_ES}
8402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8403 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8404 var
8405   Temp: PByte;
8406   TempWidth, TempHeight: Integer;
8407   TempIntFormat: GLint;
8408   IntFormat: TglBitmapFormat;
8409   FormatDesc: TFormatDescriptor;
8410 begin
8411   result := false;
8412   Bind;
8413
8414   // Request Data
8415   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8416   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8417   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8418
8419   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8420   IntFormat  := FormatDesc.Format;
8421
8422   // Getting data from OpenGL
8423   FormatDesc := TFormatDescriptor.Get(IntFormat);
8424   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8425   try
8426     if FormatDesc.IsCompressed then begin
8427       if not Assigned(glGetCompressedTexImage) then
8428         raise EglBitmap.Create('compressed formats not supported by video adapter');
8429       glGetCompressedTexImage(Target, 0, Temp)
8430     end else
8431       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8432     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8433     result := true;
8434   except
8435     if Assigned(Temp) then
8436       FreeMem(Temp);
8437     raise;
8438   end;
8439 end;
8440 {$ENDIF}
8441
8442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8443 constructor TglBitmap.Create;
8444 begin
8445   if (ClassType = TglBitmap) then
8446     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8447   inherited Create;
8448 end;
8449
8450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8451 constructor TglBitmap.Create(const aData: TglBitmapData);
8452 begin
8453   Create;
8454   UploadData(aData);
8455 end;
8456
8457 {$IFNDEF OPENGL_ES}
8458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8459 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8462 var
8463   fd: TglBitmapFormatDescriptor;
8464 begin
8465   // Upload data
8466   fd := aDataObj.FormatDescriptor;
8467   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8468     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8469
8470   if fd.IsCompressed then begin
8471     if not Assigned(glCompressedTexImage1D) then
8472       raise EglBitmap.Create('compressed formats not supported by video adapter');
8473     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8474   end else if aBuildWithGlu then
8475     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8476   else
8477     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8478 end;
8479
8480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8481 procedure TglBitmap1D.AfterConstruction;
8482 begin
8483   inherited;
8484   Target := GL_TEXTURE_1D;
8485 end;
8486
8487 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8488 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8489 var
8490   BuildWithGlu, TexRec: Boolean;
8491   TexSize: Integer;
8492 begin
8493   if not Assigned(aDataObj) then
8494     exit;
8495
8496   // Check Texture Size
8497   if (aCheckSize) then begin
8498     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8499
8500     if (aDataObj.Width > TexSize) then
8501       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8502
8503     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8504               (Target = GL_TEXTURE_RECTANGLE);
8505     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8506       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8507   end;
8508
8509   if (fID = 0) then
8510     CreateID;
8511   SetupParameters(BuildWithGlu);
8512   UploadDataIntern(aDataObj, BuildWithGlu);
8513   glAreTexturesResident(1, @fID, @fIsResident);
8514
8515   inherited UploadData(aDataObj, aCheckSize);
8516 end;
8517 {$ENDIF}
8518
8519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8520 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8522 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
8523 var
8524   fd: TglBitmapFormatDescriptor;
8525 begin
8526   fd := aDataObj.FormatDescriptor;
8527   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8528     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8529
8530   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8531
8532   if fd.IsCompressed then begin
8533     if not Assigned(glCompressedTexImage2D) then
8534       raise EglBitmap.Create('compressed formats not supported by video adapter');
8535     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8536 {$IFNDEF OPENGL_ES}
8537   end else if aBuildWithGlu then begin
8538     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8539 {$ENDIF}
8540   end else begin
8541     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8542   end;
8543 end;
8544
8545 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8546 procedure TglBitmap2D.AfterConstruction;
8547 begin
8548   inherited;
8549   Target := GL_TEXTURE_2D;
8550 end;
8551
8552 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8553 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8554 var
8555   {$IFNDEF OPENGL_ES}
8556   BuildWithGlu, TexRec: Boolean;
8557   {$ENDIF}
8558   PotTex: Boolean;
8559   TexSize: Integer;
8560 begin
8561   if not Assigned(aDataObj) then
8562     exit;
8563
8564   // Check Texture Size
8565   if (aCheckSize) then begin
8566     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8567
8568     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8569       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8570
8571     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8572 {$IF NOT DEFINED(OPENGL_ES)}
8573     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8574     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8575       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8576 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8577     if not PotTex and not GL_OES_texture_npot then
8578       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8579 {$ELSE}
8580     if not PotTex then
8581       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8582 {$IFEND}
8583   end;
8584
8585   if (fID = 0) then
8586     CreateID;
8587   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8588   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8589 {$IFNDEF OPENGL_ES}
8590   glAreTexturesResident(1, @fID, @fIsResident);
8591 {$ENDIF}
8592
8593   inherited UploadData(aDataObj, aCheckSize);
8594 end;
8595
8596 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8597 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8598 var
8599   Temp: pByte;
8600   Size, w, h: Integer;
8601   FormatDesc: TFormatDescriptor;
8602 begin
8603   FormatDesc := TFormatDescriptor.Get(aFormat);
8604   if FormatDesc.IsCompressed then
8605     raise EglBitmapUnsupportedFormat.Create(aFormat);
8606
8607   w    := aRight  - aLeft;
8608   h    := aBottom - aTop;
8609   Size := FormatDesc.GetSize(w, h);
8610   GetMem(Temp, Size);
8611   try
8612     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8613     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8614     aDataObj.SetData(Temp, aFormat, w, h);
8615     aDataObj.FlipVert;
8616   except
8617     if Assigned(Temp) then
8618       FreeMem(Temp);
8619     raise;
8620   end;
8621 end;
8622
8623 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8625 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8627 procedure TglBitmapCubeMap.AfterConstruction;
8628 begin
8629   inherited;
8630
8631 {$IFNDEF OPENGL_ES}
8632   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8633     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8634 {$ELSE}
8635   if not (GL_VERSION_2_0) then
8636     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8637 {$ENDIF}
8638
8639   SetWrap;
8640   Target   := GL_TEXTURE_CUBE_MAP;
8641 {$IFNDEF OPENGL_ES}
8642   fGenMode := GL_REFLECTION_MAP;
8643 {$ENDIF}
8644 end;
8645
8646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8647 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8648 begin
8649   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8650 end;
8651
8652 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8653 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8654 var
8655   {$IFNDEF OPENGL_ES}
8656   BuildWithGlu: Boolean;
8657   {$ENDIF}
8658   TexSize: Integer;
8659 begin
8660   if (aCheckSize) then begin
8661     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8662
8663     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8664       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8665
8666 {$IF NOT DEFINED(OPENGL_ES)}
8667     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8668       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8669 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8670     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8671       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8672 {$ELSE}
8673     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8674       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8675 {$IFEND}
8676   end;
8677
8678   if (fID = 0) then
8679     CreateID;
8680   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8681   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8682
8683   inherited UploadData(aDataObj, aCheckSize);
8684 end;
8685
8686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8687 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8688 begin
8689   inherited Bind (aEnableTextureUnit);
8690 {$IFNDEF OPENGL_ES}
8691   if aEnableTexCoordsGen then begin
8692     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8693     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8694     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8695     glEnable(GL_TEXTURE_GEN_S);
8696     glEnable(GL_TEXTURE_GEN_T);
8697     glEnable(GL_TEXTURE_GEN_R);
8698   end;
8699 {$ENDIF}
8700 end;
8701
8702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8703 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8704 begin
8705   inherited Unbind(aDisableTextureUnit);
8706 {$IFNDEF OPENGL_ES}
8707   if aDisableTexCoordsGen then begin
8708     glDisable(GL_TEXTURE_GEN_S);
8709     glDisable(GL_TEXTURE_GEN_T);
8710     glDisable(GL_TEXTURE_GEN_R);
8711   end;
8712 {$ENDIF}
8713 end;
8714 {$IFEND}
8715
8716 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8718 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8720 type
8721   TVec = Array[0..2] of Single;
8722   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8723
8724   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8725   TglBitmapNormalMapRec = record
8726     HalfSize : Integer;
8727     Func: TglBitmapNormalMapGetVectorFunc;
8728   end;
8729
8730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8731 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8732 begin
8733   aVec[0] := aHalfSize;
8734   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8735   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8736 end;
8737
8738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8739 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8740 begin
8741   aVec[0] := - aHalfSize;
8742   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8743   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8744 end;
8745
8746 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8747 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8748 begin
8749   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8750   aVec[1] := aHalfSize;
8751   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8752 end;
8753
8754 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8755 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8756 begin
8757   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8758   aVec[1] := - aHalfSize;
8759   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8760 end;
8761
8762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8763 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8764 begin
8765   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8766   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8767   aVec[2] := aHalfSize;
8768 end;
8769
8770 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8771 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8772 begin
8773   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8774   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8775   aVec[2] := - aHalfSize;
8776 end;
8777
8778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8779 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8780 var
8781   i: Integer;
8782   Vec: TVec;
8783   Len: Single;
8784 begin
8785   with FuncRec do begin
8786     with PglBitmapNormalMapRec(Args)^ do begin
8787       Func(Vec, Position, HalfSize);
8788
8789       // Normalize
8790       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8791       if Len <> 0 then begin
8792         Vec[0] := Vec[0] * Len;
8793         Vec[1] := Vec[1] * Len;
8794         Vec[2] := Vec[2] * Len;
8795       end;
8796
8797       // Scale Vector and AddVectro
8798       Vec[0] := Vec[0] * 0.5 + 0.5;
8799       Vec[1] := Vec[1] * 0.5 + 0.5;
8800       Vec[2] := Vec[2] * 0.5 + 0.5;
8801     end;
8802
8803     // Set Color
8804     for i := 0 to 2 do
8805       Dest.Data.arr[i] := Round(Vec[i] * 255);
8806   end;
8807 end;
8808
8809 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8810 procedure TglBitmapNormalMap.AfterConstruction;
8811 begin
8812   inherited;
8813 {$IFNDEF OPENGL_ES}
8814   fGenMode := GL_NORMAL_MAP;
8815 {$ENDIF}
8816 end;
8817
8818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8819 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8820 var
8821   Rec: TglBitmapNormalMapRec;
8822   SizeRec: TglBitmapSize;
8823   DataObj: TglBitmapData;
8824 begin
8825   Rec.HalfSize := aSize div 2;
8826
8827   SizeRec.Fields := [ffX, ffY];
8828   SizeRec.X := aSize;
8829   SizeRec.Y := aSize;
8830
8831   DataObj := TglBitmapData.Create;
8832   try
8833     // Positive X
8834     Rec.Func := glBitmapNormalMapPosX;
8835     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8836     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8837
8838     // Negative X
8839     Rec.Func := glBitmapNormalMapNegX;
8840     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8841     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8842
8843     // Positive Y
8844     Rec.Func := glBitmapNormalMapPosY;
8845     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8846     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8847
8848     // Negative Y
8849     Rec.Func := glBitmapNormalMapNegY;
8850     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8851     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8852
8853     // Positive Z
8854     Rec.Func := glBitmapNormalMapPosZ;
8855     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8856     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8857
8858     // Negative Z
8859     Rec.Func := glBitmapNormalMapNegZ;
8860     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8861     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8862   finally
8863     FreeAndNil(DataObj);
8864   end;
8865 end;
8866 {$IFEND}
8867
8868 initialization
8869   glBitmapSetDefaultFormat (tfEmpty);
8870   glBitmapSetDefaultMipmap (mmMipmap);
8871   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8872   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8873 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8874   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8875 {$IFEND}
8876
8877   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8878   glBitmapSetDefaultDeleteTextureOnFree    (true);
8879
8880   TFormatDescriptor.Init;
8881
8882 finalization
8883   TFormatDescriptor.Finalize;
8884
8885 end.