glBitmap.pas

   1 { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
   2   http://www.opengl24.de/index.php?cat=header&file=glbitmap
   3
   4   modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
   5
   6   The contents of this file are used with permission, subject to
   7   the Mozilla Public License Version 1.1 (the "License"); you may
   8   not use this file except in compliance with the License. You may
   9   obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  13   to manage OpenGL texture objects. Below you can find a list of the main
  14   functionality of this classes:
  15   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  16   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  17   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  18   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  19   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  20   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  21   - upload texture data to video card
  22   - download texture data from video card
  23   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  24
  25 unit glBitmap;
  26
  27 {$I glBitmapConf.inc}
  28
  29 // Delphi Versions
  30 {$IFDEF fpc}
  31   {$MODE Delphi}
  32
  33   {$IFDEF CPUI386}
  34     {$DEFINE CPU386}
  35     {$ASMMODE INTEL}
  36   {$ENDIF}
  37
  38   {$IFNDEF WINDOWS}
  39     {$linklib c}
  40   {$ENDIF}
  41 {$ENDIF}
  42
  43 // Operation System
  44 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  45   {$DEFINE GLB_WIN}
  46 {$ELSEIF DEFINED(LINUX)}
  47   {$DEFINE GLB_LINUX}
  48 {$IFEND}
  49
  50 // OpenGL ES
  51 {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  52 {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  53 {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  54 {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}
  55
  56 // checking define combinations
  57 //SDL Image
  58 {$IFDEF GLB_SDL_IMAGE}
  59   {$IFNDEF GLB_SDL}
  60     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  61     {$DEFINE GLB_SDL}
  62   {$ENDIF}
  63
  64   {$IFDEF GLB_LAZ_PNG}
  65     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  66     {$undef GLB_LAZ_PNG}
  67   {$ENDIF}
  68
  69   {$IFDEF GLB_PNGIMAGE}
  70     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  71     {$undef GLB_PNGIMAGE}
  72   {$ENDIF}
  73
  74   {$IFDEF GLB_LAZ_JPEG}
  75     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  76     {$undef GLB_LAZ_JPEG}
  77   {$ENDIF}
  78
  79   {$IFDEF GLB_DELPHI_JPEG}
  80     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  81     {$undef GLB_DELPHI_JPEG}
  82   {$ENDIF}
  83
  84   {$IFDEF GLB_LIB_PNG}
  85     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  86     {$undef GLB_LIB_PNG}
  87   {$ENDIF}
  88
  89   {$IFDEF GLB_LIB_JPEG}
  90     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  91     {$undef GLB_LIB_JPEG}
  92   {$ENDIF}
  93
  94   {$DEFINE GLB_SUPPORT_PNG_READ}
  95   {$DEFINE GLB_SUPPORT_JPEG_READ}
  96 {$ENDIF}
  97
  98 // Lazarus TPortableNetworkGraphic
  99 {$IFDEF GLB_LAZ_PNG}
 100   {$IFNDEF GLB_LAZARUS}
 101     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
 102     {$DEFINE GLB_LAZARUS}
 103   {$ENDIF}
 104
 105   {$IFDEF GLB_PNGIMAGE}
 106     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 107     {$undef GLB_PNGIMAGE}
 108   {$ENDIF}
 109
 110   {$IFDEF GLB_LIB_PNG}
 111     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
 112     {$undef GLB_LIB_PNG}
 113   {$ENDIF}
 114
 115   {$DEFINE GLB_SUPPORT_PNG_READ}
 116   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 117 {$ENDIF}
 118
 119 // PNG Image
 120 {$IFDEF GLB_PNGIMAGE}
 121   {$IFDEF GLB_LIB_PNG}
 122     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
 123     {$undef GLB_LIB_PNG}
 124   {$ENDIF}
 125
 126   {$DEFINE GLB_SUPPORT_PNG_READ}
 127   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 128 {$ENDIF}
 129
 130 // libPNG
 131 {$IFDEF GLB_LIB_PNG}
 132   {$DEFINE GLB_SUPPORT_PNG_READ}
 133   {$DEFINE GLB_SUPPORT_PNG_WRITE}
 134 {$ENDIF}
 135
 136 // Lazarus TJPEGImage
 137 {$IFDEF GLB_LAZ_JPEG}
 138   {$IFNDEF GLB_LAZARUS}
 139     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
 140     {$DEFINE GLB_LAZARUS}
 141   {$ENDIF}
 142
 143   {$IFDEF GLB_DELPHI_JPEG}
 144     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
 145     {$undef GLB_DELPHI_JPEG}
 146   {$ENDIF}
 147
 148   {$IFDEF GLB_LIB_JPEG}
 149     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
 150     {$undef GLB_LIB_JPEG}
 151   {$ENDIF}
 152
 153   {$DEFINE GLB_SUPPORT_JPEG_READ}
 154   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 155 {$ENDIF}
 156
 157 // JPEG Image
 158 {$IFDEF GLB_DELPHI_JPEG}
 159   {$IFDEF GLB_LIB_JPEG}
 160     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
 161     {$undef GLB_LIB_JPEG}
 162   {$ENDIF}
 163
 164   {$DEFINE GLB_SUPPORT_JPEG_READ}
 165   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 166 {$ENDIF}
 167
 168 // libJPEG
 169 {$IFDEF GLB_LIB_JPEG}
 170   {$DEFINE GLB_SUPPORT_JPEG_READ}
 171   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
 172 {$ENDIF}
 173
 174 // general options
 175 {$EXTENDEDSYNTAX ON}
 176 {$LONGSTRINGS ON}
 177 {$ALIGN ON}
 178 {$IFNDEF FPC}
 179   {$OPTIMIZATION ON}
 180 {$ENDIF}
 181
 182 {$UNDEF GLB_LAZARUS}
 183
 184 interface
 185
 186 uses
 187   {$IFDEF OPENGL_ES}            dglOpenGLES,
 188   {$ELSE}                       dglOpenGL,                          {$ENDIF}
 189
 190   {$IF DEFINED(GLB_WIN) AND
 191        DEFINED(GLB_DELPHI)}     windows,                            {$IFEND}
 192
 193   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
 194   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
 195   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
 196
 197   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
 198   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
 199   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
 200   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
 201   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
 202
 203   Classes, SysUtils;
 204
 205 type
 206 {$IFNDEF fpc}
 207   QWord   = System.UInt64;
 208   PQWord  = ^QWord;
 209
 210   PtrInt  = Longint;
 211   PtrUInt = DWord;
 212 {$ENDIF}
 213
 214
 215   { type that describes the format of the data stored in a texture.
 216     the name of formats is composed of the following constituents:
 217     - multiple channels:
 218        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
 219        - width of the chanel in bit       (4, 8, 16, ...)
 220     - data type                           (e.g. ub, us, ui)
 221     - number of elements of data types }
 222   TglBitmapFormat = (
 223     tfEmpty = 0,
 224
 225     tfAlpha4ub1,                //< 1 x unsigned byte
 226     tfAlpha8ub1,                //< 1 x unsigned byte
 227     tfAlpha16us1,               //< 1 x unsigned short
 228
 229     tfLuminance4ub1,            //< 1 x unsigned byte
 230     tfLuminance8ub1,            //< 1 x unsigned byte
 231     tfLuminance16us1,           //< 1 x unsigned short
 232
 233     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 234     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 235     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
 236     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 237     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
 238
 239     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
 240     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
 241     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
 242     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
 243     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
 244     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
 245     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
 246     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
 247     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
 248     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
 249     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
 250     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
 251
 252     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
 253     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
 254     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
 255     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
 256     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
 257     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
 258     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
 259     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
 260     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
 261     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
 262
 263     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
 264     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
 265     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
 266     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
 267     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
 268     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
 269     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
 270     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
 271     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
 272     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
 273     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
 274
 275     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
 276     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
 277     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
 278     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
 279     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
 280     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
 281     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
 282     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
 283     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
 284     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
 285
 286     tfDepth16us1,               //< 1 x unsigned short (depth)
 287     tfDepth24ui1,               //< 1 x unsigned int (depth)
 288     tfDepth32ui1,               //< 1 x unsigned int (depth)
 289
 290     tfS3tcDtx1RGBA,
 291     tfS3tcDtx3RGBA,
 292     tfS3tcDtx5RGBA
 293   );
 294
 295   { type to define suitable file formats }
 296   TglBitmapFileType = (
 297      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)
 298      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file
 299      ftDDS,                                             //< Direct Draw Surface file (DDS)
 300      ftTGA,                                             //< Targa Image File (TGA)
 301      ftBMP,                                             //< Windows Bitmap File (BMP)
 302      ftRAW);                                            //< glBitmap RAW file format
 303    TglBitmapFileTypes = set of TglBitmapFileType;
 304
 305   { possible mipmap types }
 306   TglBitmapMipMap = (
 307      mmNone,                //< no mipmaps
 308      mmMipmap,              //< normal mipmaps
 309      mmMipmapGlu);          //< mipmaps generated with glu functions
 310
 311   { possible normal map functions }
 312    TglBitmapNormalMapFunc = (
 313      nm4Samples,
 314      nmSobel,
 315      nm3x3,
 316      nm5x5);
 317
 318  ////////////////////////////////////////////////////////////////////////////////////////////////////
 319    EglBitmap                  = class(Exception);   //< glBitmap exception
 320    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions
 321    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures
 322    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures
 323    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats
 324    public
 325      constructor Create(const aFormat: TglBitmapFormat); overload;
 326      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
 327    end;
 328
 329 ////////////////////////////////////////////////////////////////////////////////////////////////////
 330   { record that stores 4 unsigned integer values }
 331   TglBitmapRec4ui = packed record
 332   case Integer of
 333     0: (r, g, b, a: Cardinal);
 334     1: (arr: array[0..3] of Cardinal);
 335   end;
 336
 337   { record that stores 4 unsigned byte values }
 338   TglBitmapRec4ub = packed record
 339   case Integer of
 340     0: (r, g, b, a: Byte);
 341     1: (arr: array[0..3] of Byte);
 342   end;
 343
 344   { record that stores 4 unsigned long integer values }
 345   TglBitmapRec4ul = packed record
 346   case Integer of
 347     0: (r, g, b, a: QWord);
 348     1: (arr: array[0..3] of QWord);
 349   end;
 350
 351   { structure to store pixel data in }
 352   TglBitmapPixelData = packed record
 353     Data:   TglBitmapRec4ui;  //< color data for each color channel
 354     Range:  TglBitmapRec4ui;  //< maximal color value for each channel
 355     Format: TglBitmapFormat;  //< format of the pixel
 356   end;
 357   PglBitmapPixelData = ^TglBitmapPixelData;
 358
 359   TglBitmapSizeFields = set of (ffX, ffY);
 360   TglBitmapSize = packed record
 361     Fields: TglBitmapSizeFields;
 362     X: Word;
 363     Y: Word;
 364   end;
 365   TglBitmapPixelPosition = TglBitmapSize;
 366
 367   { describes the properties of a given texture data format }
 368   TglBitmapFormatDescriptor = class(TObject)
 369   private
 370     // cached properties
 371     fBytesPerPixel: Single;   //< number of bytes for each pixel
 372     fChannelCount: Integer;   //< number of color channels
 373     fMask: TglBitmapRec4ul;   //< bitmask for each color channel
 374     fRange: TglBitmapRec4ui;  //< maximal value of each color channel
 375
 376     { @return @true if the format has a red color channel, @false otherwise }
 377     function GetHasRed: Boolean;
 378
 379     { @return @true if the format has a green color channel, @false otherwise }
 380     function GetHasGreen: Boolean;
 381
 382     { @return @true if the format has a blue color channel, @false otherwise }
 383     function GetHasBlue: Boolean;
 384
 385     { @return @true if the format has a alpha color channel, @false otherwise }
 386     function GetHasAlpha: Boolean;
 387
 388     { @return @true if the format has any color color channel, @false otherwise }
 389     function GetHasColor: Boolean;
 390
 391     { @return @true if the format is a grayscale format, @false otherwise }
 392     function GetIsGrayscale: Boolean;
 393
 394     { @return @true if the format is supported by OpenGL, @false otherwise }
 395     function GetHasOpenGLSupport: Boolean;
 396
 397   protected
 398     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to
 399     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel
 400     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel
 401     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL
 402     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels
 403     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data
 404
 405     fBitsPerPixel: Integer;           //< number of bits per pixel
 406     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise
 407
 408     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel
 409     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel
 410
 411     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)
 412     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)
 413     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 414
 415     { set values for this format descriptor }
 416     procedure SetValues; virtual;
 417
 418     { calculate cached values }
 419     procedure CalcValues;
 420   public
 421     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to
 422     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels
 423     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise
 424     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel
 425     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel
 426
 427     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel
 428     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel
 429     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel
 430     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel
 431
 432     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels
 433     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel
 434     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel
 435     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
 436     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
 437
 438     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)
 439     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
 440     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
 441
 442     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise
 443     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise
 444     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise
 445     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise
 446     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise
 447     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise
 448
 449     property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
 450
 451     function GetSize(const aSize: TglBitmapSize): Integer;     overload; virtual;
 452     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
 453
 454     { constructor }
 455     constructor Create;
 456   public
 457     { get the format descriptor by a given OpenGL internal format
 458         @param aInternalFormat  OpenGL internal format to get format descriptor for
 459         @returns                suitable format descriptor or tfEmpty-Descriptor }
 460     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
 461   end;
 462
 463 ////////////////////////////////////////////////////////////////////////////////////////////////////
 464   TglBitmapData = class;
 465
 466   { structure to store data for converting in }
 467   TglBitmapFunctionRec = record
 468     Sender:   TglBitmapData;          //< texture object that stores the data to convert
 469     Size:     TglBitmapSize;          //< size of the texture
 470     Position: TglBitmapPixelPosition; //< position of the currently pixel
 471     Source:   TglBitmapPixelData;     //< pixel data of the current pixel
 472     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)
 473     Args:     Pointer;                //< user defined args that was passed to the convert function
 474   end;
 475
 476   { callback to use for converting texture data }
 477   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
 478
 479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 480   { class to store texture data in. used to load, save and
 481     manipulate data before assigned to texture object
 482     all operations on a data object can be done from a background thread }
 483   TglBitmapData = class
 484   private { fields }
 485
 486     fData: PByte;               //< texture data
 487     fDimension: TglBitmapSize;  //< pixel size of the data
 488     fFormat: TglBitmapFormat;   //< format the texture data is stored in
 489     fFilename: String;          //< file the data was load from
 490
 491     fScanlines:    array of PByte;  //< pointer to begin of each line
 492     fHasScanlines: Boolean;         //< @true if scanlines are initialized, @false otherwise
 493
 494   private { getter / setter }
 495
 496     { @returns the format descriptor suitable to the texture data format }
 497     function GetFormatDescriptor: TglBitmapFormatDescriptor;
 498
 499     { @returns the width of the texture data (in pixel) or -1 if no data is set }
 500     function GetWidth: Integer;
 501
 502     { @returns the height of the texture data (in pixel) or -1 if no data is set }
 503     function GetHeight: Integer;
 504
 505     { get scanline at index aIndex
 506         @returns Pointer to start of line or @nil }
 507     function GetScanlines(const aIndex: Integer): PByte;
 508
 509     { set new value for the data format. only possible if new format has the same pixel size.
 510       if you want to convert the texture data, see ConvertTo function }
 511     procedure SetFormat(const aValue: TglBitmapFormat);
 512
 513   private { internal misc }
 514
 515     { splits a resource identifier into the resource and it's type
 516         @param aResource  resource identifier to split and store name in
 517         @param aResType   type of the resource }
 518     procedure PrepareResType(var aResource: String; var aResType: PChar);
 519
 520     { updates scanlines array }
 521     procedure UpdateScanlines;
 522
 523   private { internal load and save }
 524 {$IFDEF GLB_SUPPORT_PNG_READ}
 525     { try to load a PNG from a stream
 526         @param aStream  stream to load PNG from
 527         @returns        @true on success, @false otherwise }
 528     function  LoadPNG(const aStream: TStream): Boolean; virtual;
 529 {$ENDIF}
 530
 531 {$ifdef GLB_SUPPORT_PNG_WRITE}
 532     { save texture data as PNG to stream
 533         @param aStream stream to save data to}
 534     procedure SavePNG(const aStream: TStream); virtual;
 535 {$ENDIF}
 536
 537 {$IFDEF GLB_SUPPORT_JPEG_READ}
 538     { try to load a JPEG from a stream
 539         @param aStream  stream to load JPEG from
 540         @returns        @true on success, @false otherwise }
 541     function  LoadJPEG(const aStream: TStream): Boolean; virtual;
 542 {$ENDIF}
 543
 544 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
 545     { save texture data as JPEG to stream
 546         @param aStream stream to save data to}
 547     procedure SaveJPEG(const aStream: TStream); virtual;
 548 {$ENDIF}
 549
 550     { try to load a RAW image from a stream
 551         @param aStream  stream to load RAW image from
 552         @returns        @true on success, @false otherwise }
 553     function LoadRAW(const aStream: TStream): Boolean;
 554
 555     { save texture data as RAW image to stream
 556         @param aStream stream to save data to}
 557     procedure SaveRAW(const aStream: TStream);
 558
 559     { try to load a BMP from a stream
 560         @param aStream  stream to load BMP from
 561         @returns        @true on success, @false otherwise }
 562     function LoadBMP(const aStream: TStream): Boolean;
 563
 564     { save texture data as BMP to stream
 565         @param aStream stream to save data to}
 566     procedure SaveBMP(const aStream: TStream);
 567
 568     { try to load a TGA from a stream
 569         @param aStream  stream to load TGA from
 570         @returns        @true on success, @false otherwise }
 571     function LoadTGA(const aStream: TStream): Boolean;
 572
 573     { save texture data as TGA to stream
 574         @param aStream stream to save data to}
 575     procedure SaveTGA(const aStream: TStream);
 576
 577     { try to load a DDS from a stream
 578         @param aStream  stream to load DDS from
 579         @returns        @true on success, @false otherwise }
 580     function LoadDDS(const aStream: TStream): Boolean;
 581
 582     { save texture data as DDS to stream
 583         @param aStream stream to save data to}
 584     procedure SaveDDS(const aStream: TStream);
 585
 586   public { properties }
 587     property Data:      PByte           read fData;                     //< texture data (be carefull with this!)
 588     property Dimension: TglBitmapSize   read fDimension;                //< size of the texture data (in pixel)
 589     property Filename:  String          read fFilename;                 //< file the data was loaded from
 590     property Width:     Integer         read GetWidth;                  //< width of the texture data (in pixel)
 591     property Height:    Integer         read GetHeight;                 //< height of the texture data (in pixel)
 592     property Format:    TglBitmapFormat read fFormat write SetFormat;   //< format the texture data is stored in
 593     property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
 594
 595     property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
 596
 597   public { flip }
 598
 599     { flip texture horizontal
 600         @returns @true in success, @false otherwise }
 601     function FlipHorz: Boolean; virtual;
 602
 603     { flip texture vertical
 604         @returns @true in success, @false otherwise }
 605     function FlipVert: Boolean; virtual;
 606
 607   public { load }
 608
 609     { load a texture from a file
 610         @param aFilename file to load texuture from }
 611     procedure LoadFromFile(const aFilename: String);
 612
 613     { load a texture from a stream
 614         @param aStream  stream to load texture from }
 615     procedure LoadFromStream(const aStream: TStream); virtual;
 616
 617     { use a function to generate texture data
 618         @param aSize    size of the texture
 619         @param aFormat  format of the texture data
 620         @param aFunc    callback to use for generation
 621         @param aArgs    user defined paramaters (use at will) }
 622     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
 623
 624     { load a texture from a resource
 625         @param aInstance  resource handle
 626         @param aResource  resource indentifier
 627         @param aResType   resource type (if known) }
 628     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
 629
 630     { load a texture from a resource id
 631         @param aInstance  resource handle
 632         @param aResource  resource ID
 633         @param aResType   resource type }
 634     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
 635
 636   public { save }
 637
 638     { save texture data to a file
 639         @param aFilename  filename to store texture in
 640         @param aFileType  file type to store data into }
 641     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
 642
 643     { save texture data to a stream
 644         @param aFilename  filename to store texture in
 645         @param aFileType  file type to store data into }
 646     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
 647
 648   public { convert }
 649
 650     { convert texture data using a user defined callback
 651         @param aFunc        callback to use for converting
 652         @param aCreateTemp  create a temporary buffer to use for converting
 653         @param aArgs        user defined paramters (use at will)
 654         @returns            @true if converting was successful, @false otherwise }
 655     function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
 656
 657     { convert texture data using a user defined callback
 658         @param aSource      glBitmap to read data from
 659         @param aFunc        callback to use for converting
 660         @param aCreateTemp  create a temporary buffer to use for converting
 661         @param aFormat      format of the new data
 662         @param aArgs        user defined paramters (use at will)
 663         @returns            @true if converting was successful, @false otherwise }
 664     function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
 665       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
 666
 667     { convert texture data using a specific format
 668         @param aFormat  new format of texture data
 669         @returns        @true if converting was successful, @false otherwise }
 670     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
 671
 672 {$IFDEF GLB_SDL}
 673   public { SDL }
 674
 675     { assign texture data to SDL surface
 676         @param aSurface SDL surface to write data to
 677         @returns        @true on success, @false otherwise }
 678     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
 679
 680     { assign texture data from SDL surface
 681         @param aSurface SDL surface to read data from
 682         @returns        @true on success, @false otherwise }
 683     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
 684
 685     { assign alpha channel data to SDL surface
 686         @param aSurface SDL surface to write alpha channel data to
 687         @returns        @true on success, @false otherwise }
 688     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
 689
 690     { assign alpha channel data from SDL surface
 691         @param aSurface SDL surface to read data from
 692         @param aFunc    callback to use for converting
 693         @param aArgs    user defined parameters (use at will)
 694         @returns        @true on success, @false otherwise }
 695     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 696 {$ENDIF}
 697
 698 {$IFDEF GLB_DELPHI}
 699   public { Delphi }
 700
 701     { assign texture data to TBitmap object
 702         @param aBitmap  TBitmap to write data to
 703         @returns        @true on success, @false otherwise }
 704     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
 705
 706     { assign texture data from TBitmap object
 707         @param aBitmap  TBitmap to read data from
 708         @returns        @true on success, @false otherwise }
 709     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
 710
 711     { assign alpha channel data to TBitmap object
 712         @param aBitmap  TBitmap to write data to
 713         @returns        @true on success, @false otherwise }
 714     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
 715
 716     { assign alpha channel data from TBitmap object
 717         @param aBitmap  TBitmap to read data from
 718         @param aFunc    callback to use for converting
 719         @param aArgs    user defined parameters (use at will)
 720         @returns        @true on success, @false otherwise }
 721     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 722 {$ENDIF}
 723
 724 {$IFDEF GLB_LAZARUS}
 725   public { Lazarus }
 726
 727     { assign texture data to TLazIntfImage object
 728         @param aImage   TLazIntfImage to write data to
 729         @returns        @true on success, @false otherwise }
 730     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 731
 732     { assign texture data from TLazIntfImage object
 733         @param aImage   TLazIntfImage to read data from
 734         @returns        @true on success, @false otherwise }
 735     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
 736
 737     { assign alpha channel data to TLazIntfImage object
 738         @param aImage   TLazIntfImage to write data to
 739         @returns        @true on success, @false otherwise }
 740     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
 741
 742     { assign alpha channel data from TLazIntfImage object
 743         @param aImage   TLazIntfImage to read data from
 744         @param aFunc    callback to use for converting
 745         @param aArgs    user defined parameters (use at will)
 746         @returns        @true on success, @false otherwise }
 747     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 748 {$ENDIF}
 749
 750   public { Alpha }
 751     { load alpha channel data from resource
 752         @param aInstance  resource handle
 753         @param aResource  resource ID
 754         @param aResType   resource type
 755         @param aFunc      callback to use for converting
 756         @param aArgs      user defined parameters (use at will)
 757         @returns          @true on success, @false otherwise }
 758     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 759
 760     { load alpha channel data from resource ID
 761         @param aInstance    resource handle
 762         @param aResourceID  resource ID
 763         @param aResType     resource type
 764         @param aFunc        callback to use for converting
 765         @param aArgs        user defined parameters (use at will)
 766         @returns            @true on success, @false otherwise }
 767     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 768
 769     { add alpha channel data from function
 770         @param aFunc  callback to get data from
 771         @param aArgs  user defined parameters (use at will)
 772         @returns      @true on success, @false otherwise }
 773     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
 774
 775     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
 776         @param aFilename  file to load alpha channel data from
 777         @param aFunc      callback to use for converting
 778         @param aArgs     SetFormat user defined parameters (use at will)
 779         @returns          @true on success, @false otherwise }
 780     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 781
 782     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
 783         @param aStream  stream to load alpha channel data from
 784         @param aFunc    callback to use for converting
 785         @param aArgs    user defined parameters (use at will)
 786         @returns        @true on success, @false otherwise }
 787     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
 788
 789     { add alpha channel data from existing glBitmap object
 790         @param aBitmap  TglBitmap to copy alpha channel data from
 791         @param aFunc    callback to use for converting
 792         @param aArgs    user defined parameters (use at will)
 793         @returns        @true on success, @false otherwise }
 794     function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
 795
 796     { add alpha to pixel if the pixels color is greter than the given color value
 797         @param aRed         red threshold (0-255)
 798         @param aGreen       green threshold (0-255)
 799         @param aBlue        blue threshold (0-255)
 800         @param aDeviatation accepted deviatation (0-255)
 801         @returns            @true on success, @false otherwise }
 802     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
 803
 804     { add alpha to pixel if the pixels color is greter than the given color value
 805         @param aRed         red threshold (0-Range.r)
 806         @param aGreen       green threshold (0-Range.g)
 807         @param aBlue        blue threshold (0-Range.b)
 808         @param aDeviatation accepted deviatation (0-max(Range.rgb))
 809         @returns            @true on success, @false otherwise }
 810     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
 811
 812     { add alpha to pixel if the pixels color is greter than the given color value
 813         @param aRed         red threshold (0.0-1.0)
 814         @param aGreen       green threshold (0.0-1.0)
 815         @param aBlue        blue threshold (0.0-1.0)
 816         @param aDeviatation accepted deviatation (0.0-1.0)
 817         @returns            @true on success, @false otherwise }
 818     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
 819
 820     { add a constand alpha value to all pixels
 821         @param aAlpha alpha value to add (0-255)
 822         @returns      @true on success, @false otherwise }
 823     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
 824
 825     { add a constand alpha value to all pixels
 826         @param aAlpha alpha value to add (0-max(Range.rgb))
 827         @returns      @true on success, @false otherwise }
 828     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
 829
 830     { add a constand alpha value to all pixels
 831         @param aAlpha alpha value to add (0.0-1.0)
 832         @returns      @true on success, @false otherwise }
 833     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
 834
 835     { remove alpha channel
 836         @returns  @true on success, @false otherwise }
 837     function RemoveAlpha: Boolean; virtual;
 838
 839   public { fill }
 840     { fill complete texture with one color
 841         @param aRed   red color for border (0-255)
 842         @param aGreen green color for border (0-255)
 843         @param aBlue  blue color for border (0-255)
 844         @param aAlpha alpha color for border (0-255) }
 845     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
 846
 847     { fill complete texture with one color
 848         @param aRed   red color for border (0-Range.r)
 849         @param aGreen green color for border (0-Range.g)
 850         @param aBlue  blue color for border (0-Range.b)
 851         @param aAlpha alpha color for border (0-Range.a) }
 852     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
 853
 854     { fill complete texture with one color
 855         @param aRed   red color for border (0.0-1.0)
 856         @param aGreen green color for border (0.0-1.0)
 857         @param aBlue  blue color for border (0.0-1.0)
 858         @param aAlpha alpha color for border (0.0-1.0) }
 859     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
 860
 861   public { Misc }
 862
 863     { set data pointer of texture data
 864         @param aData    pointer to new texture data
 865         @param aFormat  format of the data stored at aData
 866         @param aWidth   width of the texture data
 867         @param aHeight  height of the texture data }
 868     procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
 869       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
 870
 871       { create a clone of the current object
 872         @returns clone of this object}
 873     function Clone: TglBitmapData;
 874
 875     { invert color data (bitwise not)
 876         @param aRed     invert red channel
 877         @param aGreen   invert green channel
 878         @param aBlue    invert blue channel
 879         @param aAlpha   invert alpha channel }
 880     procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
 881
 882     { create normal map from texture data
 883         @param aFunc      normal map function to generate normalmap with
 884         @param aScale     scale of the normale stored in the normal map
 885         @param aUseAlpha  generate normalmap from alpha channel data (if present) }
 886     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
 887       const aScale: Single = 2; const aUseAlpha: Boolean = false);
 888
 889   public { constructor }
 890
 891     { constructor - creates a texutre data object }
 892     constructor Create; overload;
 893
 894     { constructor - creates a texture data object and loads it from a file
 895         @param aFilename file to load texture from }
 896     constructor Create(const aFileName: String); overload;
 897
 898     { constructor - creates a texture data object and loads it from a stream
 899         @param aStream stream to load texture from }
 900     constructor Create(const aStream: TStream); overload;
 901
 902     { constructor - creates a texture data object with the given size, format and data
 903         @param aSize    size of the texture
 904         @param aFormat  format of the given data
 905         @param aData    texture data - be carefull: the data will now be managed by the texture data object }
 906     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
 907
 908     { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
 909         @param aSize    size of the texture
 910         @param aFormat  format of the given data
 911         @param aFunc    callback to use for generating the data
 912         @param aArgs    user defined parameters (use at will) }
 913     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
 914
 915     { constructor - creates a texture data object and loads it from a resource
 916         @param aInstance  resource handle
 917         @param aResource  resource indentifier
 918         @param aResType   resource type (if known) }
 919     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
 920
 921     { constructor - creates a texture data object and loads it from a resource
 922         @param aInstance    resource handle
 923         @param aResourceID  resource ID
 924         @param aResType     resource type (if known) }
 925     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
 926
 927     { destructor }
 928     destructor Destroy; override;
 929
 930   end;
 931
 932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 933   { base class for all glBitmap classes. used to manage OpenGL texture objects
 934     all operations on a bitmap object must be done from the render thread }
 935   TglBitmap = class
 936   protected
 937     fID: GLuint;                          //< name of the OpenGL texture object
 938     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)
 939     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed
 940
 941     // texture properties
 942     fFilterMin: GLenum;                   //< min filter to apply to the texture
 943     fFilterMag: GLenum;                   //< mag filter to apply to the texture
 944     fWrapS: GLenum;                       //< texture wrapping for x axis
 945     fWrapT: GLenum;                       //< texture wrapping for y axis
 946     fWrapR: GLenum;                       //< texture wrapping for z axis
 947     fAnisotropic: Integer;                //< anisotropic level
 948     fBorderColor: array[0..3] of Single;  //< color of the texture border
 949
 950 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
 951     //Swizzle
 952     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle
 953 {$IFEND}
 954 {$IFNDEF OPENGL_ES}
 955     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise
 956 {$ENDIF}
 957
 958     fDimension: TglBitmapSize;            //< size of this texture
 959     fMipMap: TglBitmapMipMap;             //< mipmap type
 960
 961     // CustomData
 962     fCustomData: Pointer;                 //< user defined data
 963     fCustomName: String;                  //< user defined name
 964     fCustomNameW: WideString;             //< user defined name
 965   protected
 966     { @returns the actual width of the texture }
 967     function GetWidth:  Integer; virtual;
 968
 969     { @returns the actual height of the texture }
 970     function GetHeight: Integer; virtual;
 971
 972   protected
 973     { set a new value for fCustomData }
 974     procedure SetCustomData(const aValue: Pointer);
 975
 976     { set a new value for fCustomName }
 977     procedure SetCustomName(const aValue: String);
 978
 979     { set a new value for fCustomNameW }
 980     procedure SetCustomNameW(const aValue: WideString);
 981
 982     { set new value for fDeleteTextureOnFree }
 983     procedure SetDeleteTextureOnFree(const aValue: Boolean);
 984
 985     { set name of OpenGL texture object }
 986     procedure SetID(const aValue: Cardinal);
 987
 988     { set new value for fMipMap }
 989     procedure SetMipMap(const aValue: TglBitmapMipMap);
 990
 991     { set new value for target }
 992     procedure SetTarget(const aValue: Cardinal);
 993
 994     { set new value for fAnisotrophic }
 995     procedure SetAnisotropic(const aValue: Integer);
 996
 997   protected
 998     { create OpenGL texture object (delete exisiting object if exists) }
 999     procedure CreateID;
1000
1001     { setup texture parameters }
1002     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
1003
1004   protected
1005     property Width:  Integer read GetWidth;   //< the actual width of the texture
1006     property Height: Integer read GetHeight;  //< the actual height of the texture
1007
1008   public
1009     property ID:                  Cardinal  read fID                  write SetID;                  //< name of the OpenGL texture object
1010     property Target:              Cardinal  read fTarget              write SetTarget;              //< texture target (e.g. GL_TEXTURE_2D)
1011     property DeleteTextureOnFree: Boolean   read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
1012
1013     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type
1014     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level
1015
1016     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)
1017     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)
1018     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)
1019
1020     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture
1021 {$IFNDEF OPENGL_ES}
1022     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise
1023 {$ENDIF}
1024
1025     { this method is called after the constructor and sets the default values of this object }
1026     procedure AfterConstruction; override;
1027
1028     { this method is called before the destructor and does some cleanup }
1029     procedure BeforeDestruction; override;
1030
1031   public
1032 {$IFNDEF OPENGL_ES}
1033     { set the new value for texture border color
1034         @param aRed   red color for border (0.0-1.0)
1035         @param aGreen green color for border (0.0-1.0)
1036         @param aBlue  blue color for border (0.0-1.0)
1037         @param aAlpha alpha color for border (0.0-1.0) }
1038     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1039 {$ENDIF}
1040
1041   public
1042     { set new texture filer
1043         @param aMin   min filter
1044         @param aMag   mag filter }
1045     procedure SetFilter(const aMin, aMag: GLenum);
1046
1047     { set new texture wrapping
1048         @param S  texture wrapping for x axis
1049         @param T  texture wrapping for y axis
1050         @param R  texture wrapping for z axis }
1051     procedure SetWrap(
1052       const S: GLenum = GL_CLAMP_TO_EDGE;
1053       const T: GLenum = GL_CLAMP_TO_EDGE;
1054       const R: GLenum = GL_CLAMP_TO_EDGE);
1055
1056 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1057     { set new swizzle
1058         @param r  swizzle for red channel
1059         @param g  swizzle for green channel
1060         @param b  swizzle for blue channel
1061         @param a  swizzle for alpha channel }
1062     procedure SetSwizzle(const r, g, b, a: GLenum);
1063 {$IFEND}
1064
1065   public
1066     { bind texture
1067         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1068     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1069
1070     { bind texture
1071         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
1072     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1073
1074     { upload texture data from given data object to video card
1075         @param aData        texture data object that contains the actual data
1076         @param aCheckSize   check size before upload and throw exception if something is wrong }
1077     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
1078
1079 {$IFNDEF OPENGL_ES}
1080     { download texture data from video card and store it into given data object
1081         @returns @true when download was successfull, @false otherwise }
1082     function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
1083 {$ENDIF}
1084   public
1085     { constructor - creates an empty texture }
1086     constructor Create; overload;
1087
1088     { constructor - creates an texture object and uploads the given data }
1089     constructor Create(const aData: TglBitmapData); overload;
1090
1091   end;
1092
1093 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1094 {$IF NOT DEFINED(OPENGL_ES)}
1095   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
1096     all operations on a bitmap object must be done from the render thread }
1097   TglBitmap1D = class(TglBitmap)
1098   protected
1099
1100     { upload the texture data to video card
1101         @param aDataObj       texture data object that contains the actual data
1102         @param aBuildWithGlu  use glu functions to build mipmaps }
1103     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
1104
1105   public
1106     property Width; //< actual with of the texture
1107
1108     { this method is called after constructor and initializes the object }
1109     procedure AfterConstruction; override;
1110
1111     { upload texture data from given data object to video card
1112         @param aData        texture data object that contains the actual data
1113         @param aCheckSize   check size before upload and throw exception if something is wrong }
1114     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1115
1116   end;
1117 {$IFEND}
1118
1119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1120   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
1121     all operations on a bitmap object must be done from the render thread }
1122   TglBitmap2D = class(TglBitmap)
1123   protected
1124
1125     { upload the texture data to video card
1126         @param aDataObj       texture data object that contains the actual data
1127         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)
1128         @param aBuildWithGlu  use glu functions to build mipmaps }
1129     procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
1130       {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
1131
1132   public
1133     property Width;   //< actual width of the texture
1134     property Height;  //< actual height of the texture
1135
1136     { this method is called after constructor and initializes the object }
1137     procedure AfterConstruction; override;
1138
1139     { upload texture data from given data object to video card
1140         @param aData        texture data object that contains the actual data
1141         @param aCheckSize   check size before upload and throw exception if something is wrong }
1142     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1143
1144   public
1145
1146     { copy a part of the frame buffer to the texture
1147         @param aTop     topmost pixel to copy
1148         @param aLeft    leftmost pixel to copy
1149         @param aRight   rightmost pixel to copy
1150         @param aBottom  bottommost pixel to copy
1151         @param aFormat  format to store data in
1152         @param aDataObj texture data object to store the data in }
1153     class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
1154
1155   end;
1156
1157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1158 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1159   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
1160     all operations on a bitmap object must be done from the render thread }
1161   TglBitmapCubeMap = class(TglBitmap2D)
1162   protected
1163   {$IFNDEF OPENGL_ES}
1164     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
1165   {$ENDIF}
1166
1167   public
1168     { this method is called after constructor and initializes the object }
1169     procedure AfterConstruction; override;
1170
1171     { upload texture data from given data object to video card
1172         @param aData        texture data object that contains the actual data
1173         @param aCheckSize   check size before upload and throw exception if something is wrong }
1174     procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
1175
1176     { upload texture data from given data object to video card
1177         @param aData        texture data object that contains the actual data
1178         @param aCubeTarget  cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
1179         @param aCheckSize   check size before upload and throw exception if something is wrong }
1180     procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
1181
1182     { bind texture
1183         @param aEnableTexCoordsGen  enable cube map generator
1184         @param aEnableTextureUnit   enable texture unit }
1185     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1186
1187     { unbind texture
1188         @param aDisableTexCoordsGen   disable cube map generator
1189         @param aDisableTextureUnit    disable texture unit }
1190     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1191   end;
1192 {$IFEND}
1193
1194 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
1195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1196   { wrapper class for cube normal maps
1197     all operations on a bitmap object must be done from the render thread }
1198   TglBitmapNormalMap = class(TglBitmapCubeMap)
1199   public
1200     { this method is called after constructor and initializes the object }
1201     procedure AfterConstruction; override;
1202
1203     { create cube normal map from texture data and upload it to video card
1204         @param aSize        size of each cube map texture
1205         @param aCheckSize   check size before upload and throw exception if something is wrong }
1206     procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
1207   end;
1208 {$IFEND}
1209
1210 const
1211   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
1212
1213 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1214 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1215 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1216 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1217 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1218 procedure glBitmapSetDefaultWrap(
1219   const S: Cardinal = GL_CLAMP_TO_EDGE;
1220   const T: Cardinal = GL_CLAMP_TO_EDGE;
1221   const R: Cardinal = GL_CLAMP_TO_EDGE);
1222
1223 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1224 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
1225 {$IFEND}
1226
1227 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1228 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1229 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1230 function glBitmapGetDefaultFormat: TglBitmapFormat;
1231 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1232 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1233 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
1234 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
1235 {$IFEND}
1236
1237 function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
1238 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1239 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1240 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1241 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1242 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1243 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1244
1245 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1246
1247 {$IFDEF GLB_DELPHI}
1248 function CreateGrayPalette: HPALETTE;
1249 {$ENDIF}
1250
1251 implementation
1252
1253 uses
1254   Math, syncobjs, typinfo
1255   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1256
1257
1258 var
1259   glBitmapDefaultDeleteTextureOnFree: Boolean;
1260   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1261   glBitmapDefaultFormat: TglBitmapFormat;
1262   glBitmapDefaultMipmap: TglBitmapMipMap;
1263   glBitmapDefaultFilterMin: Cardinal;
1264   glBitmapDefaultFilterMag: Cardinal;
1265   glBitmapDefaultWrapS: Cardinal;
1266   glBitmapDefaultWrapT: Cardinal;
1267   glBitmapDefaultWrapR: Cardinal;
1268   glDefaultSwizzle: array[0..3] of GLenum;
1269
1270 ////////////////////////////////////////////////////////////////////////////////////////////////////
1271 type
1272   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1273   public
1274     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1275     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1276
1277     function CreateMappingData: Pointer; virtual;
1278     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1279
1280     function IsEmpty: Boolean; virtual;
1281     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1282
1283     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1284
1285     constructor Create; virtual;
1286   public
1287     class procedure Init;
1288     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1289     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1290     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1291     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1292     class procedure Clear;
1293     class procedure Finalize;
1294   end;
1295   TFormatDescriptorClass = class of TFormatDescriptor;
1296
1297   TfdEmpty = class(TFormatDescriptor);
1298
1299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1300   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1301     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1302     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1303   end;
1304
1305   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1306     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1307     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1308   end;
1309
1310   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1311     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1312     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1313   end;
1314
1315   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1316     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318   end;
1319
1320   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1321     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1322     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1323   end;
1324
1325   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1326     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1327     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1328   end;
1329
1330   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
1331     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1332     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1333   end;
1334
1335   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
1336     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1337     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1338   end;
1339
1340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1341   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1342     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1343     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1344   end;
1345
1346   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1347     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1348     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1349   end;
1350
1351   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1352     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1353     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1354   end;
1355
1356   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1357     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1358     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1359   end;
1360
1361   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1362     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1363     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1364   end;
1365
1366   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1367     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1368     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1369   end;
1370
1371   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374   end;
1375
1376   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1377     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1378     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1379   end;
1380
1381   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1382     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1383     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1384   end;
1385
1386   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1387     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1388     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1389   end;
1390
1391   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1392     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1393     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1394   end;
1395
1396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1397   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1398     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1399     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1400   end;
1401
1402   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1403     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1404     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1405   end;
1406
1407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1408   TfdAlpha4ub1 = class(TfdAlphaUB1)
1409     procedure SetValues; override;
1410   end;
1411
1412   TfdAlpha8ub1 = class(TfdAlphaUB1)
1413     procedure SetValues; override;
1414   end;
1415
1416   TfdAlpha16us1 = class(TfdAlphaUS1)
1417     procedure SetValues; override;
1418   end;
1419
1420   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1421     procedure SetValues; override;
1422   end;
1423
1424   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1425     procedure SetValues; override;
1426   end;
1427
1428   TfdLuminance16us1 = class(TfdLuminanceUS1)
1429     procedure SetValues; override;
1430   end;
1431
1432   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1433     procedure SetValues; override;
1434   end;
1435
1436   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1437     procedure SetValues; override;
1438   end;
1439
1440   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1441     procedure SetValues; override;
1442   end;
1443
1444   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1445     procedure SetValues; override;
1446   end;
1447
1448   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1449     procedure SetValues; override;
1450   end;
1451
1452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1453   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1454     procedure SetValues; override;
1455   end;
1456
1457   TfdRGBX4us1 = class(TfdUniversalUS1)
1458     procedure SetValues; override;
1459   end;
1460
1461   TfdXRGB4us1 = class(TfdUniversalUS1)
1462     procedure SetValues; override;
1463   end;
1464
1465   TfdR5G6B5us1 = class(TfdUniversalUS1)
1466     procedure SetValues; override;
1467   end;
1468
1469   TfdRGB5X1us1 = class(TfdUniversalUS1)
1470     procedure SetValues; override;
1471   end;
1472
1473   TfdX1RGB5us1 = class(TfdUniversalUS1)
1474     procedure SetValues; override;
1475   end;
1476
1477   TfdRGB8ub3 = class(TfdRGBub3)
1478     procedure SetValues; override;
1479   end;
1480
1481   TfdRGBX8ui1 = class(TfdUniversalUI1)
1482     procedure SetValues; override;
1483   end;
1484
1485   TfdXRGB8ui1 = class(TfdUniversalUI1)
1486     procedure SetValues; override;
1487   end;
1488
1489   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1490     procedure SetValues; override;
1491   end;
1492
1493   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1494     procedure SetValues; override;
1495   end;
1496
1497   TfdRGB16us3 = class(TfdRGBus3)
1498     procedure SetValues; override;
1499   end;
1500
1501   TfdRGBA4us1 = class(TfdUniversalUS1)
1502     procedure SetValues; override;
1503   end;
1504
1505   TfdARGB4us1 = class(TfdUniversalUS1)
1506     procedure SetValues; override;
1507   end;
1508
1509   TfdRGB5A1us1 = class(TfdUniversalUS1)
1510     procedure SetValues; override;
1511   end;
1512
1513   TfdA1RGB5us1 = class(TfdUniversalUS1)
1514     procedure SetValues; override;
1515   end;
1516
1517   TfdRGBA8ui1 = class(TfdUniversalUI1)
1518     procedure SetValues; override;
1519   end;
1520
1521   TfdARGB8ui1 = class(TfdUniversalUI1)
1522     procedure SetValues; override;
1523   end;
1524
1525   TfdRGBA8ub4 = class(TfdRGBAub4)
1526     procedure SetValues; override;
1527   end;
1528
1529   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1530     procedure SetValues; override;
1531   end;
1532
1533   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1534     procedure SetValues; override;
1535   end;
1536
1537   TfdRGBA16us4 = class(TfdRGBAus4)
1538     procedure SetValues; override;
1539   end;
1540
1541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1542   TfdBGRX4us1 = class(TfdUniversalUS1)
1543     procedure SetValues; override;
1544   end;
1545
1546   TfdXBGR4us1 = class(TfdUniversalUS1)
1547     procedure SetValues; override;
1548   end;
1549
1550   TfdB5G6R5us1 = class(TfdUniversalUS1)
1551     procedure SetValues; override;
1552   end;
1553
1554   TfdBGR5X1us1 = class(TfdUniversalUS1)
1555     procedure SetValues; override;
1556   end;
1557
1558   TfdX1BGR5us1 = class(TfdUniversalUS1)
1559     procedure SetValues; override;
1560   end;
1561
1562   TfdBGR8ub3 = class(TfdBGRub3)
1563     procedure SetValues; override;
1564   end;
1565
1566   TfdBGRX8ui1 = class(TfdUniversalUI1)
1567     procedure SetValues; override;
1568   end;
1569
1570   TfdXBGR8ui1 = class(TfdUniversalUI1)
1571     procedure SetValues; override;
1572   end;
1573
1574   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1575     procedure SetValues; override;
1576   end;
1577
1578   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1579     procedure SetValues; override;
1580   end;
1581
1582   TfdBGR16us3 = class(TfdBGRus3)
1583     procedure SetValues; override;
1584   end;
1585
1586   TfdBGRA4us1 = class(TfdUniversalUS1)
1587     procedure SetValues; override;
1588   end;
1589
1590   TfdABGR4us1 = class(TfdUniversalUS1)
1591     procedure SetValues; override;
1592   end;
1593
1594   TfdBGR5A1us1 = class(TfdUniversalUS1)
1595     procedure SetValues; override;
1596   end;
1597
1598   TfdA1BGR5us1 = class(TfdUniversalUS1)
1599     procedure SetValues; override;
1600   end;
1601
1602   TfdBGRA8ui1 = class(TfdUniversalUI1)
1603     procedure SetValues; override;
1604   end;
1605
1606   TfdABGR8ui1 = class(TfdUniversalUI1)
1607     procedure SetValues; override;
1608   end;
1609
1610   TfdBGRA8ub4 = class(TfdBGRAub4)
1611     procedure SetValues; override;
1612   end;
1613
1614   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1615     procedure SetValues; override;
1616   end;
1617
1618   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1619     procedure SetValues; override;
1620   end;
1621
1622   TfdBGRA16us4 = class(TfdBGRAus4)
1623     procedure SetValues; override;
1624   end;
1625
1626   TfdDepth16us1 = class(TfdDepthUS1)
1627     procedure SetValues; override;
1628   end;
1629
1630   TfdDepth24ui1 = class(TfdDepthUI1)
1631     procedure SetValues; override;
1632   end;
1633
1634   TfdDepth32ui1 = class(TfdDepthUI1)
1635     procedure SetValues; override;
1636   end;
1637
1638   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1639     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1640     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1641     procedure SetValues; override;
1642   end;
1643
1644   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1645     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1646     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1647     procedure SetValues; override;
1648   end;
1649
1650   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1651     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1652     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1653     procedure SetValues; override;
1654   end;
1655
1656 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1657   TbmpBitfieldFormat = class(TFormatDescriptor)
1658   public
1659     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1660     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1661     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1662     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1663   end;
1664
1665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1666   TbmpColorTableEnty = packed record
1667     b, g, r, a: Byte;
1668   end;
1669   TbmpColorTable = array of TbmpColorTableEnty;
1670   TbmpColorTableFormat = class(TFormatDescriptor)
1671   private
1672     fColorTable: TbmpColorTable;
1673   protected
1674     procedure SetValues; override;
1675   public
1676     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1677
1678     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1679     procedure CalcValues;
1680     procedure CreateColorTable;
1681
1682     function CreateMappingData: Pointer; override;
1683     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1684     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1685     destructor Destroy; override;
1686   end;
1687
1688 const
1689   LUMINANCE_WEIGHT_R = 0.30;
1690   LUMINANCE_WEIGHT_G = 0.59;
1691   LUMINANCE_WEIGHT_B = 0.11;
1692
1693   ALPHA_WEIGHT_R = 0.30;
1694   ALPHA_WEIGHT_G = 0.59;
1695   ALPHA_WEIGHT_B = 0.11;
1696
1697   DEPTH_WEIGHT_R = 0.333333333;
1698   DEPTH_WEIGHT_G = 0.333333333;
1699   DEPTH_WEIGHT_B = 0.333333333;
1700
1701   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1702     TfdEmpty,
1703
1704     TfdAlpha4ub1,
1705     TfdAlpha8ub1,
1706     TfdAlpha16us1,
1707
1708     TfdLuminance4ub1,
1709     TfdLuminance8ub1,
1710     TfdLuminance16us1,
1711
1712     TfdLuminance4Alpha4ub2,
1713     TfdLuminance6Alpha2ub2,
1714     TfdLuminance8Alpha8ub2,
1715     TfdLuminance12Alpha4us2,
1716     TfdLuminance16Alpha16us2,
1717
1718     TfdR3G3B2ub1,
1719     TfdRGBX4us1,
1720     TfdXRGB4us1,
1721     TfdR5G6B5us1,
1722     TfdRGB5X1us1,
1723     TfdX1RGB5us1,
1724     TfdRGB8ub3,
1725     TfdRGBX8ui1,
1726     TfdXRGB8ui1,
1727     TfdRGB10X2ui1,
1728     TfdX2RGB10ui1,
1729     TfdRGB16us3,
1730
1731     TfdRGBA4us1,
1732     TfdARGB4us1,
1733     TfdRGB5A1us1,
1734     TfdA1RGB5us1,
1735     TfdRGBA8ui1,
1736     TfdARGB8ui1,
1737     TfdRGBA8ub4,
1738     TfdRGB10A2ui1,
1739     TfdA2RGB10ui1,
1740     TfdRGBA16us4,
1741
1742     TfdBGRX4us1,
1743     TfdXBGR4us1,
1744     TfdB5G6R5us1,
1745     TfdBGR5X1us1,
1746     TfdX1BGR5us1,
1747     TfdBGR8ub3,
1748     TfdBGRX8ui1,
1749     TfdXBGR8ui1,
1750     TfdBGR10X2ui1,
1751     TfdX2BGR10ui1,
1752     TfdBGR16us3,
1753
1754     TfdBGRA4us1,
1755     TfdABGR4us1,
1756     TfdBGR5A1us1,
1757     TfdA1BGR5us1,
1758     TfdBGRA8ui1,
1759     TfdABGR8ui1,
1760     TfdBGRA8ub4,
1761     TfdBGR10A2ui1,
1762     TfdA2BGR10ui1,
1763     TfdBGRA16us4,
1764
1765     TfdDepth16us1,
1766     TfdDepth24ui1,
1767     TfdDepth32ui1,
1768
1769     TfdS3tcDtx1RGBA,
1770     TfdS3tcDtx3RGBA,
1771     TfdS3tcDtx5RGBA
1772   );
1773
1774 var
1775   FormatDescriptorCS: TCriticalSection;
1776   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1777
1778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1779 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1780 begin
1781   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1782 end;
1783
1784 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1786 begin
1787   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1788 end;
1789
1790 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1791 function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
1792 begin
1793   result.Fields := [];
1794   if (X >= 0) then
1795     result.Fields := result.Fields + [ffX];
1796   if (Y >= 0) then
1797     result.Fields := result.Fields + [ffY];
1798   result.X := Max(0, X);
1799   result.Y := Max(0, Y);
1800 end;
1801
1802 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1803 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1804 begin
1805   result := glBitmapSize(X, Y);
1806 end;
1807
1808 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1809 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1810 begin
1811   result.r := r;
1812   result.g := g;
1813   result.b := b;
1814   result.a := a;
1815 end;
1816
1817 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1818 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1819 begin
1820   result.r := r;
1821   result.g := g;
1822   result.b := b;
1823   result.a := a;
1824 end;
1825
1826 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1827 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1828 begin
1829   result.r := r;
1830   result.g := g;
1831   result.b := b;
1832   result.a := a;
1833 end;
1834
1835 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1836 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1837 var
1838   i: Integer;
1839 begin
1840   result := false;
1841   for i := 0 to high(r1.arr) do
1842     if (r1.arr[i] <> r2.arr[i]) then
1843       exit;
1844   result := true;
1845 end;
1846
1847 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1848 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1849 var
1850   i: Integer;
1851 begin
1852   result := false;
1853   for i := 0 to high(r1.arr) do
1854     if (r1.arr[i] <> r2.arr[i]) then
1855       exit;
1856   result := true;
1857 end;
1858
1859 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1860 function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
1861 var
1862   desc: TFormatDescriptor;
1863   p, tmp: PByte;
1864   x, y, i: Integer;
1865   md: Pointer;
1866   px: TglBitmapPixelData;
1867 begin
1868   result := nil;
1869   desc := TFormatDescriptor.Get(aFormat);
1870   if (desc.IsCompressed) or (desc.glFormat = 0) then
1871     exit;
1872
1873   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1874   md := desc.CreateMappingData;
1875   try
1876     tmp := p;
1877     desc.PreparePixel(px);
1878     for y := 0 to 4 do
1879       for x := 0 to 4 do begin
1880         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1881         for i := 0 to 3 do begin
1882           if ((y < 3) and (y = i)) or
1883              ((y = 3) and (i < 3)) or
1884              ((y = 4) and (i = 3))
1885           then
1886             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1887           else if ((y < 4) and (i = 3)) or
1888                   ((y = 4) and (i < 3))
1889           then
1890             px.Data.arr[i] := px.Range.arr[i]
1891           else
1892             px.Data.arr[i] := 0; //px.Range.arr[i];
1893         end;
1894         desc.Map(px, tmp, md);
1895       end;
1896   finally
1897     desc.FreeMappingData(md);
1898   end;
1899
1900   result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
1901 end;
1902
1903 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1904 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1905 begin
1906   result.r := r;
1907   result.g := g;
1908   result.b := b;
1909   result.a := a;
1910 end;
1911
1912 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1913 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1914 begin
1915   result := [];
1916
1917   if (aFormat in [
1918         //8bpp
1919         tfAlpha4ub1, tfAlpha8ub1,
1920         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1921
1922         //16bpp
1923         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1924         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1925         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1926
1927         //24bpp
1928         tfBGR8ub3, tfRGB8ub3,
1929
1930         //32bpp
1931         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1932         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
1933   then
1934     result := result + [ ftBMP ];
1935
1936   if (aFormat in [
1937         //8bbp
1938         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
1939
1940         //16bbp
1941         tfAlpha16us1, tfLuminance16us1,
1942         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1943         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
1944
1945         //24bbp
1946         tfBGR8ub3,
1947
1948         //32bbp
1949         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
1950         tfDepth24ui1, tfDepth32ui1])
1951   then
1952     result := result + [ftTGA];
1953
1954   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
1955     result := result + [ftDDS];
1956
1957 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1958   if aFormat in [
1959       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
1960       tfRGB8ub3, tfRGBA8ui1,
1961       tfBGR8ub3, tfBGRA8ui1] then
1962     result := result + [ftPNG];
1963 {$ENDIF}
1964
1965 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1966   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
1967     result := result + [ftJPEG];
1968 {$ENDIF}
1969 end;
1970
1971 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1972 function IsPowerOfTwo(aNumber: Integer): Boolean;
1973 begin
1974   while (aNumber and 1) = 0 do
1975     aNumber := aNumber shr 1;
1976   result := aNumber = 1;
1977 end;
1978
1979 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1980 function GetTopMostBit(aBitSet: QWord): Integer;
1981 begin
1982   result := 0;
1983   while aBitSet > 0 do begin
1984     inc(result);
1985     aBitSet := aBitSet shr 1;
1986   end;
1987 end;
1988
1989 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1990 function CountSetBits(aBitSet: QWord): Integer;
1991 begin
1992   result := 0;
1993   while aBitSet > 0 do begin
1994     if (aBitSet and 1) = 1 then
1995       inc(result);
1996     aBitSet := aBitSet shr 1;
1997   end;
1998 end;
1999
2000 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2001 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2002 begin
2003   result := Trunc(
2004     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2005     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2006     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2007 end;
2008
2009 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2010 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2011 begin
2012   result := Trunc(
2013     DEPTH_WEIGHT_R * aPixel.Data.r +
2014     DEPTH_WEIGHT_G * aPixel.Data.g +
2015     DEPTH_WEIGHT_B * aPixel.Data.b);
2016 end;
2017
2018 {$IFDEF GLB_SDL_IMAGE}
2019 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2020 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2021 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2022 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2023 begin
2024   result := TStream(context^.unknown.data1).Seek(offset, whence);
2025 end;
2026
2027 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2028 begin
2029   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2030 end;
2031
2032 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2033 begin
2034   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2035 end;
2036
2037 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2038 begin
2039   result := 0;
2040 end;
2041
2042 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2043 begin
2044   result := SDL_AllocRW;
2045
2046   if result = nil then
2047     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2048
2049   result^.seek := glBitmapRWseek;
2050   result^.read := glBitmapRWread;
2051   result^.write := glBitmapRWwrite;
2052   result^.close := glBitmapRWclose;
2053   result^.unknown.data1 := Stream;
2054 end;
2055 {$ENDIF}
2056
2057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2058 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2059 begin
2060   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2061 end;
2062
2063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2064 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2065 begin
2066   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2067 end;
2068
2069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2070 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2071 begin
2072   glBitmapDefaultMipmap := aValue;
2073 end;
2074
2075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2076 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2077 begin
2078   glBitmapDefaultFormat := aFormat;
2079 end;
2080
2081 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2082 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2083 begin
2084   glBitmapDefaultFilterMin := aMin;
2085   glBitmapDefaultFilterMag := aMag;
2086 end;
2087
2088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2090 begin
2091   glBitmapDefaultWrapS := S;
2092   glBitmapDefaultWrapT := T;
2093   glBitmapDefaultWrapR := R;
2094 end;
2095
2096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2097 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2098 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2099 begin
2100   glDefaultSwizzle[0] := r;
2101   glDefaultSwizzle[1] := g;
2102   glDefaultSwizzle[2] := b;
2103   glDefaultSwizzle[3] := a;
2104 end;
2105 {$IFEND}
2106
2107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2108 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2109 begin
2110   result := glBitmapDefaultDeleteTextureOnFree;
2111 end;
2112
2113 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2114 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2115 begin
2116   result := glBitmapDefaultFreeDataAfterGenTextures;
2117 end;
2118
2119 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2121 begin
2122   result := glBitmapDefaultMipmap;
2123 end;
2124
2125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2126 function glBitmapGetDefaultFormat: TglBitmapFormat;
2127 begin
2128   result := glBitmapDefaultFormat;
2129 end;
2130
2131 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2132 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2133 begin
2134   aMin := glBitmapDefaultFilterMin;
2135   aMag := glBitmapDefaultFilterMag;
2136 end;
2137
2138 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2139 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2140 begin
2141   S := glBitmapDefaultWrapS;
2142   T := glBitmapDefaultWrapT;
2143   R := glBitmapDefaultWrapR;
2144 end;
2145
2146 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
2147 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2148 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2149 begin
2150   r := glDefaultSwizzle[0];
2151   g := glDefaultSwizzle[1];
2152   b := glDefaultSwizzle[2];
2153   a := glDefaultSwizzle[3];
2154 end;
2155 {$IFEND}
2156
2157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2158 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2159 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2160 function TFormatDescriptor.CreateMappingData: Pointer;
2161 begin
2162   result := nil;
2163 end;
2164
2165 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2166 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2167 begin
2168   //DUMMY
2169 end;
2170
2171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2172 function TFormatDescriptor.IsEmpty: Boolean;
2173 begin
2174   result := (fFormat = tfEmpty);
2175 end;
2176
2177 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2178 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2179 var
2180   i: Integer;
2181   m: TglBitmapRec4ul;
2182 begin
2183   result := false;
2184   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2185     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2186   m := Mask;
2187   for i := 0 to 3 do
2188     if (aMask.arr[i] <> m.arr[i]) then
2189       exit;
2190   result := true;
2191 end;
2192
2193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2194 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2195 begin
2196   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2197   aPixel.Data   := Range;
2198   aPixel.Format := fFormat;
2199   aPixel.Range  := Range;
2200 end;
2201
2202 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2203 constructor TFormatDescriptor.Create;
2204 begin
2205   inherited Create;
2206 end;
2207
2208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2209 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2211 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2212 begin
2213   aData^ := aPixel.Data.a;
2214   inc(aData);
2215 end;
2216
2217 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2218 begin
2219   aPixel.Data.r := 0;
2220   aPixel.Data.g := 0;
2221   aPixel.Data.b := 0;
2222   aPixel.Data.a := aData^;
2223   inc(aData);
2224 end;
2225
2226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2227 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2229 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2230 begin
2231   aData^ := LuminanceWeight(aPixel);
2232   inc(aData);
2233 end;
2234
2235 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2236 begin
2237   aPixel.Data.r := aData^;
2238   aPixel.Data.g := aData^;
2239   aPixel.Data.b := aData^;
2240   aPixel.Data.a := 0;
2241   inc(aData);
2242 end;
2243
2244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2245 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2248 var
2249   i: Integer;
2250 begin
2251   aData^ := 0;
2252   for i := 0 to 3 do
2253     if (Range.arr[i] > 0) then
2254       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2255   inc(aData);
2256 end;
2257
2258 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2259 var
2260   i: Integer;
2261 begin
2262   for i := 0 to 3 do
2263     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2264   inc(aData);
2265 end;
2266
2267 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2268 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2269 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2270 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2271 begin
2272   inherited Map(aPixel, aData, aMapData);
2273   aData^ := aPixel.Data.a;
2274   inc(aData);
2275 end;
2276
2277 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2278 begin
2279   inherited Unmap(aData, aPixel, aMapData);
2280   aPixel.Data.a := aData^;
2281   inc(aData);
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2286 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2287 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2288 begin
2289   aData^ := aPixel.Data.r;
2290   inc(aData);
2291   aData^ := aPixel.Data.g;
2292   inc(aData);
2293   aData^ := aPixel.Data.b;
2294   inc(aData);
2295 end;
2296
2297 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2298 begin
2299   aPixel.Data.r := aData^;
2300   inc(aData);
2301   aPixel.Data.g := aData^;
2302   inc(aData);
2303   aPixel.Data.b := aData^;
2304   inc(aData);
2305   aPixel.Data.a := 0;
2306 end;
2307
2308 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2309 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2311 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2312 begin
2313   aData^ := aPixel.Data.b;
2314   inc(aData);
2315   aData^ := aPixel.Data.g;
2316   inc(aData);
2317   aData^ := aPixel.Data.r;
2318   inc(aData);
2319 end;
2320
2321 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2322 begin
2323   aPixel.Data.b := aData^;
2324   inc(aData);
2325   aPixel.Data.g := aData^;
2326   inc(aData);
2327   aPixel.Data.r := aData^;
2328   inc(aData);
2329   aPixel.Data.a := 0;
2330 end;
2331
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2336 begin
2337   inherited Map(aPixel, aData, aMapData);
2338   aData^ := aPixel.Data.a;
2339   inc(aData);
2340 end;
2341
2342 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2343 begin
2344   inherited Unmap(aData, aPixel, aMapData);
2345   aPixel.Data.a := aData^;
2346   inc(aData);
2347 end;
2348
2349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2350 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2352 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2353 begin
2354   inherited Map(aPixel, aData, aMapData);
2355   aData^ := aPixel.Data.a;
2356   inc(aData);
2357 end;
2358
2359 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2360 begin
2361   inherited Unmap(aData, aPixel, aMapData);
2362   aPixel.Data.a := aData^;
2363   inc(aData);
2364 end;
2365
2366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2370 begin
2371   PWord(aData)^ := aPixel.Data.a;
2372   inc(aData, 2);
2373 end;
2374
2375 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2376 begin
2377   aPixel.Data.r := 0;
2378   aPixel.Data.g := 0;
2379   aPixel.Data.b := 0;
2380   aPixel.Data.a := PWord(aData)^;
2381   inc(aData, 2);
2382 end;
2383
2384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2385 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2387 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2388 begin
2389   PWord(aData)^ := LuminanceWeight(aPixel);
2390   inc(aData, 2);
2391 end;
2392
2393 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2394 begin
2395   aPixel.Data.r := PWord(aData)^;
2396   aPixel.Data.g := PWord(aData)^;
2397   aPixel.Data.b := PWord(aData)^;
2398   aPixel.Data.a := 0;
2399   inc(aData, 2);
2400 end;
2401
2402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2405 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2406 var
2407   i: Integer;
2408 begin
2409   PWord(aData)^ := 0;
2410   for i := 0 to 3 do
2411     if (Range.arr[i] > 0) then
2412       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2413   inc(aData, 2);
2414 end;
2415
2416 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2417 var
2418   i: Integer;
2419 begin
2420   for i := 0 to 3 do
2421     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2422   inc(aData, 2);
2423 end;
2424
2425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2429 begin
2430   PWord(aData)^ := DepthWeight(aPixel);
2431   inc(aData, 2);
2432 end;
2433
2434 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2435 begin
2436   aPixel.Data.r := PWord(aData)^;
2437   aPixel.Data.g := PWord(aData)^;
2438   aPixel.Data.b := PWord(aData)^;
2439   aPixel.Data.a := PWord(aData)^;;
2440   inc(aData, 2);
2441 end;
2442
2443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2444 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2446 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2447 begin
2448   inherited Map(aPixel, aData, aMapData);
2449   PWord(aData)^ := aPixel.Data.a;
2450   inc(aData, 2);
2451 end;
2452
2453 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2454 begin
2455   inherited Unmap(aData, aPixel, aMapData);
2456   aPixel.Data.a := PWord(aData)^;
2457   inc(aData, 2);
2458 end;
2459
2460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2461 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2464 begin
2465   PWord(aData)^ := aPixel.Data.r;
2466   inc(aData, 2);
2467   PWord(aData)^ := aPixel.Data.g;
2468   inc(aData, 2);
2469   PWord(aData)^ := aPixel.Data.b;
2470   inc(aData, 2);
2471 end;
2472
2473 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2474 begin
2475   aPixel.Data.r := PWord(aData)^;
2476   inc(aData, 2);
2477   aPixel.Data.g := PWord(aData)^;
2478   inc(aData, 2);
2479   aPixel.Data.b := PWord(aData)^;
2480   inc(aData, 2);
2481   aPixel.Data.a := 0;
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2487 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2488 begin
2489   PWord(aData)^ := aPixel.Data.b;
2490   inc(aData, 2);
2491   PWord(aData)^ := aPixel.Data.g;
2492   inc(aData, 2);
2493   PWord(aData)^ := aPixel.Data.r;
2494   inc(aData, 2);
2495 end;
2496
2497 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2498 begin
2499   aPixel.Data.b := PWord(aData)^;
2500   inc(aData, 2);
2501   aPixel.Data.g := PWord(aData)^;
2502   inc(aData, 2);
2503   aPixel.Data.r := PWord(aData)^;
2504   inc(aData, 2);
2505   aPixel.Data.a := 0;
2506 end;
2507
2508 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2509 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2511 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2512 begin
2513   inherited Map(aPixel, aData, aMapData);
2514   PWord(aData)^ := aPixel.Data.a;
2515   inc(aData, 2);
2516 end;
2517
2518 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2519 begin
2520   inherited Unmap(aData, aPixel, aMapData);
2521   aPixel.Data.a := PWord(aData)^;
2522   inc(aData, 2);
2523 end;
2524
2525 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2528 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2529 begin
2530   PWord(aData)^ := aPixel.Data.a;
2531   inc(aData, 2);
2532   inherited Map(aPixel, aData, aMapData);
2533 end;
2534
2535 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2536 begin
2537   aPixel.Data.a := PWord(aData)^;
2538   inc(aData, 2);
2539   inherited Unmap(aData, aPixel, aMapData);
2540 end;
2541
2542 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2543 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2546 begin
2547   inherited Map(aPixel, aData, aMapData);
2548   PWord(aData)^ := aPixel.Data.a;
2549   inc(aData, 2);
2550 end;
2551
2552 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2553 begin
2554   inherited Unmap(aData, aPixel, aMapData);
2555   aPixel.Data.a := PWord(aData)^;
2556   inc(aData, 2);
2557 end;
2558
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2561 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2562 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2563 begin
2564   PWord(aData)^ := aPixel.Data.a;
2565   inc(aData, 2);
2566   inherited Map(aPixel, aData, aMapData);
2567 end;
2568
2569 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2570 begin
2571   aPixel.Data.a := PWord(aData)^;
2572   inc(aData, 2);
2573   inherited Unmap(aData, aPixel, aMapData);
2574 end;
2575
2576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2577 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2580 var
2581   i: Integer;
2582 begin
2583   PCardinal(aData)^ := 0;
2584   for i := 0 to 3 do
2585     if (Range.arr[i] > 0) then
2586       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2587   inc(aData, 4);
2588 end;
2589
2590 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2591 var
2592   i: Integer;
2593 begin
2594   for i := 0 to 3 do
2595     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2596   inc(aData, 2);
2597 end;
2598
2599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2601 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2603 begin
2604   PCardinal(aData)^ := DepthWeight(aPixel);
2605   inc(aData, 4);
2606 end;
2607
2608 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2609 begin
2610   aPixel.Data.r := PCardinal(aData)^;
2611   aPixel.Data.g := PCardinal(aData)^;
2612   aPixel.Data.b := PCardinal(aData)^;
2613   aPixel.Data.a := PCardinal(aData)^;
2614   inc(aData, 4);
2615 end;
2616
2617 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2618 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2619 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2620 procedure TfdAlpha4ub1.SetValues;
2621 begin
2622   inherited SetValues;
2623   fBitsPerPixel     := 8;
2624   fFormat           := tfAlpha4ub1;
2625   fWithAlpha        := tfAlpha4ub1;
2626   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2627   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2628 {$IFNDEF OPENGL_ES}
2629   fOpenGLFormat     := tfAlpha4ub1;
2630   fglFormat         := GL_ALPHA;
2631   fglInternalFormat := GL_ALPHA4;
2632   fglDataFormat     := GL_UNSIGNED_BYTE;
2633 {$ELSE}
2634   fOpenGLFormat     := tfAlpha8ub1;
2635 {$ENDIF}
2636 end;
2637
2638 procedure TfdAlpha8ub1.SetValues;
2639 begin
2640   inherited SetValues;
2641   fBitsPerPixel     := 8;
2642   fFormat           := tfAlpha8ub1;
2643   fWithAlpha        := tfAlpha8ub1;
2644   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2645   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2646   fOpenGLFormat     := tfAlpha8ub1;
2647   fglFormat         := GL_ALPHA;
2648   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
2649   fglDataFormat     := GL_UNSIGNED_BYTE;
2650 end;
2651
2652 procedure TfdAlpha16us1.SetValues;
2653 begin
2654   inherited SetValues;
2655   fBitsPerPixel     := 16;
2656   fFormat           := tfAlpha16us1;
2657   fWithAlpha        := tfAlpha16us1;
2658   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2659   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2660 {$IFNDEF OPENGL_ES}
2661   fOpenGLFormat     := tfAlpha16us1;
2662   fglFormat         := GL_ALPHA;
2663   fglInternalFormat := GL_ALPHA16;
2664   fglDataFormat     := GL_UNSIGNED_SHORT;
2665 {$ELSE}
2666   fOpenGLFormat     := tfAlpha8ub1;
2667 {$ENDIF}
2668 end;
2669
2670 procedure TfdLuminance4ub1.SetValues;
2671 begin
2672   inherited SetValues;
2673   fBitsPerPixel     := 8;
2674   fFormat           := tfLuminance4ub1;
2675   fWithAlpha        := tfLuminance4Alpha4ub2;
2676   fWithoutAlpha     := tfLuminance4ub1;
2677   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2678   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2679 {$IFNDEF OPENGL_ES}
2680   fOpenGLFormat     := tfLuminance4ub1;
2681   fglFormat         := GL_LUMINANCE;
2682   fglInternalFormat := GL_LUMINANCE4;
2683   fglDataFormat     := GL_UNSIGNED_BYTE;
2684 {$ELSE}
2685   fOpenGLFormat     := tfLuminance8ub1;
2686 {$ENDIF}
2687 end;
2688
2689 procedure TfdLuminance8ub1.SetValues;
2690 begin
2691   inherited SetValues;
2692   fBitsPerPixel     := 8;
2693   fFormat           := tfLuminance8ub1;
2694   fWithAlpha        := tfLuminance8Alpha8ub2;
2695   fWithoutAlpha     := tfLuminance8ub1;
2696   fOpenGLFormat     := tfLuminance8ub1;
2697   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2698   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2699   fglFormat         := GL_LUMINANCE;
2700   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
2701   fglDataFormat     := GL_UNSIGNED_BYTE;
2702 end;
2703
2704 procedure TfdLuminance16us1.SetValues;
2705 begin
2706   inherited SetValues;
2707   fBitsPerPixel     := 16;
2708   fFormat           := tfLuminance16us1;
2709   fWithAlpha        := tfLuminance16Alpha16us2;
2710   fWithoutAlpha     := tfLuminance16us1;
2711   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
2712   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
2713 {$IFNDEF OPENGL_ES}
2714   fOpenGLFormat     := tfLuminance16us1;
2715   fglFormat         := GL_LUMINANCE;
2716   fglInternalFormat := GL_LUMINANCE16;
2717   fglDataFormat     := GL_UNSIGNED_SHORT;
2718 {$ELSE}
2719   fOpenGLFormat     := tfLuminance8ub1;
2720 {$ENDIF}
2721 end;
2722
2723 procedure TfdLuminance4Alpha4ub2.SetValues;
2724 begin
2725   inherited SetValues;
2726   fBitsPerPixel     := 16;
2727   fFormat           := tfLuminance4Alpha4ub2;
2728   fWithAlpha        := tfLuminance4Alpha4ub2;
2729   fWithoutAlpha     := tfLuminance4ub1;
2730   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2731   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2732 {$IFNDEF OPENGL_ES}
2733   fOpenGLFormat     := tfLuminance4Alpha4ub2;
2734   fglFormat         := GL_LUMINANCE_ALPHA;
2735   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
2736   fglDataFormat     := GL_UNSIGNED_BYTE;
2737 {$ELSE}
2738   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2739 {$ENDIF}
2740 end;
2741
2742 procedure TfdLuminance6Alpha2ub2.SetValues;
2743 begin
2744   inherited SetValues;
2745   fBitsPerPixel     := 16;
2746   fFormat           := tfLuminance6Alpha2ub2;
2747   fWithAlpha        := tfLuminance6Alpha2ub2;
2748   fWithoutAlpha     := tfLuminance8ub1;
2749   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2750   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2751 {$IFNDEF OPENGL_ES}
2752   fOpenGLFormat     := tfLuminance6Alpha2ub2;
2753   fglFormat         := GL_LUMINANCE_ALPHA;
2754   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
2755   fglDataFormat     := GL_UNSIGNED_BYTE;
2756 {$ELSE}
2757   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2758 {$ENDIF}
2759 end;
2760
2761 procedure TfdLuminance8Alpha8ub2.SetValues;
2762 begin
2763   inherited SetValues;
2764   fBitsPerPixel     := 16;
2765   fFormat           := tfLuminance8Alpha8ub2;
2766   fWithAlpha        := tfLuminance8Alpha8ub2;
2767   fWithoutAlpha     := tfLuminance8ub1;
2768   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2769   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
2770   fShift            := glBitmapRec4ub(0, 0, 0, 8);
2771   fglFormat         := GL_LUMINANCE_ALPHA;
2772   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
2773   fglDataFormat     := GL_UNSIGNED_BYTE;
2774 end;
2775
2776 procedure TfdLuminance12Alpha4us2.SetValues;
2777 begin
2778   inherited SetValues;
2779   fBitsPerPixel     := 32;
2780   fFormat           := tfLuminance12Alpha4us2;
2781   fWithAlpha        := tfLuminance12Alpha4us2;
2782   fWithoutAlpha     := tfLuminance16us1;
2783   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2784   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2785 {$IFNDEF OPENGL_ES}
2786   fOpenGLFormat     := tfLuminance12Alpha4us2;
2787   fglFormat         := GL_LUMINANCE_ALPHA;
2788   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
2789   fglDataFormat     := GL_UNSIGNED_SHORT;
2790 {$ELSE}
2791   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2792 {$ENDIF}
2793 end;
2794
2795 procedure TfdLuminance16Alpha16us2.SetValues;
2796 begin
2797   inherited SetValues;
2798   fBitsPerPixel     := 32;
2799   fFormat           := tfLuminance16Alpha16us2;
2800   fWithAlpha        := tfLuminance16Alpha16us2;
2801   fWithoutAlpha     := tfLuminance16us1;
2802   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
2803   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
2804 {$IFNDEF OPENGL_ES}
2805   fOpenGLFormat     := tfLuminance16Alpha16us2;
2806   fglFormat         := GL_LUMINANCE_ALPHA;
2807   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
2808   fglDataFormat     := GL_UNSIGNED_SHORT;
2809 {$ELSE}
2810   fOpenGLFormat     := tfLuminance8Alpha8ub2;
2811 {$ENDIF}
2812 end;
2813
2814 procedure TfdR3G3B2ub1.SetValues;
2815 begin
2816   inherited SetValues;
2817   fBitsPerPixel     := 8;
2818   fFormat           := tfR3G3B2ub1;
2819   fWithAlpha        := tfRGBA4us1;
2820   fWithoutAlpha     := tfR3G3B2ub1;
2821   fRGBInverted      := tfEmpty;
2822   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
2823   fShift            := glBitmapRec4ub(5, 2, 0, 0);
2824 {$IFNDEF OPENGL_ES}
2825   fOpenGLFormat     := tfR3G3B2ub1;
2826   fglFormat         := GL_RGB;
2827   fglInternalFormat := GL_R3_G3_B2;
2828   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
2829 {$ELSE}
2830   fOpenGLFormat     := tfR5G6B5us1;
2831 {$ENDIF}
2832 end;
2833
2834 procedure TfdRGBX4us1.SetValues;
2835 begin
2836   inherited SetValues;
2837   fBitsPerPixel     := 16;
2838   fFormat           := tfRGBX4us1;
2839   fWithAlpha        := tfRGBA4us1;
2840   fWithoutAlpha     := tfRGBX4us1;
2841   fRGBInverted      := tfBGRX4us1;
2842   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
2843   fShift            := glBitmapRec4ub(12, 8, 4, 0);
2844 {$IFNDEF OPENGL_ES}
2845   fOpenGLFormat     := tfRGBX4us1;
2846   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2847   fglInternalFormat := GL_RGB4;
2848   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
2849 {$ELSE}
2850   fOpenGLFormat     := tfR5G6B5us1;
2851 {$ENDIF}
2852 end;
2853
2854 procedure TfdXRGB4us1.SetValues;
2855 begin
2856   inherited SetValues;
2857   fBitsPerPixel     := 16;
2858   fFormat           := tfXRGB4us1;
2859   fWithAlpha        := tfARGB4us1;
2860   fWithoutAlpha     := tfXRGB4us1;
2861   fRGBInverted      := tfXBGR4us1;
2862   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
2863   fShift            := glBitmapRec4ub(8, 4, 0, 0);
2864 {$IFNDEF OPENGL_ES}
2865   fOpenGLFormat     := tfXRGB4us1;
2866   fglFormat         := GL_BGRA;
2867   fglInternalFormat := GL_RGB4;
2868   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
2869 {$ELSE}
2870   fOpenGLFormat     := tfR5G6B5us1;
2871 {$ENDIF}
2872 end;
2873
2874 procedure TfdR5G6B5us1.SetValues;
2875 begin
2876   inherited SetValues;
2877   fBitsPerPixel     := 16;
2878   fFormat           := tfR5G6B5us1;
2879   fWithAlpha        := tfRGB5A1us1;
2880   fWithoutAlpha     := tfR5G6B5us1;
2881   fRGBInverted      := tfB5G6R5us1;
2882   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
2883   fShift            := glBitmapRec4ub(11, 5, 0, 0);
2884 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
2885   fOpenGLFormat     := tfR5G6B5us1;
2886   fglFormat         := GL_RGB;
2887   fglInternalFormat := GL_RGB565;
2888   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
2889 {$ELSE}
2890   fOpenGLFormat     := tfRGB8ub3;
2891 {$IFEND}
2892 end;
2893
2894 procedure TfdRGB5X1us1.SetValues;
2895 begin
2896   inherited SetValues;
2897   fBitsPerPixel     := 16;
2898   fFormat           := tfRGB5X1us1;
2899   fWithAlpha        := tfRGB5A1us1;
2900   fWithoutAlpha     := tfRGB5X1us1;
2901   fRGBInverted      := tfBGR5X1us1;
2902   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2903   fShift            := glBitmapRec4ub(11, 6, 1, 0);
2904 {$IFNDEF OPENGL_ES}
2905   fOpenGLFormat     := tfRGB5X1us1;
2906   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2907   fglInternalFormat := GL_RGB5;
2908   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
2909 {$ELSE}
2910   fOpenGLFormat     := tfR5G6B5us1;
2911 {$ENDIF}
2912 end;
2913
2914 procedure TfdX1RGB5us1.SetValues;
2915 begin
2916   inherited SetValues;
2917   fBitsPerPixel     := 16;
2918   fFormat           := tfX1RGB5us1;
2919   fWithAlpha        := tfA1RGB5us1;
2920   fWithoutAlpha     := tfX1RGB5us1;
2921   fRGBInverted      := tfX1BGR5us1;
2922   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
2923   fShift            := glBitmapRec4ub(10, 5, 0, 0);
2924 {$IFNDEF OPENGL_ES}
2925   fOpenGLFormat     := tfX1RGB5us1;
2926   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2927   fglInternalFormat := GL_RGB5;
2928   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
2929 {$ELSE}
2930   fOpenGLFormat     := tfR5G6B5us1;
2931 {$ENDIF}
2932 end;
2933
2934 procedure TfdRGB8ub3.SetValues;
2935 begin
2936   inherited SetValues;
2937   fBitsPerPixel     := 24;
2938   fFormat           := tfRGB8ub3;
2939   fWithAlpha        := tfRGBA8ub4;
2940   fWithoutAlpha     := tfRGB8ub3;
2941   fRGBInverted      := tfBGR8ub3;
2942   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
2943   fShift            := glBitmapRec4ub(0, 8, 16, 0);
2944   fOpenGLFormat     := tfRGB8ub3;
2945   fglFormat         := GL_RGB;
2946   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
2947   fglDataFormat     := GL_UNSIGNED_BYTE;
2948 end;
2949
2950 procedure TfdRGBX8ui1.SetValues;
2951 begin
2952   inherited SetValues;
2953   fBitsPerPixel     := 32;
2954   fFormat           := tfRGBX8ui1;
2955   fWithAlpha        := tfRGBA8ui1;
2956   fWithoutAlpha     := tfRGBX8ui1;
2957   fRGBInverted      := tfBGRX8ui1;
2958   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2959   fShift            := glBitmapRec4ub(24, 16,  8, 0);
2960 {$IFNDEF OPENGL_ES}
2961   fOpenGLFormat     := tfRGBX8ui1;
2962   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2963   fglInternalFormat := GL_RGB8;
2964   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
2965 {$ELSE}
2966   fOpenGLFormat     := tfRGB8ub3;
2967 {$ENDIF}
2968 end;
2969
2970 procedure TfdXRGB8ui1.SetValues;
2971 begin
2972   inherited SetValues;
2973   fBitsPerPixel     := 32;
2974   fFormat           := tfXRGB8ui1;
2975   fWithAlpha        := tfXRGB8ui1;
2976   fWithoutAlpha     := tfXRGB8ui1;
2977   fOpenGLFormat     := tfXRGB8ui1;
2978   fRGBInverted      := tfXBGR8ui1;
2979   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
2980   fShift            := glBitmapRec4ub(16,  8,  0, 0);
2981 {$IFNDEF OPENGL_ES}
2982   fOpenGLFormat     := tfXRGB8ui1;
2983   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
2984   fglInternalFormat := GL_RGB8;
2985   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
2986 {$ELSE}
2987   fOpenGLFormat     := tfRGB8ub3;
2988 {$ENDIF}
2989 end;
2990
2991 procedure TfdRGB10X2ui1.SetValues;
2992 begin
2993   inherited SetValues;
2994   fBitsPerPixel     := 32;
2995   fFormat           := tfRGB10X2ui1;
2996   fWithAlpha        := tfRGB10A2ui1;
2997   fWithoutAlpha     := tfRGB10X2ui1;
2998   fRGBInverted      := tfBGR10X2ui1;
2999   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3000   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3001 {$IFNDEF OPENGL_ES}
3002   fOpenGLFormat     := tfRGB10X2ui1;
3003   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3004   fglInternalFormat := GL_RGB10;
3005   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3006 {$ELSE}
3007   fOpenGLFormat     := tfRGB16us3;
3008 {$ENDIF}
3009 end;
3010
3011 procedure TfdX2RGB10ui1.SetValues;
3012 begin
3013   inherited SetValues;
3014   fBitsPerPixel     := 32;
3015   fFormat           := tfX2RGB10ui1;
3016   fWithAlpha        := tfA2RGB10ui1;
3017   fWithoutAlpha     := tfX2RGB10ui1;
3018   fRGBInverted      := tfX2BGR10ui1;
3019   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3020   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3021 {$IFNDEF OPENGL_ES}
3022   fOpenGLFormat     := tfX2RGB10ui1;
3023   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3024   fglInternalFormat := GL_RGB10;
3025   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3026 {$ELSE}
3027   fOpenGLFormat     := tfRGB16us3;
3028 {$ENDIF}
3029 end;
3030
3031 procedure TfdRGB16us3.SetValues;
3032 begin
3033   inherited SetValues;
3034   fBitsPerPixel     := 48;
3035   fFormat           := tfRGB16us3;
3036   fWithAlpha        := tfRGBA16us4;
3037   fWithoutAlpha     := tfRGB16us3;
3038   fRGBInverted      := tfBGR16us3;
3039   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3040   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3041 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3042   fOpenGLFormat     := tfRGB16us3;
3043   fglFormat         := GL_RGB;
3044   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
3045   fglDataFormat     := GL_UNSIGNED_SHORT;
3046 {$ELSE}
3047   fOpenGLFormat     := tfRGB8ub3;
3048 {$IFEND}
3049 end;
3050
3051 procedure TfdRGBA4us1.SetValues;
3052 begin
3053   inherited SetValues;
3054   fBitsPerPixel     := 16;
3055   fFormat           := tfRGBA4us1;
3056   fWithAlpha        := tfRGBA4us1;
3057   fWithoutAlpha     := tfRGBX4us1;
3058   fOpenGLFormat     := tfRGBA4us1;
3059   fRGBInverted      := tfBGRA4us1;
3060   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3061   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3062   fglFormat         := GL_RGBA;
3063   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3064   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3065 end;
3066
3067 procedure TfdARGB4us1.SetValues;
3068 begin
3069   inherited SetValues;
3070   fBitsPerPixel     := 16;
3071   fFormat           := tfARGB4us1;
3072   fWithAlpha        := tfARGB4us1;
3073   fWithoutAlpha     := tfXRGB4us1;
3074   fRGBInverted      := tfABGR4us1;
3075   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3076   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3077 {$IFNDEF OPENGL_ES}
3078   fOpenGLFormat     := tfARGB4us1;
3079   fglFormat         := GL_BGRA;
3080   fglInternalFormat := GL_RGBA4;
3081   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3082 {$ELSE}
3083   fOpenGLFormat     := tfRGBA4us1;
3084 {$ENDIF}
3085 end;
3086
3087 procedure TfdRGB5A1us1.SetValues;
3088 begin
3089   inherited SetValues;
3090   fBitsPerPixel     := 16;
3091   fFormat           := tfRGB5A1us1;
3092   fWithAlpha        := tfRGB5A1us1;
3093   fWithoutAlpha     := tfRGB5X1us1;
3094   fOpenGLFormat     := tfRGB5A1us1;
3095   fRGBInverted      := tfBGR5A1us1;
3096   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3097   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3098   fglFormat         := GL_RGBA;
3099   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
3100   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3101 end;
3102
3103 procedure TfdA1RGB5us1.SetValues;
3104 begin
3105   inherited SetValues;
3106   fBitsPerPixel     := 16;
3107   fFormat           := tfA1RGB5us1;
3108   fWithAlpha        := tfA1RGB5us1;
3109   fWithoutAlpha     := tfX1RGB5us1;
3110   fRGBInverted      := tfA1BGR5us1;
3111   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3112   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3113 {$IFNDEF OPENGL_ES}
3114   fOpenGLFormat     := tfA1RGB5us1;
3115   fglFormat         := GL_BGRA;
3116   fglInternalFormat := GL_RGB5_A1;
3117   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3118 {$ELSE}
3119   fOpenGLFormat     := tfRGB5A1us1;
3120 {$ENDIF}
3121 end;
3122
3123 procedure TfdRGBA8ui1.SetValues;
3124 begin
3125   inherited SetValues;
3126   fBitsPerPixel     := 32;
3127   fFormat           := tfRGBA8ui1;
3128   fWithAlpha        := tfRGBA8ui1;
3129   fWithoutAlpha     := tfRGBX8ui1;
3130   fRGBInverted      := tfBGRA8ui1;
3131   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3132   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3133 {$IFNDEF OPENGL_ES}
3134   fOpenGLFormat     := tfRGBA8ui1;
3135   fglFormat         := GL_RGBA;
3136   fglInternalFormat := GL_RGBA8;
3137   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3138 {$ELSE}
3139   fOpenGLFormat     := tfRGBA8ub4;
3140 {$ENDIF}
3141 end;
3142
3143 procedure TfdARGB8ui1.SetValues;
3144 begin
3145   inherited SetValues;
3146   fBitsPerPixel     := 32;
3147   fFormat           := tfARGB8ui1;
3148   fWithAlpha        := tfARGB8ui1;
3149   fWithoutAlpha     := tfXRGB8ui1;
3150   fRGBInverted      := tfABGR8ui1;
3151   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3152   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3153 {$IFNDEF OPENGL_ES}
3154   fOpenGLFormat     := tfARGB8ui1;
3155   fglFormat         := GL_BGRA;
3156   fglInternalFormat := GL_RGBA8;
3157   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3158 {$ELSE}
3159   fOpenGLFormat     := tfRGBA8ub4;
3160 {$ENDIF}
3161 end;
3162
3163 procedure TfdRGBA8ub4.SetValues;
3164 begin
3165   inherited SetValues;
3166   fBitsPerPixel     := 32;
3167   fFormat           := tfRGBA8ub4;
3168   fWithAlpha        := tfRGBA8ub4;
3169   fWithoutAlpha     := tfRGB8ub3;
3170   fOpenGLFormat     := tfRGBA8ub4;
3171   fRGBInverted      := tfBGRA8ub4;
3172   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3173   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3174   fglFormat         := GL_RGBA;
3175   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
3176   fglDataFormat     := GL_UNSIGNED_BYTE;
3177 end;
3178
3179 procedure TfdRGB10A2ui1.SetValues;
3180 begin
3181   inherited SetValues;
3182   fBitsPerPixel     := 32;
3183   fFormat           := tfRGB10A2ui1;
3184   fWithAlpha        := tfRGB10A2ui1;
3185   fWithoutAlpha     := tfRGB10X2ui1;
3186   fRGBInverted      := tfBGR10A2ui1;
3187   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3188   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3189 {$IFNDEF OPENGL_ES}
3190   fOpenGLFormat     := tfRGB10A2ui1;
3191   fglFormat         := GL_RGBA;
3192   fglInternalFormat := GL_RGB10_A2;
3193   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3194 {$ELSE}
3195   fOpenGLFormat     := tfA2RGB10ui1;
3196 {$ENDIF}
3197 end;
3198
3199 procedure TfdA2RGB10ui1.SetValues;
3200 begin
3201   inherited SetValues;
3202   fBitsPerPixel     := 32;
3203   fFormat           := tfA2RGB10ui1;
3204   fWithAlpha        := tfA2RGB10ui1;
3205   fWithoutAlpha     := tfX2RGB10ui1;
3206   fRGBInverted      := tfA2BGR10ui1;
3207   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3208   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3209 {$IF NOT DEFINED(OPENGL_ES)}
3210   fOpenGLFormat     := tfA2RGB10ui1;
3211   fglFormat         := GL_BGRA;
3212   fglInternalFormat := GL_RGB10_A2;
3213   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3214 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3215   fOpenGLFormat     := tfA2RGB10ui1;
3216   fglFormat         := GL_RGBA;
3217   fglInternalFormat := GL_RGB10_A2;
3218   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3219 {$ELSE}
3220   fOpenGLFormat     := tfRGBA8ui1;
3221 {$IFEND}
3222 end;
3223
3224 procedure TfdRGBA16us4.SetValues;
3225 begin
3226   inherited SetValues;
3227   fBitsPerPixel     := 64;
3228   fFormat           := tfRGBA16us4;
3229   fWithAlpha        := tfRGBA16us4;
3230   fWithoutAlpha     := tfRGB16us3;
3231   fRGBInverted      := tfBGRA16us4;
3232   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3233   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3234 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3235   fOpenGLFormat     := tfRGBA16us4;
3236   fglFormat         := GL_RGBA;
3237   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
3238   fglDataFormat     := GL_UNSIGNED_SHORT;
3239 {$ELSE}
3240   fOpenGLFormat     := tfRGBA8ub4;
3241 {$IFEND}
3242 end;
3243
3244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3245 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3247 procedure TfdBGRX4us1.SetValues;
3248 begin
3249   inherited SetValues;
3250   fBitsPerPixel     := 16;
3251   fFormat           := tfBGRX4us1;
3252   fWithAlpha        := tfBGRA4us1;
3253   fWithoutAlpha     := tfBGRX4us1;
3254   fRGBInverted      := tfRGBX4us1;
3255   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3256   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3257 {$IFNDEF OPENGL_ES}
3258   fOpenGLFormat     := tfBGRX4us1;
3259   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3260   fglInternalFormat := GL_RGB4;
3261   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3262 {$ELSE}
3263   fOpenGLFormat     := tfR5G6B5us1;
3264 {$ENDIF}
3265 end;
3266
3267 procedure TfdXBGR4us1.SetValues;
3268 begin
3269   inherited SetValues;
3270   fBitsPerPixel     := 16;
3271   fFormat           := tfXBGR4us1;
3272   fWithAlpha        := tfABGR4us1;
3273   fWithoutAlpha     := tfXBGR4us1;
3274   fRGBInverted      := tfXRGB4us1;
3275   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3276   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3277 {$IFNDEF OPENGL_ES}
3278   fOpenGLFormat     := tfXBGR4us1;
3279   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3280   fglInternalFormat := GL_RGB4;
3281   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3282 {$ELSE}
3283   fOpenGLFormat     := tfR5G6B5us1;
3284 {$ENDIF}
3285 end;
3286
3287 procedure TfdB5G6R5us1.SetValues;
3288 begin
3289   inherited SetValues;
3290   fBitsPerPixel     := 16;
3291   fFormat           := tfB5G6R5us1;
3292   fWithAlpha        := tfBGR5A1us1;
3293   fWithoutAlpha     := tfB5G6R5us1;
3294   fRGBInverted      := tfR5G6B5us1;
3295   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3296   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3297 {$IFNDEF OPENGL_ES}
3298   fOpenGLFormat     := tfB5G6R5us1;
3299   fglFormat         := GL_RGB;
3300   fglInternalFormat := GL_RGB565;
3301   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3302 {$ELSE}
3303   fOpenGLFormat     := tfR5G6B5us1;
3304 {$ENDIF}
3305 end;
3306
3307 procedure TfdBGR5X1us1.SetValues;
3308 begin
3309   inherited SetValues;
3310   fBitsPerPixel     := 16;
3311   fFormat           := tfBGR5X1us1;
3312   fWithAlpha        := tfBGR5A1us1;
3313   fWithoutAlpha     := tfBGR5X1us1;
3314   fRGBInverted      := tfRGB5X1us1;
3315   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3316   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3317 {$IFNDEF OPENGL_ES}
3318   fOpenGLFormat     := tfBGR5X1us1;
3319   fglFormat         := GL_BGRA;
3320   fglInternalFormat := GL_RGB5;
3321   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3322 {$ELSE}
3323   fOpenGLFormat     := tfR5G6B5us1;
3324 {$ENDIF}
3325 end;
3326
3327 procedure TfdX1BGR5us1.SetValues;
3328 begin
3329   inherited SetValues;
3330   fBitsPerPixel     := 16;
3331   fFormat           := tfX1BGR5us1;
3332   fWithAlpha        := tfA1BGR5us1;
3333   fWithoutAlpha     := tfX1BGR5us1;
3334   fRGBInverted      := tfX1RGB5us1;
3335   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3336   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3337 {$IFNDEF OPENGL_ES}
3338   fOpenGLFormat     := tfX1BGR5us1;
3339   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3340   fglInternalFormat := GL_RGB5;
3341   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3342 {$ELSE}
3343   fOpenGLFormat     := tfR5G6B5us1;
3344 {$ENDIF}
3345 end;
3346
3347 procedure TfdBGR8ub3.SetValues;
3348 begin
3349   inherited SetValues;
3350   fBitsPerPixel     := 24;
3351   fFormat           := tfBGR8ub3;
3352   fWithAlpha        := tfBGRA8ub4;
3353   fWithoutAlpha     := tfBGR8ub3;
3354   fRGBInverted      := tfRGB8ub3;
3355   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3356   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3357 {$IFNDEF OPENGL_ES}
3358   fOpenGLFormat     := tfBGR8ub3;
3359   fglFormat         := GL_BGR;
3360   fglInternalFormat := GL_RGB8;
3361   fglDataFormat     := GL_UNSIGNED_BYTE;
3362 {$ELSE}
3363   fOpenGLFormat     := tfRGB8ub3;
3364 {$ENDIF}
3365 end;
3366
3367 procedure TfdBGRX8ui1.SetValues;
3368 begin
3369   inherited SetValues;
3370   fBitsPerPixel     := 32;
3371   fFormat           := tfBGRX8ui1;
3372   fWithAlpha        := tfBGRA8ui1;
3373   fWithoutAlpha     := tfBGRX8ui1;
3374   fRGBInverted      := tfRGBX8ui1;
3375   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3376   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3377 {$IFNDEF OPENGL_ES}
3378   fOpenGLFormat     := tfBGRX8ui1;
3379   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3380   fglInternalFormat := GL_RGB8;
3381   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3382 {$ELSE}
3383   fOpenGLFormat     := tfRGB8ub3;
3384 {$ENDIF}
3385 end;
3386
3387 procedure TfdXBGR8ui1.SetValues;
3388 begin
3389   inherited SetValues;
3390   fBitsPerPixel     := 32;
3391   fFormat           := tfXBGR8ui1;
3392   fWithAlpha        := tfABGR8ui1;
3393   fWithoutAlpha     := tfXBGR8ui1;
3394   fRGBInverted      := tfXRGB8ui1;
3395   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3396   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3397 {$IFNDEF OPENGL_ES}
3398   fOpenGLFormat     := tfXBGR8ui1;
3399   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3400   fglInternalFormat := GL_RGB8;
3401   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3402 {$ELSE}
3403   fOpenGLFormat     := tfRGB8ub3;
3404 {$ENDIF}
3405 end;
3406
3407 procedure TfdBGR10X2ui1.SetValues;
3408 begin
3409   inherited SetValues;
3410   fBitsPerPixel     := 32;
3411   fFormat           := tfBGR10X2ui1;
3412   fWithAlpha        := tfBGR10A2ui1;
3413   fWithoutAlpha     := tfBGR10X2ui1;
3414   fRGBInverted      := tfRGB10X2ui1;
3415   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3416   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3417 {$IFNDEF OPENGL_ES}
3418   fOpenGLFormat     := tfBGR10X2ui1;
3419   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3420   fglInternalFormat := GL_RGB10;
3421   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3422 {$ELSE}
3423   fOpenGLFormat     := tfRGB16us3;
3424 {$ENDIF}
3425 end;
3426
3427 procedure TfdX2BGR10ui1.SetValues;
3428 begin
3429   inherited SetValues;
3430   fBitsPerPixel     := 32;
3431   fFormat           := tfX2BGR10ui1;
3432   fWithAlpha        := tfA2BGR10ui1;
3433   fWithoutAlpha     := tfX2BGR10ui1;
3434   fRGBInverted      := tfX2RGB10ui1;
3435   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3436   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3437 {$IFNDEF OPENGL_ES}
3438   fOpenGLFormat     := tfX2BGR10ui1;
3439   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3440   fglInternalFormat := GL_RGB10;
3441   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3442 {$ELSE}
3443   fOpenGLFormat     := tfRGB16us3;
3444 {$ENDIF}
3445 end;
3446
3447 procedure TfdBGR16us3.SetValues;
3448 begin
3449   inherited SetValues;
3450   fBitsPerPixel     := 48;
3451   fFormat           := tfBGR16us3;
3452   fWithAlpha        := tfBGRA16us4;
3453   fWithoutAlpha     := tfBGR16us3;
3454   fRGBInverted      := tfRGB16us3;
3455   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3456   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3457 {$IFNDEF OPENGL_ES}
3458   fOpenGLFormat     := tfBGR16us3;
3459   fglFormat         := GL_BGR;
3460   fglInternalFormat := GL_RGB16;
3461   fglDataFormat     := GL_UNSIGNED_SHORT;
3462 {$ELSE}
3463   fOpenGLFormat     := tfRGB16us3;
3464 {$ENDIF}
3465 end;
3466
3467 procedure TfdBGRA4us1.SetValues;
3468 begin
3469   inherited SetValues;
3470   fBitsPerPixel     := 16;
3471   fFormat           := tfBGRA4us1;
3472   fWithAlpha        := tfBGRA4us1;
3473   fWithoutAlpha     := tfBGRX4us1;
3474   fRGBInverted      := tfRGBA4us1;
3475   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3476   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3477 {$IFNDEF OPENGL_ES}
3478   fOpenGLFormat     := tfBGRA4us1;
3479   fglFormat         := GL_BGRA;
3480   fglInternalFormat := GL_RGBA4;
3481   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3482 {$ELSE}
3483   fOpenGLFormat     := tfRGBA4us1;
3484 {$ENDIF}
3485 end;
3486
3487 procedure TfdABGR4us1.SetValues;
3488 begin
3489   inherited SetValues;
3490   fBitsPerPixel     := 16;
3491   fFormat           := tfABGR4us1;
3492   fWithAlpha        := tfABGR4us1;
3493   fWithoutAlpha     := tfXBGR4us1;
3494   fRGBInverted      := tfARGB4us1;
3495   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3496   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3497 {$IFNDEF OPENGL_ES}
3498   fOpenGLFormat     := tfABGR4us1;
3499   fglFormat         := GL_RGBA;
3500   fglInternalFormat := GL_RGBA4;
3501   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3502 {$ELSE}
3503   fOpenGLFormat     := tfRGBA4us1;
3504 {$ENDIF}
3505 end;
3506
3507 procedure TfdBGR5A1us1.SetValues;
3508 begin
3509   inherited SetValues;
3510   fBitsPerPixel     := 16;
3511   fFormat           := tfBGR5A1us1;
3512   fWithAlpha        := tfBGR5A1us1;
3513   fWithoutAlpha     := tfBGR5X1us1;
3514   fRGBInverted      := tfRGB5A1us1;
3515   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3516   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3517 {$IFNDEF OPENGL_ES}
3518   fOpenGLFormat     := tfBGR5A1us1;
3519   fglFormat         := GL_BGRA;
3520   fglInternalFormat := GL_RGB5_A1;
3521   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3522 {$ELSE}
3523   fOpenGLFormat     := tfRGB5A1us1;
3524 {$ENDIF}
3525 end;
3526
3527 procedure TfdA1BGR5us1.SetValues;
3528 begin
3529   inherited SetValues;
3530   fBitsPerPixel     := 16;
3531   fFormat           := tfA1BGR5us1;
3532   fWithAlpha        := tfA1BGR5us1;
3533   fWithoutAlpha     := tfX1BGR5us1;
3534   fRGBInverted      := tfA1RGB5us1;
3535   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3536   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3537 {$IFNDEF OPENGL_ES}
3538   fOpenGLFormat     := tfA1BGR5us1;
3539   fglFormat         := GL_RGBA;
3540   fglInternalFormat := GL_RGB5_A1;
3541   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3542 {$ELSE}
3543   fOpenGLFormat     := tfRGB5A1us1;
3544 {$ENDIF}
3545 end;
3546
3547 procedure TfdBGRA8ui1.SetValues;
3548 begin
3549   inherited SetValues;
3550   fBitsPerPixel     := 32;
3551   fFormat           := tfBGRA8ui1;
3552   fWithAlpha        := tfBGRA8ui1;
3553   fWithoutAlpha     := tfBGRX8ui1;
3554   fRGBInverted      := tfRGBA8ui1;
3555   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3556   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3557 {$IFNDEF OPENGL_ES}
3558   fOpenGLFormat     := tfBGRA8ui1;
3559   fglFormat         := GL_BGRA;
3560   fglInternalFormat := GL_RGBA8;
3561   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3562 {$ELSE}
3563   fOpenGLFormat     := tfRGBA8ub4;
3564 {$ENDIF}
3565 end;
3566
3567 procedure TfdABGR8ui1.SetValues;
3568 begin
3569   inherited SetValues;
3570   fBitsPerPixel     := 32;
3571   fFormat           := tfABGR8ui1;
3572   fWithAlpha        := tfABGR8ui1;
3573   fWithoutAlpha     := tfXBGR8ui1;
3574   fRGBInverted      := tfARGB8ui1;
3575   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3576   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3577 {$IFNDEF OPENGL_ES}
3578   fOpenGLFormat     := tfABGR8ui1;
3579   fglFormat         := GL_RGBA;
3580   fglInternalFormat := GL_RGBA8;
3581   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3582 {$ELSE}
3583   fOpenGLFormat     := tfRGBA8ub4
3584 {$ENDIF}
3585 end;
3586
3587 procedure TfdBGRA8ub4.SetValues;
3588 begin
3589   inherited SetValues;
3590   fBitsPerPixel     := 32;
3591   fFormat           := tfBGRA8ub4;
3592   fWithAlpha        := tfBGRA8ub4;
3593   fWithoutAlpha     := tfBGR8ub3;
3594   fRGBInverted      := tfRGBA8ub4;
3595   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3596   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3597 {$IFNDEF OPENGL_ES}
3598   fOpenGLFormat     := tfBGRA8ub4;
3599   fglFormat         := GL_BGRA;
3600   fglInternalFormat := GL_RGBA8;
3601   fglDataFormat     := GL_UNSIGNED_BYTE;
3602 {$ELSE}
3603   fOpenGLFormat     := tfRGBA8ub4;
3604 {$ENDIF}
3605 end;
3606
3607 procedure TfdBGR10A2ui1.SetValues;
3608 begin
3609   inherited SetValues;
3610   fBitsPerPixel     := 32;
3611   fFormat           := tfBGR10A2ui1;
3612   fWithAlpha        := tfBGR10A2ui1;
3613   fWithoutAlpha     := tfBGR10X2ui1;
3614   fRGBInverted      := tfRGB10A2ui1;
3615   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3616   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3617 {$IFNDEF OPENGL_ES}
3618   fOpenGLFormat     := tfBGR10A2ui1;
3619   fglFormat         := GL_BGRA;
3620   fglInternalFormat := GL_RGB10_A2;
3621   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3622 {$ELSE}
3623   fOpenGLFormat     := tfA2RGB10ui1;
3624 {$ENDIF}
3625 end;
3626
3627 procedure TfdA2BGR10ui1.SetValues;
3628 begin
3629   inherited SetValues;
3630   fBitsPerPixel     := 32;
3631   fFormat           := tfA2BGR10ui1;
3632   fWithAlpha        := tfA2BGR10ui1;
3633   fWithoutAlpha     := tfX2BGR10ui1;
3634   fRGBInverted      := tfA2RGB10ui1;
3635   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3636   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3637 {$IFNDEF OPENGL_ES}
3638   fOpenGLFormat     := tfA2BGR10ui1;
3639   fglFormat         := GL_RGBA;
3640   fglInternalFormat := GL_RGB10_A2;
3641   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3642 {$ELSE}
3643   fOpenGLFormat     := tfA2RGB10ui1;
3644 {$ENDIF}
3645 end;
3646
3647 procedure TfdBGRA16us4.SetValues;
3648 begin
3649   inherited SetValues;
3650   fBitsPerPixel     := 64;
3651   fFormat           := tfBGRA16us4;
3652   fWithAlpha        := tfBGRA16us4;
3653   fWithoutAlpha     := tfBGR16us3;
3654   fRGBInverted      := tfRGBA16us4;
3655   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3656   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3657 {$IFNDEF OPENGL_ES}
3658   fOpenGLFormat     := tfBGRA16us4;
3659   fglFormat         := GL_BGRA;
3660   fglInternalFormat := GL_RGBA16;
3661   fglDataFormat     := GL_UNSIGNED_SHORT;
3662 {$ELSE}
3663   fOpenGLFormat     := tfRGBA16us4;
3664 {$ENDIF}
3665 end;
3666
3667 procedure TfdDepth16us1.SetValues;
3668 begin
3669   inherited SetValues;
3670   fBitsPerPixel     := 16;
3671   fFormat           := tfDepth16us1;
3672   fWithoutAlpha     := tfDepth16us1;
3673   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3674   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3675 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
3676   fOpenGLFormat     := tfDepth16us1;
3677   fglFormat         := GL_DEPTH_COMPONENT;
3678   fglInternalFormat := GL_DEPTH_COMPONENT16;
3679   fglDataFormat     := GL_UNSIGNED_SHORT;
3680 {$IFEND}
3681 end;
3682
3683 procedure TfdDepth24ui1.SetValues;
3684 begin
3685   inherited SetValues;
3686   fBitsPerPixel     := 32;
3687   fFormat           := tfDepth24ui1;
3688   fWithoutAlpha     := tfDepth24ui1;
3689   fOpenGLFormat     := tfDepth24ui1;
3690   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3691   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3692 {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
3693   fOpenGLFormat     := tfDepth24ui1;
3694   fglFormat         := GL_DEPTH_COMPONENT;
3695   fglInternalFormat := GL_DEPTH_COMPONENT24;
3696   fglDataFormat     := GL_UNSIGNED_INT;
3697 {$IFEND}
3698 end;
3699
3700 procedure TfdDepth32ui1.SetValues;
3701 begin
3702   inherited SetValues;
3703   fBitsPerPixel     := 32;
3704   fFormat           := tfDepth32ui1;
3705   fWithoutAlpha     := tfDepth32ui1;
3706   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3707   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3708 {$IF NOT DEFINED(OPENGL_ES)}
3709   fOpenGLFormat     := tfDepth32ui1;
3710   fglFormat         := GL_DEPTH_COMPONENT;
3711   fglInternalFormat := GL_DEPTH_COMPONENT32;
3712   fglDataFormat     := GL_UNSIGNED_INT;
3713 {$ELSEIF DEFINED(OPENGL_ES_3_0)}
3714   fOpenGLFormat     := tfDepth24ui1;
3715 {$ELSEIF DEFINED(OPENGL_ES_2_0)}
3716   fOpenGLFormat     := tfDepth16us1;
3717 {$IFEND}
3718 end;
3719
3720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3721 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3724 begin
3725   raise EglBitmap.Create('mapping for compressed formats is not supported');
3726 end;
3727
3728 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3729 begin
3730   raise EglBitmap.Create('mapping for compressed formats is not supported');
3731 end;
3732
3733 procedure TfdS3tcDtx1RGBA.SetValues;
3734 begin
3735   inherited SetValues;
3736   fFormat           := tfS3tcDtx1RGBA;
3737   fWithAlpha        := tfS3tcDtx1RGBA;
3738   fUncompressed     := tfRGB5A1us1;
3739   fBitsPerPixel     := 4;
3740   fIsCompressed     := true;
3741 {$IFNDEF OPENGL_ES}
3742   fOpenGLFormat     := tfS3tcDtx1RGBA;
3743   fglFormat         := GL_COMPRESSED_RGBA;
3744   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3745   fglDataFormat     := GL_UNSIGNED_BYTE;
3746 {$ELSE}
3747   fOpenGLFormat     := fUncompressed;
3748 {$ENDIF}
3749 end;
3750
3751 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3752 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3755 begin
3756   raise EglBitmap.Create('mapping for compressed formats is not supported');
3757 end;
3758
3759 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3760 begin
3761   raise EglBitmap.Create('mapping for compressed formats is not supported');
3762 end;
3763
3764 procedure TfdS3tcDtx3RGBA.SetValues;
3765 begin
3766   inherited SetValues;
3767   fFormat           := tfS3tcDtx3RGBA;
3768   fWithAlpha        := tfS3tcDtx3RGBA;
3769   fUncompressed     := tfRGBA8ub4;
3770   fBitsPerPixel     := 8;
3771   fIsCompressed     := true;
3772 {$IFNDEF OPENGL_ES}
3773   fOpenGLFormat     := tfS3tcDtx3RGBA;
3774   fglFormat         := GL_COMPRESSED_RGBA;
3775   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3776   fglDataFormat     := GL_UNSIGNED_BYTE;
3777 {$ELSE}
3778   fOpenGLFormat     := fUncompressed;
3779 {$ENDIF}
3780 end;
3781
3782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3784 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3785 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3786 begin
3787   raise EglBitmap.Create('mapping for compressed formats is not supported');
3788 end;
3789
3790 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3791 begin
3792   raise EglBitmap.Create('mapping for compressed formats is not supported');
3793 end;
3794
3795 procedure TfdS3tcDtx5RGBA.SetValues;
3796 begin
3797   inherited SetValues;
3798   fFormat           := tfS3tcDtx3RGBA;
3799   fWithAlpha        := tfS3tcDtx3RGBA;
3800   fUncompressed     := tfRGBA8ub4;
3801   fBitsPerPixel     := 8;
3802   fIsCompressed     := true;
3803 {$IFNDEF OPENGL_ES}
3804   fOpenGLFormat     := tfS3tcDtx3RGBA;
3805   fglFormat         := GL_COMPRESSED_RGBA;
3806   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3807   fglDataFormat     := GL_UNSIGNED_BYTE;
3808 {$ELSE}
3809   fOpenGLFormat     := fUncompressed;
3810 {$ENDIF}
3811 end;
3812
3813 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3814 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3816 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3817 begin
3818   result := (fPrecision.r > 0);
3819 end;
3820
3821 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3822 begin
3823   result := (fPrecision.g > 0);
3824 end;
3825
3826 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3827 begin
3828   result := (fPrecision.b > 0);
3829 end;
3830
3831 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3832 begin
3833   result := (fPrecision.a > 0);
3834 end;
3835
3836 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3837 begin
3838   result := HasRed or HasGreen or HasBlue;
3839 end;
3840
3841 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3842 begin
3843   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3844 end;
3845
3846 function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
3847 begin
3848   result := (OpenGLFormat = Format);
3849 end;
3850
3851 procedure TglBitmapFormatDescriptor.SetValues;
3852 begin
3853   fFormat       := tfEmpty;
3854   fWithAlpha    := tfEmpty;
3855   fWithoutAlpha := tfEmpty;
3856   fOpenGLFormat := tfEmpty;
3857   fRGBInverted  := tfEmpty;
3858   fUncompressed := tfEmpty;
3859
3860   fBitsPerPixel := 0;
3861   fIsCompressed := false;
3862
3863   fglFormat         := 0;
3864   fglInternalFormat := 0;
3865   fglDataFormat     := 0;
3866
3867   FillChar(fPrecision, 0, SizeOf(fPrecision));
3868   FillChar(fShift,     0, SizeOf(fShift));
3869 end;
3870
3871 procedure TglBitmapFormatDescriptor.CalcValues;
3872 var
3873   i: Integer;
3874 begin
3875   fBytesPerPixel := fBitsPerPixel / 8;
3876   fChannelCount  := 0;
3877   for i := 0 to 3 do begin
3878     if (fPrecision.arr[i] > 0) then
3879       inc(fChannelCount);
3880     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3881     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3882   end;
3883 end;
3884
3885 function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
3886 var
3887   w, h: Integer;
3888 begin
3889   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
3890     w := Max(1, aSize.X);
3891     h := Max(1, aSize.Y);
3892     result := GetSize(w, h);
3893   end else
3894     result := 0;
3895 end;
3896
3897 function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
3898 begin
3899   result := 0;
3900   if (aWidth <= 0) or (aHeight <= 0) then
3901     exit;
3902   result := Ceil(aWidth * aHeight * BytesPerPixel);
3903 end;
3904
3905 constructor TglBitmapFormatDescriptor.Create;
3906 begin
3907   inherited Create;
3908   SetValues;
3909   CalcValues;
3910 end;
3911
3912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3913 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3914 var
3915   f: TglBitmapFormat;
3916 begin
3917   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3918     result := TFormatDescriptor.Get(f);
3919     if (result.glInternalFormat = aInternalFormat) then
3920       exit;
3921   end;
3922   result := TFormatDescriptor.Get(tfEmpty);
3923 end;
3924
3925 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3926 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3927 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3928 class procedure TFormatDescriptor.Init;
3929 begin
3930   if not Assigned(FormatDescriptorCS) then
3931     FormatDescriptorCS := TCriticalSection.Create;
3932 end;
3933
3934 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3935 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3936 begin
3937   FormatDescriptorCS.Enter;
3938   try
3939     result := FormatDescriptors[aFormat];
3940     if not Assigned(result) then begin
3941       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3942       FormatDescriptors[aFormat] := result;
3943     end;
3944   finally
3945     FormatDescriptorCS.Leave;
3946   end;
3947 end;
3948
3949 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3950 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3951 begin
3952   result := Get(Get(aFormat).WithAlpha);
3953 end;
3954
3955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
3957 var
3958   ft: TglBitmapFormat;
3959 begin
3960   // find matching format with OpenGL support
3961   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3962     result := Get(ft);
3963     if (result.MaskMatch(aMask))      and
3964        (result.glFormat <> 0)         and
3965        (result.glInternalFormat <> 0) and
3966        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3967     then
3968       exit;
3969   end;
3970
3971   // find matching format without OpenGL Support
3972   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3973     result := Get(ft);
3974     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
3975       exit;
3976   end;
3977
3978   result := TFormatDescriptor.Get(tfEmpty);
3979 end;
3980
3981 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3982 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
3983 var
3984   ft: TglBitmapFormat;
3985 begin
3986   // find matching format with OpenGL support
3987   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
3988     result := Get(ft);
3989     if glBitmapRec4ubCompare(result.Shift,     aShift) and
3990        glBitmapRec4ubCompare(result.Precision, aPrec) and
3991        (result.glFormat <> 0)         and
3992        (result.glInternalFormat <> 0) and
3993        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
3994     then
3995       exit;
3996   end;
3997
3998   // find matching format without OpenGL Support
3999   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4000     result := Get(ft);
4001     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4002        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4003        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4004       exit;
4005   end;
4006
4007   result := TFormatDescriptor.Get(tfEmpty);
4008 end;
4009
4010 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4011 class procedure TFormatDescriptor.Clear;
4012 var
4013   f: TglBitmapFormat;
4014 begin
4015   FormatDescriptorCS.Enter;
4016   try
4017     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4018       FreeAndNil(FormatDescriptors[f]);
4019   finally
4020     FormatDescriptorCS.Leave;
4021   end;
4022 end;
4023
4024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4025 class procedure TFormatDescriptor.Finalize;
4026 begin
4027   Clear;
4028   FreeAndNil(FormatDescriptorCS);
4029 end;
4030
4031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4032 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4034 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4035 var
4036   i: Integer;
4037 begin
4038   for i := 0 to 3 do begin
4039     fShift.arr[i] := 0;
4040     while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
4041       aMask.arr[i] := aMask.arr[i] shr 1;
4042       inc(fShift.arr[i]);
4043     end;
4044     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4045   end;
4046   fBitsPerPixel := aBPP;
4047   CalcValues;
4048 end;
4049
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4052 begin
4053   fBitsPerPixel := aBBP;
4054   fPrecision    := aPrec;
4055   fShift        := aShift;
4056   CalcValues;
4057 end;
4058
4059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4060 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4061 var
4062   data: QWord;
4063 begin
4064   data :=
4065     ((aPixel.Data.r and Range.r) shl Shift.r) or
4066     ((aPixel.Data.g and Range.g) shl Shift.g) or
4067     ((aPixel.Data.b and Range.b) shl Shift.b) or
4068     ((aPixel.Data.a and Range.a) shl Shift.a);
4069   case BitsPerPixel of
4070     8:           aData^  := data;
4071    16:     PWord(aData)^ := data;
4072    32: PCardinal(aData)^ := data;
4073    64:    PQWord(aData)^ := data;
4074   else
4075     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4076   end;
4077   inc(aData, Round(BytesPerPixel));
4078 end;
4079
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4082 var
4083   data: QWord;
4084   i: Integer;
4085 begin
4086   case BitsPerPixel of
4087      8: data :=           aData^;
4088     16: data :=     PWord(aData)^;
4089     32: data := PCardinal(aData)^;
4090     64: data :=    PQWord(aData)^;
4091   else
4092     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4093   end;
4094   for i := 0 to 3 do
4095     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4096   inc(aData, Round(BytesPerPixel));
4097 end;
4098
4099 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4100 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure TbmpColorTableFormat.SetValues;
4103 begin
4104   inherited SetValues;
4105   fShift := glBitmapRec4ub(8, 8, 8, 0);
4106 end;
4107
4108 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4109 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4110 begin
4111   fFormat       := aFormat;
4112   fBitsPerPixel := aBPP;
4113   fPrecision    := aPrec;
4114   fShift        := aShift;
4115   CalcValues;
4116 end;
4117
4118 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4119 procedure TbmpColorTableFormat.CalcValues;
4120 begin
4121   inherited CalcValues;
4122 end;
4123
4124 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4125 procedure TbmpColorTableFormat.CreateColorTable;
4126 var
4127   i: Integer;
4128 begin
4129   SetLength(fColorTable, 256);
4130   if not HasColor then begin
4131     // alpha
4132     for i := 0 to High(fColorTable) do begin
4133       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4134       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4135       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4136       fColorTable[i].a := 0;
4137     end;
4138   end else begin
4139     // normal
4140     for i := 0 to High(fColorTable) do begin
4141       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4142       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4143       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4144       fColorTable[i].a := 0;
4145     end;
4146   end;
4147 end;
4148
4149 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4150 function TbmpColorTableFormat.CreateMappingData: Pointer;
4151 begin
4152   result := Pointer(0);
4153 end;
4154
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4157 begin
4158   if (BitsPerPixel <> 8) then
4159     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4160   if not HasColor then
4161     // alpha
4162     aData^ := aPixel.Data.a
4163   else
4164     // normal
4165     aData^ := Round(
4166       ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
4167       ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
4168       ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
4169   inc(aData);
4170 end;
4171
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4174
4175   function ReadValue: Byte;
4176   var
4177     i: PtrUInt;
4178   begin
4179     if (BitsPerPixel = 8) then begin
4180       result := aData^;
4181       inc(aData);
4182     end else begin
4183       i := {%H-}PtrUInt(aMapData);
4184       if (BitsPerPixel > 1) then
4185         result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
4186       else
4187         result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
4188       inc(i, BitsPerPixel);
4189       while (i >= 8) do begin
4190         inc(aData);
4191         dec(i, 8);
4192       end;
4193       aMapData := {%H-}Pointer(i);
4194     end;
4195   end;
4196
4197 begin
4198   if (BitsPerPixel > 8) then
4199     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4200   with fColorTable[ReadValue] do begin
4201     aPixel.Data.r := r;
4202     aPixel.Data.g := g;
4203     aPixel.Data.b := b;
4204     aPixel.Data.a := a;
4205   end;
4206 end;
4207
4208 destructor TbmpColorTableFormat.Destroy;
4209 begin
4210   SetLength(fColorTable, 0);
4211   inherited Destroy;
4212 end;
4213
4214 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4215 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4217 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4218 var
4219   i: Integer;
4220 begin
4221   for i := 0 to 3 do begin
4222     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4223       if (aSourceFD.Range.arr[i] > 0) then
4224         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4225       else
4226         aPixel.Data.arr[i] := 0;
4227     end;
4228   end;
4229 end;
4230
4231 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4232 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4233 begin
4234   with aFuncRec do begin
4235     if (Source.Range.r   > 0) then
4236       Dest.Data.r := Source.Data.r;
4237     if (Source.Range.g > 0) then
4238       Dest.Data.g := Source.Data.g;
4239     if (Source.Range.b  > 0) then
4240       Dest.Data.b := Source.Data.b;
4241     if (Source.Range.a > 0) then
4242       Dest.Data.a := Source.Data.a;
4243   end;
4244 end;
4245
4246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4247 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4248 var
4249   i: Integer;
4250 begin
4251   with aFuncRec do begin
4252     for i := 0 to 3 do
4253       if (Source.Range.arr[i] > 0) then
4254         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4255   end;
4256 end;
4257
4258 type
4259   TShiftData = packed record
4260     case Integer of
4261       0: (r, g, b, a: SmallInt);
4262       1: (arr: array[0..3] of SmallInt);
4263   end;
4264   PShiftData = ^TShiftData;
4265
4266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4267 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4268 var
4269   i: Integer;
4270 begin
4271   with aFuncRec do
4272     for i := 0 to 3 do
4273       if (Source.Range.arr[i] > 0) then
4274         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4275 end;
4276
4277 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4278 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4279 var
4280   i: Integer;
4281 begin
4282   with aFuncRec do begin
4283     Dest.Data := Source.Data;
4284     for i := 0 to 3 do
4285       if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
4286         Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
4287   end;
4288 end;
4289
4290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4291 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4292 var
4293   i: Integer;
4294 begin
4295   with aFuncRec do begin
4296     for i := 0 to 3 do
4297       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4298   end;
4299 end;
4300
4301 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4302 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4303 var
4304   Temp: Single;
4305 begin
4306   with FuncRec do begin
4307     if (FuncRec.Args = nil) then begin //source has no alpha
4308       Temp :=
4309         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4310         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4311         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4312       Dest.Data.a := Round(Dest.Range.a * Temp);
4313     end else
4314       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4315   end;
4316 end;
4317
4318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4319 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4320 type
4321   PglBitmapPixelData = ^TglBitmapPixelData;
4322 begin
4323   with FuncRec do begin
4324     Dest.Data.r := Source.Data.r;
4325     Dest.Data.g := Source.Data.g;
4326     Dest.Data.b := Source.Data.b;
4327
4328     with PglBitmapPixelData(Args)^ do
4329       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4330           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4331           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4332         Dest.Data.a := 0
4333       else
4334         Dest.Data.a := Dest.Range.a;
4335   end;
4336 end;
4337
4338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4339 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4340 begin
4341   with FuncRec do begin
4342     Dest.Data.r := Source.Data.r;
4343     Dest.Data.g := Source.Data.g;
4344     Dest.Data.b := Source.Data.b;
4345     Dest.Data.a := PCardinal(Args)^;
4346   end;
4347 end;
4348
4349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4350 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4351 type
4352   PRGBPix = ^TRGBPix;
4353   TRGBPix = array [0..2] of byte;
4354 var
4355   Temp: Byte;
4356 begin
4357   while aWidth > 0 do begin
4358     Temp := PRGBPix(aData)^[0];
4359     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4360     PRGBPix(aData)^[2] := Temp;
4361
4362     if aHasAlpha then
4363       Inc(aData, 4)
4364     else
4365       Inc(aData, 3);
4366     dec(aWidth);
4367   end;
4368 end;
4369
4370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4371 //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4372 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4373 function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
4374 begin
4375   result := TFormatDescriptor.Get(fFormat);
4376 end;
4377
4378 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4379 function TglBitmapData.GetWidth: Integer;
4380 begin
4381   if (ffX in fDimension.Fields) then
4382     result := fDimension.X
4383   else
4384     result := -1;
4385 end;
4386
4387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4388 function TglBitmapData.GetHeight: Integer;
4389 begin
4390   if (ffY in fDimension.Fields) then
4391     result := fDimension.Y
4392   else
4393     result := -1;
4394 end;
4395
4396 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4397 function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
4398 begin
4399   if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
4400     result := fScanlines[aIndex]
4401   else
4402     result := nil;
4403 end;
4404
4405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4406 procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
4407 begin
4408   if fFormat = aValue then
4409     exit;
4410   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4411     raise EglBitmapUnsupportedFormat.Create(Format);
4412   SetData(fData, aValue, Width, Height);
4413 end;
4414
4415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4416 procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
4417 var
4418   TempPos: Integer;
4419 begin
4420   if not Assigned(aResType) then begin
4421     TempPos   := Pos('.', aResource);
4422     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4423     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4424   end;
4425 end;
4426
4427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4428 procedure TglBitmapData.UpdateScanlines;
4429 var
4430   w, h, i, LineWidth: Integer;
4431 begin
4432   w := Width;
4433   h := Height;
4434   fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
4435   if fHasScanlines then begin
4436     SetLength(fScanlines, h);
4437     LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
4438     for i := 0 to h-1 do begin
4439       fScanlines[i] := fData;
4440       Inc(fScanlines[i], i * LineWidth);
4441     end;
4442   end else
4443     SetLength(fScanlines, 0);
4444 end;
4445
4446 {$IFDEF GLB_SUPPORT_PNG_READ}
4447 {$IF DEFINED(GLB_LAZ_PNG)}
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4451 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4452 const
4453   MAGIC_LEN = 8;
4454   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
4455 var
4456   reader: TLazReaderPNG;
4457   intf: TLazIntfImage;
4458   StreamPos: Int64;
4459   magic: String[MAGIC_LEN];
4460 begin
4461   result := true;
4462   StreamPos := aStream.Position;
4463
4464   SetLength(magic, MAGIC_LEN);
4465   aStream.Read(magic[1], MAGIC_LEN);
4466   aStream.Position := StreamPos;
4467   if (magic <> PNG_MAGIC) then begin
4468     result := false;
4469     exit;
4470   end;
4471
4472   intf   := TLazIntfImage.Create(0, 0);
4473   reader := TLazReaderPNG.Create;
4474   try try
4475     reader.UpdateDescription := true;
4476     reader.ImageRead(aStream, intf);
4477     AssignFromLazIntfImage(intf);
4478   except
4479     result := false;
4480     aStream.Position := StreamPos;
4481     exit;
4482   end;
4483   finally
4484     reader.Free;
4485     intf.Free;
4486   end;
4487 end;
4488
4489 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
4490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4491 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4492 var
4493   Surface: PSDL_Surface;
4494   RWops: PSDL_RWops;
4495 begin
4496   result := false;
4497   RWops := glBitmapCreateRWops(aStream);
4498   try
4499     if IMG_isPNG(RWops) > 0 then begin
4500       Surface := IMG_LoadPNG_RW(RWops);
4501       try
4502         AssignFromSurface(Surface);
4503         result := true;
4504       finally
4505         SDL_FreeSurface(Surface);
4506       end;
4507     end;
4508   finally
4509     SDL_FreeRW(RWops);
4510   end;
4511 end;
4512
4513 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4515 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4516 begin
4517   TStream(png_get_io_ptr(png)).Read(buffer^, size);
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4522 var
4523   StreamPos: Int64;
4524   signature: array [0..7] of byte;
4525   png: png_structp;
4526   png_info: png_infop;
4527
4528   TempHeight, TempWidth: Integer;
4529   Format: TglBitmapFormat;
4530
4531   png_data: pByte;
4532   png_rows: array of pByte;
4533   Row, LineSize: Integer;
4534 begin
4535   result := false;
4536
4537   if not init_libPNG then
4538     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
4539
4540   try
4541     // signature
4542     StreamPos := aStream.Position;
4543     aStream.Read(signature{%H-}, 8);
4544     aStream.Position := StreamPos;
4545
4546     if png_check_sig(@signature, 8) <> 0 then begin
4547       // png read struct
4548       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4549       if png = nil then
4550         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
4551
4552       // png info
4553       png_info := png_create_info_struct(png);
4554       if png_info = nil then begin
4555         png_destroy_read_struct(@png, nil, nil);
4556         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
4557       end;
4558
4559       // set read callback
4560       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
4561
4562       // read informations
4563       png_read_info(png, png_info);
4564
4565       // size
4566       TempHeight := png_get_image_height(png, png_info);
4567       TempWidth := png_get_image_width(png, png_info);
4568
4569       // format
4570       case png_get_color_type(png, png_info) of
4571         PNG_COLOR_TYPE_GRAY:
4572           Format := tfLuminance8ub1;
4573         PNG_COLOR_TYPE_GRAY_ALPHA:
4574           Format := tfLuminance8Alpha8us1;
4575         PNG_COLOR_TYPE_RGB:
4576           Format := tfRGB8ub3;
4577         PNG_COLOR_TYPE_RGB_ALPHA:
4578           Format := tfRGBA8ub4;
4579         else
4580           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4581       end;
4582
4583       // cut upper 8 bit from 16 bit formats
4584       if png_get_bit_depth(png, png_info) > 8 then
4585         png_set_strip_16(png);
4586
4587       // expand bitdepth smaller than 8
4588       if png_get_bit_depth(png, png_info) < 8 then
4589         png_set_expand(png);
4590
4591       // allocating mem for scanlines
4592       LineSize := png_get_rowbytes(png, png_info);
4593       GetMem(png_data, TempHeight * LineSize);
4594       try
4595         SetLength(png_rows, TempHeight);
4596         for Row := Low(png_rows) to High(png_rows) do begin
4597           png_rows[Row] := png_data;
4598           Inc(png_rows[Row], Row * LineSize);
4599         end;
4600
4601         // read complete image into scanlines
4602         png_read_image(png, @png_rows[0]);
4603
4604         // read end
4605         png_read_end(png, png_info);
4606
4607         // destroy read struct
4608         png_destroy_read_struct(@png, @png_info, nil);
4609
4610         SetLength(png_rows, 0);
4611
4612         // set new data
4613         SetData(png_data, Format, TempWidth, TempHeight);
4614
4615         result := true;
4616       except
4617         if Assigned(png_data) then
4618           FreeMem(png_data);
4619         raise;
4620       end;
4621     end;
4622   finally
4623     quit_libPNG;
4624   end;
4625 end;
4626
4627 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4629 function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
4630 var
4631   StreamPos: Int64;
4632   Png: TPNGObject;
4633   Header: String[8];
4634   Row, Col, PixSize, LineSize: Integer;
4635   NewImage, pSource, pDest, pAlpha: pByte;
4636   PngFormat: TglBitmapFormat;
4637   FormatDesc: TFormatDescriptor;
4638
4639 const
4640   PngHeader: String[8] = #137#80#78#71#13#10#26#10;
4641
4642 begin
4643   result := false;
4644
4645   StreamPos := aStream.Position;
4646   aStream.Read(Header[0], SizeOf(Header));
4647   aStream.Position := StreamPos;
4648
4649   {Test if the header matches}
4650   if Header = PngHeader then begin
4651     Png := TPNGObject.Create;
4652     try
4653       Png.LoadFromStream(aStream);
4654
4655       case Png.Header.ColorType of
4656         COLOR_GRAYSCALE:
4657           PngFormat := tfLuminance8ub1;
4658         COLOR_GRAYSCALEALPHA:
4659           PngFormat := tfLuminance8Alpha8us1;
4660         COLOR_RGB:
4661           PngFormat := tfBGR8ub3;
4662         COLOR_RGBALPHA:
4663           PngFormat := tfBGRA8ub4;
4664         else
4665           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4666       end;
4667
4668       FormatDesc := TFormatDescriptor.Get(PngFormat);
4669       PixSize    := Round(FormatDesc.PixelSize);
4670       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);
4671
4672       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
4673       try
4674         pDest := NewImage;
4675
4676         case Png.Header.ColorType of
4677           COLOR_RGB, COLOR_GRAYSCALE:
4678             begin
4679               for Row := 0 to Png.Height -1 do begin
4680                 Move (Png.Scanline[Row]^, pDest^, LineSize);
4681                 Inc(pDest, LineSize);
4682               end;
4683             end;
4684           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
4685             begin
4686               PixSize := PixSize -1;
4687
4688               for Row := 0 to Png.Height -1 do begin
4689                 pSource := Png.Scanline[Row];
4690                 pAlpha := pByte(Png.AlphaScanline[Row]);
4691
4692                 for Col := 0 to Png.Width -1 do begin
4693                   Move (pSource^, pDest^, PixSize);
4694                   Inc(pSource, PixSize);
4695                   Inc(pDest, PixSize);
4696
4697                   pDest^ := pAlpha^;
4698                   inc(pAlpha);
4699                   Inc(pDest);
4700                 end;
4701               end;
4702             end;
4703           else
4704             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
4705         end;
4706
4707         SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
4708
4709         result := true;
4710       except
4711         if Assigned(NewImage) then
4712           FreeMem(NewImage);
4713         raise;
4714       end;
4715     finally
4716       Png.Free;
4717     end;
4718   end;
4719 end;
4720 {$IFEND}
4721 {$ENDIF}
4722
4723 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4724 {$IFDEF GLB_LIB_PNG}
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4727 begin
4728   TStream(png_get_io_ptr(png)).Write(buffer^, size);
4729 end;
4730 {$ENDIF}
4731
4732 {$IF DEFINED(GLB_LAZ_PNG)}
4733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4734 procedure TglBitmapData.SavePNG(const aStream: TStream);
4735 var
4736   png: TPortableNetworkGraphic;
4737   intf: TLazIntfImage;
4738   raw: TRawImage;
4739 begin
4740   png  := TPortableNetworkGraphic.Create;
4741   intf := TLazIntfImage.Create(0, 0);
4742   try
4743     if not AssignToLazIntfImage(intf) then
4744       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
4745     intf.GetRawImage(raw);
4746     png.LoadFromRawImage(raw, false);
4747     png.SaveToStream(aStream);
4748   finally
4749     png.Free;
4750     intf.Free;
4751   end;
4752 end;
4753
4754 {$ELSEIF DEFINED(GLB_LIB_PNG)}
4755 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4756 procedure TglBitmapData.SavePNG(const aStream: TStream);
4757 var
4758   png: png_structp;
4759   png_info: png_infop;
4760   png_rows: array of pByte;
4761   LineSize: Integer;
4762   ColorType: Integer;
4763   Row: Integer;
4764   FormatDesc: TFormatDescriptor;
4765 begin
4766   if not (ftPNG in FormatGetSupportedFiles(Format)) then
4767     raise EglBitmapUnsupportedFormat.Create(Format);
4768
4769   if not init_libPNG then
4770     raise Exception.Create('unable to initialize libPNG.');
4771
4772   try
4773     case Format of
4774       tfAlpha8ub1, tfLuminance8ub1:
4775         ColorType := PNG_COLOR_TYPE_GRAY;
4776       tfLuminance8Alpha8us1:
4777         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4778       tfBGR8ub3, tfRGB8ub3:
4779         ColorType := PNG_COLOR_TYPE_RGB;
4780       tfBGRA8ub4, tfRGBA8ub4:
4781         ColorType := PNG_COLOR_TYPE_RGBA;
4782       else
4783         raise EglBitmapUnsupportedFormat.Create(Format);
4784     end;
4785
4786     FormatDesc := TFormatDescriptor.Get(Format);
4787     LineSize := FormatDesc.GetSize(Width, 1);
4788
4789     // creating array for scanline
4790     SetLength(png_rows, Height);
4791     try
4792       for Row := 0 to Height - 1 do begin
4793         png_rows[Row] := Data;
4794         Inc(png_rows[Row], Row * LineSize)
4795       end;
4796
4797       // write struct
4798       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4799       if png = nil then
4800         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4801
4802       // create png info
4803       png_info := png_create_info_struct(png);
4804       if png_info = nil then begin
4805         png_destroy_write_struct(@png, nil);
4806         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4807       end;
4808
4809       // set read callback
4810       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
4811
4812       // set compression
4813       png_set_compression_level(png, 6);
4814
4815       if Format in [tfBGR8ub3, tfBGRA8ub4] then
4816         png_set_bgr(png);
4817
4818       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4819       png_write_info(png, png_info);
4820       png_write_image(png, @png_rows[0]);
4821       png_write_end(png, png_info);
4822       png_destroy_write_struct(@png, @png_info);
4823     finally
4824       SetLength(png_rows, 0);
4825     end;
4826   finally
4827     quit_libPNG;
4828   end;
4829 end;
4830
4831 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
4832 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4833 procedure TglBitmapData.SavePNG(const aStream: TStream);
4834 var
4835   Png: TPNGObject;
4836
4837   pSource, pDest: pByte;
4838   X, Y, PixSize: Integer;
4839   ColorType: Cardinal;
4840   Alpha: Boolean;
4841
4842   pTemp: pByte;
4843   Temp: Byte;
4844 begin
4845   if not (ftPNG in FormatGetSupportedFiles (Format)) then
4846     raise EglBitmapUnsupportedFormat.Create(Format);
4847
4848   case Format of
4849     tfAlpha8ub1, tfLuminance8ub1: begin
4850       ColorType := COLOR_GRAYSCALE;
4851       PixSize   := 1;
4852       Alpha     := false;
4853     end;
4854     tfLuminance8Alpha8us1: begin
4855       ColorType := COLOR_GRAYSCALEALPHA;
4856       PixSize   := 1;
4857       Alpha     := true;
4858     end;
4859     tfBGR8ub3, tfRGB8ub3: begin
4860       ColorType := COLOR_RGB;
4861       PixSize   := 3;
4862       Alpha     := false;
4863     end;
4864     tfBGRA8ub4, tfRGBA8ub4: begin
4865       ColorType := COLOR_RGBALPHA;
4866       PixSize   := 3;
4867       Alpha     := true
4868     end;
4869   else
4870     raise EglBitmapUnsupportedFormat.Create(Format);
4871   end;
4872
4873   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4874   try
4875     // Copy ImageData
4876     pSource := Data;
4877     for Y := 0 to Height -1 do begin
4878       pDest := png.ScanLine[Y];
4879       for X := 0 to Width -1 do begin
4880         Move(pSource^, pDest^, PixSize);
4881         Inc(pDest, PixSize);
4882         Inc(pSource, PixSize);
4883         if Alpha then begin
4884           png.AlphaScanline[Y]^[X] := pSource^;
4885           Inc(pSource);
4886         end;
4887       end;
4888
4889       // convert RGB line to BGR
4890       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
4891         pTemp := png.ScanLine[Y];
4892         for X := 0 to Width -1 do begin
4893           Temp := pByteArray(pTemp)^[0];
4894           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4895           pByteArray(pTemp)^[2] := Temp;
4896           Inc(pTemp, 3);
4897         end;
4898       end;
4899     end;
4900
4901     // Save to Stream
4902     Png.CompressionLevel := 6;
4903     Png.SaveToStream(aStream);
4904   finally
4905     FreeAndNil(Png);
4906   end;
4907 end;
4908 {$IFEND}
4909 {$ENDIF}
4910
4911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4912 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4913 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4914 {$IFDEF GLB_LIB_JPEG}
4915 type
4916   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
4917   glBitmap_libJPEG_source_mgr = record
4918     pub: jpeg_source_mgr;
4919
4920     SrcStream: TStream;
4921     SrcBuffer: array [1..4096] of byte;
4922   end;
4923
4924   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
4925   glBitmap_libJPEG_dest_mgr = record
4926     pub: jpeg_destination_mgr;
4927
4928     DestStream: TStream;
4929     DestBuffer: array [1..4096] of byte;
4930   end;
4931
4932 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
4933 begin
4934   //DUMMY
4935 end;
4936
4937
4938 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
4939 begin
4940   //DUMMY
4941 end;
4942
4943
4944 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
4945 begin
4946   //DUMMY
4947 end;
4948
4949 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
4950 begin
4951   //DUMMY
4952 end;
4953
4954
4955 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
4956 begin
4957   //DUMMY
4958 end;
4959
4960
4961 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4962 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
4963 var
4964   src: glBitmap_libJPEG_source_mgr_ptr;
4965   bytes: integer;
4966 begin
4967   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4968
4969   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
4970         if (bytes <= 0) then begin
4971                 src^.SrcBuffer[1] := $FF;
4972                 src^.SrcBuffer[2] := JPEG_EOI;
4973                 bytes := 2;
4974         end;
4975
4976         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
4977         src^.pub.bytes_in_buffer := bytes;
4978
4979   result := true;
4980 end;
4981
4982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4983 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
4984 var
4985   src: glBitmap_libJPEG_source_mgr_ptr;
4986 begin
4987   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
4988
4989   if num_bytes > 0 then begin
4990     // wanted byte isn't in buffer so set stream position and read buffer
4991     if num_bytes > src^.pub.bytes_in_buffer then begin
4992       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
4993       src^.pub.fill_input_buffer(cinfo);
4994     end else begin
4995       // wanted byte is in buffer so only skip
4996                 inc(src^.pub.next_input_byte, num_bytes);
4997                 dec(src^.pub.bytes_in_buffer, num_bytes);
4998     end;
4999   end;
5000 end;
5001
5002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5003 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5004 var
5005   dest: glBitmap_libJPEG_dest_mgr_ptr;
5006 begin
5007   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5008
5009   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5010     // write complete buffer
5011     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5012
5013     // reset buffer
5014     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5015     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5016   end;
5017
5018   result := true;
5019 end;
5020
5021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5022 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5023 var
5024   Idx: Integer;
5025   dest: glBitmap_libJPEG_dest_mgr_ptr;
5026 begin
5027   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5028
5029   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5030     // check for endblock
5031     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5032       // write endblock
5033       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5034
5035       // leave
5036       break;
5037     end else
5038       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5039   end;
5040 end;
5041 {$ENDIF}
5042
5043 {$IFDEF GLB_SUPPORT_JPEG_READ}
5044 {$IF DEFINED(GLB_LAZ_JPEG)}
5045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5046 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5047 const
5048   MAGIC_LEN = 2;
5049   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
5050 var
5051   intf: TLazIntfImage;
5052   reader: TFPReaderJPEG;
5053   StreamPos: Int64;
5054   magic: String[MAGIC_LEN];
5055 begin
5056   result := true;
5057   StreamPos := aStream.Position;
5058
5059   SetLength(magic, MAGIC_LEN);
5060   aStream.Read(magic[1], MAGIC_LEN);
5061   aStream.Position := StreamPos;
5062   if (magic <> JPEG_MAGIC) then begin
5063     result := false;
5064     exit;
5065   end;
5066
5067   reader := TFPReaderJPEG.Create;
5068   intf := TLazIntfImage.Create(0, 0);
5069   try try
5070     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
5071     reader.ImageRead(aStream, intf);
5072     AssignFromLazIntfImage(intf);
5073   except
5074     result := false;
5075     aStream.Position := StreamPos;
5076     exit;
5077   end;
5078   finally
5079     reader.Free;
5080     intf.Free;
5081   end;
5082 end;
5083
5084 {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
5085 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5086 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5087 var
5088   Surface: PSDL_Surface;
5089   RWops: PSDL_RWops;
5090 begin
5091   result := false;
5092
5093   RWops := glBitmapCreateRWops(aStream);
5094   try
5095     if IMG_isJPG(RWops) > 0 then begin
5096       Surface := IMG_LoadJPG_RW(RWops);
5097       try
5098         AssignFromSurface(Surface);
5099         result := true;
5100       finally
5101         SDL_FreeSurface(Surface);
5102       end;
5103     end;
5104   finally
5105     SDL_FreeRW(RWops);
5106   end;
5107 end;
5108
5109 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5110 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5111 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5112 var
5113   StreamPos: Int64;
5114   Temp: array[0..1]of Byte;
5115
5116   jpeg: jpeg_decompress_struct;
5117   jpeg_err: jpeg_error_mgr;
5118
5119   IntFormat: TglBitmapFormat;
5120   pImage: pByte;
5121   TempHeight, TempWidth: Integer;
5122
5123   pTemp: pByte;
5124   Row: Integer;
5125
5126   FormatDesc: TFormatDescriptor;
5127 begin
5128   result := false;
5129
5130   if not init_libJPEG then
5131     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
5132
5133   try
5134     // reading first two bytes to test file and set cursor back to begin
5135     StreamPos := aStream.Position;
5136     aStream.Read({%H-}Temp[0], 2);
5137     aStream.Position := StreamPos;
5138
5139     // if Bitmap then read file.
5140     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5141       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
5142       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5143
5144       // error managment
5145       jpeg.err := jpeg_std_error(@jpeg_err);
5146       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5147       jpeg_err.output_message := glBitmap_libJPEG_output_message;
5148
5149       // decompression struct
5150       jpeg_create_decompress(@jpeg);
5151
5152       // allocation space for streaming methods
5153       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
5154
5155       // seeting up custom functions
5156       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
5157         pub.init_source       := glBitmap_libJPEG_init_source;
5158         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
5159         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
5160         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
5161         pub.term_source       := glBitmap_libJPEG_term_source;
5162
5163         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
5164         pub.next_input_byte := nil;   // until buffer loaded
5165
5166         SrcStream := aStream;
5167       end;
5168
5169       // set global decoding state
5170       jpeg.global_state := DSTATE_START;
5171
5172       // read header of jpeg
5173       jpeg_read_header(@jpeg, false);
5174
5175       // setting output parameter
5176       case jpeg.jpeg_color_space of
5177         JCS_GRAYSCALE:
5178           begin
5179             jpeg.out_color_space := JCS_GRAYSCALE;
5180             IntFormat := tfLuminance8ub1;
5181           end;
5182         else
5183           jpeg.out_color_space := JCS_RGB;
5184           IntFormat := tfRGB8ub3;
5185       end;
5186
5187       // reading image
5188       jpeg_start_decompress(@jpeg);
5189
5190       TempHeight := jpeg.output_height;
5191       TempWidth := jpeg.output_width;
5192
5193       FormatDesc := TFormatDescriptor.Get(IntFormat);
5194
5195       // creating new image
5196       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
5197       try
5198         pTemp := pImage;
5199
5200         for Row := 0 to TempHeight -1 do begin
5201           jpeg_read_scanlines(@jpeg, @pTemp, 1);
5202           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
5203         end;
5204
5205         // finish decompression
5206         jpeg_finish_decompress(@jpeg);
5207
5208         // destroy decompression
5209         jpeg_destroy_decompress(@jpeg);
5210
5211         SetData(pImage, IntFormat, TempWidth, TempHeight);
5212
5213         result := true;
5214       except
5215         if Assigned(pImage) then
5216           FreeMem(pImage);
5217         raise;
5218       end;
5219     end;
5220   finally
5221     quit_libJPEG;
5222   end;
5223 end;
5224
5225 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5227 function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
5228 var
5229   bmp: TBitmap;
5230   jpg: TJPEGImage;
5231   StreamPos: Int64;
5232   Temp: array[0..1]of Byte;
5233 begin
5234   result := false;
5235
5236   // reading first two bytes to test file and set cursor back to begin
5237   StreamPos := aStream.Position;
5238   aStream.Read(Temp[0], 2);
5239   aStream.Position := StreamPos;
5240
5241   // if Bitmap then read file.
5242   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
5243     bmp := TBitmap.Create;
5244     try
5245       jpg := TJPEGImage.Create;
5246       try
5247         jpg.LoadFromStream(aStream);
5248         bmp.Assign(jpg);
5249         result := AssignFromBitmap(bmp);
5250       finally
5251         jpg.Free;
5252       end;
5253     finally
5254       bmp.Free;
5255     end;
5256   end;
5257 end;
5258 {$IFEND}
5259 {$ENDIF}
5260
5261 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
5262 {$IF DEFINED(GLB_LAZ_JPEG)}
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5265 var
5266   jpeg: TJPEGImage;
5267   intf: TLazIntfImage;
5268   raw: TRawImage;
5269 begin
5270   jpeg := TJPEGImage.Create;
5271   intf := TLazIntfImage.Create(0, 0);
5272   try
5273     if not AssignToLazIntfImage(intf) then
5274       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
5275     intf.GetRawImage(raw);
5276     jpeg.LoadFromRawImage(raw, false);
5277     jpeg.SaveToStream(aStream);
5278   finally
5279     intf.Free;
5280     jpeg.Free;
5281   end;
5282 end;
5283
5284 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
5285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5286 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5287 var
5288   jpeg: jpeg_compress_struct;
5289   jpeg_err: jpeg_error_mgr;
5290   Row: Integer;
5291   pTemp, pTemp2: pByte;
5292
5293   procedure CopyRow(pDest, pSource: pByte);
5294   var
5295     X: Integer;
5296   begin
5297     for X := 0 to Width - 1 do begin
5298       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
5299       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
5300       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
5301       Inc(pDest, 3);
5302       Inc(pSource, 3);
5303     end;
5304   end;
5305
5306 begin
5307   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5308     raise EglBitmapUnsupportedFormat.Create(Format);
5309
5310   if not init_libJPEG then
5311     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
5312
5313   try
5314     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
5315     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
5316
5317     // error managment
5318     jpeg.err := jpeg_std_error(@jpeg_err);
5319     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
5320     jpeg_err.output_message := glBitmap_libJPEG_output_message;
5321
5322     // compression struct
5323     jpeg_create_compress(@jpeg);
5324
5325     // allocation space for streaming methods
5326     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
5327
5328     // seeting up custom functions
5329     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
5330       pub.init_destination    := glBitmap_libJPEG_init_destination;
5331       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
5332       pub.term_destination    := glBitmap_libJPEG_term_destination;
5333
5334       pub.next_output_byte  := @DestBuffer[1];
5335       pub.free_in_buffer    := Length(DestBuffer);
5336
5337       DestStream := aStream;
5338     end;
5339
5340     // very important state
5341     jpeg.global_state := CSTATE_START;
5342     jpeg.image_width  := Width;
5343     jpeg.image_height := Height;
5344     case Format of
5345       tfAlpha8ub1, tfLuminance8ub1: begin
5346         jpeg.input_components := 1;
5347         jpeg.in_color_space   := JCS_GRAYSCALE;
5348       end;
5349       tfRGB8ub3, tfBGR8ub3: begin
5350         jpeg.input_components := 3;
5351         jpeg.in_color_space   := JCS_RGB;
5352       end;
5353     end;
5354
5355     jpeg_set_defaults(@jpeg);
5356     jpeg_set_quality(@jpeg, 95, true);
5357     jpeg_start_compress(@jpeg, true);
5358     pTemp := Data;
5359
5360     if Format = tfBGR8ub3 then
5361       GetMem(pTemp2, fRowSize)
5362     else
5363       pTemp2 := pTemp;
5364
5365     try
5366       for Row := 0 to jpeg.image_height -1 do begin
5367         // prepare row
5368         if Format = tfBGR8ub3 then
5369           CopyRow(pTemp2, pTemp)
5370         else
5371           pTemp2 := pTemp;
5372
5373         // write row
5374         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
5375         inc(pTemp, fRowSize);
5376       end;
5377     finally
5378       // free memory
5379       if Format = tfBGR8ub3 then
5380         FreeMem(pTemp2);
5381     end;
5382     jpeg_finish_compress(@jpeg);
5383     jpeg_destroy_compress(@jpeg);
5384   finally
5385     quit_libJPEG;
5386   end;
5387 end;
5388
5389 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
5390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5391 procedure TglBitmapData.SaveJPEG(const aStream: TStream);
5392 var
5393   Bmp: TBitmap;
5394   Jpg: TJPEGImage;
5395 begin
5396   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
5397     raise EglBitmapUnsupportedFormat.Create(Format);
5398
5399   Bmp := TBitmap.Create;
5400   try
5401     Jpg := TJPEGImage.Create;
5402     try
5403       AssignToBitmap(Bmp);
5404       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
5405         Jpg.Grayscale   := true;
5406         Jpg.PixelFormat := jf8Bit;
5407       end;
5408       Jpg.Assign(Bmp);
5409       Jpg.SaveToStream(aStream);
5410     finally
5411       FreeAndNil(Jpg);
5412     end;
5413   finally
5414     FreeAndNil(Bmp);
5415   end;
5416 end;
5417 {$IFEND}
5418 {$ENDIF}
5419
5420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5421 //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5422 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5423 type
5424   RawHeader = packed record
5425     Magic:        String[5];
5426     Version:      Byte;
5427     Width:        Integer;
5428     Height:       Integer;
5429     DataSize:     Integer;
5430     BitsPerPixel: Integer;
5431     Precision:    TglBitmapRec4ub;
5432     Shift:        TglBitmapRec4ub;
5433   end;
5434
5435 function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
5436 var
5437   header: RawHeader;
5438   StartPos: Int64;
5439   fd: TFormatDescriptor;
5440   buf: PByte;
5441 begin
5442   result := false;
5443   StartPos := aStream.Position;
5444   aStream.Read(header{%H-}, SizeOf(header));
5445   if (header.Magic <> 'glBMP') then begin
5446     aStream.Position := StartPos;
5447     exit;
5448   end;
5449
5450   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
5451   if (fd.Format = tfEmpty) then
5452     raise EglBitmapUnsupportedFormat.Create('no supported format found');
5453
5454   buf := GetMemory(header.DataSize);
5455   aStream.Read(buf^, header.DataSize);
5456   SetData(buf, fd.Format, header.Width, header.Height);
5457
5458   result := true;
5459 end;
5460
5461 procedure TglBitmapData.SaveRAW(const aStream: TStream);
5462 var
5463   header: RawHeader;
5464   fd: TFormatDescriptor;
5465 begin
5466   fd := TFormatDescriptor.Get(Format);
5467   header.Magic        := 'glBMP';
5468   header.Version      := 1;
5469   header.Width        := Width;
5470   header.Height       := Height;
5471   header.DataSize     := fd.GetSize(fDimension);
5472   header.BitsPerPixel := fd.BitsPerPixel;
5473   header.Precision    := fd.Precision;
5474   header.Shift        := fd.Shift;
5475   aStream.Write(header, SizeOf(header));
5476   aStream.Write(Data^,  header.DataSize);
5477 end;
5478
5479 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5480 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5482 const
5483   BMP_MAGIC          = $4D42;
5484
5485   BMP_COMP_RGB       = 0;
5486   BMP_COMP_RLE8      = 1;
5487   BMP_COMP_RLE4      = 2;
5488   BMP_COMP_BITFIELDS = 3;
5489
5490 type
5491   TBMPHeader = packed record
5492     bfType: Word;
5493     bfSize: Cardinal;
5494     bfReserved1: Word;
5495     bfReserved2: Word;
5496     bfOffBits: Cardinal;
5497   end;
5498
5499   TBMPInfo = packed record
5500     biSize: Cardinal;
5501     biWidth: Longint;
5502     biHeight: Longint;
5503     biPlanes: Word;
5504     biBitCount: Word;
5505     biCompression: Cardinal;
5506     biSizeImage: Cardinal;
5507     biXPelsPerMeter: Longint;
5508     biYPelsPerMeter: Longint;
5509     biClrUsed: Cardinal;
5510     biClrImportant: Cardinal;
5511   end;
5512
5513 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5514 function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
5515
5516   //////////////////////////////////////////////////////////////////////////////////////////////////
5517   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
5518   var
5519     tmp, i: Cardinal;
5520   begin
5521     result := tfEmpty;
5522     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
5523     FillChar(aMask{%H-}, SizeOf(aMask), 0);
5524
5525     //Read Compression
5526     case aInfo.biCompression of
5527       BMP_COMP_RLE4,
5528       BMP_COMP_RLE8: begin
5529         raise EglBitmap.Create('RLE compression is not supported');
5530       end;
5531       BMP_COMP_BITFIELDS: begin
5532         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
5533           for i := 0 to 2 do begin
5534             aStream.Read(tmp{%H-}, SizeOf(tmp));
5535             aMask.arr[i] := tmp;
5536           end;
5537         end else
5538           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
5539       end;
5540     end;
5541
5542     //get suitable format
5543     case aInfo.biBitCount of
5544        8: result := tfLuminance8ub1;
5545       16: result := tfX1RGB5us1;
5546       24: result := tfBGR8ub3;
5547       32: result := tfXRGB8ui1;
5548     end;
5549   end;
5550
5551   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
5552   var
5553     i, c: Integer;
5554     fd: TFormatDescriptor;
5555     ColorTable: TbmpColorTable;
5556   begin
5557     result := nil;
5558     if (aInfo.biBitCount >= 16) then
5559       exit;
5560     aFormat := tfLuminance8ub1;
5561     c := aInfo.biClrUsed;
5562     if (c = 0) then
5563       c := 1 shl aInfo.biBitCount;
5564     SetLength(ColorTable, c);
5565     for i := 0 to c-1 do begin
5566       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
5567       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
5568         aFormat := tfRGB8ub3;
5569     end;
5570
5571     fd := TFormatDescriptor.Get(aFormat);
5572     result := TbmpColorTableFormat.Create;
5573     result.ColorTable   := ColorTable;
5574     result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
5575   end;
5576
5577   //////////////////////////////////////////////////////////////////////////////////////////////////
5578   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
5579   var
5580     fd: TFormatDescriptor;
5581   begin
5582     result := nil;
5583     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
5584
5585       // find suitable format ...
5586       fd := TFormatDescriptor.GetFromMask(aMask);
5587       if (fd.Format <> tfEmpty) then begin
5588         aFormat := fd.Format;
5589         exit;
5590       end;
5591
5592       // or create custom bitfield format
5593       result := TbmpBitfieldFormat.Create;
5594       result.SetCustomValues(aInfo.biBitCount, aMask);
5595     end;
5596   end;
5597
5598 var
5599   //simple types
5600   StartPos: Int64;
5601   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
5602   PaddingBuff: Cardinal;
5603   LineBuf, ImageData, TmpData: PByte;
5604   SourceMD, DestMD: Pointer;
5605   BmpFormat: TglBitmapFormat;
5606
5607   //records
5608   Mask: TglBitmapRec4ul;
5609   Header: TBMPHeader;
5610   Info: TBMPInfo;
5611
5612   //classes
5613   SpecialFormat: TFormatDescriptor;
5614   FormatDesc: TFormatDescriptor;
5615
5616   //////////////////////////////////////////////////////////////////////////////////////////////////
5617   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
5618   var
5619     i: Integer;
5620     Pixel: TglBitmapPixelData;
5621   begin
5622     aStream.Read(aLineBuf^, rbLineSize);
5623     SpecialFormat.PreparePixel(Pixel);
5624     for i := 0 to Info.biWidth-1 do begin
5625       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
5626       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
5627       FormatDesc.Map(Pixel, aData, DestMD);
5628     end;
5629   end;
5630
5631 begin
5632   result        := false;
5633   BmpFormat     := tfEmpty;
5634   SpecialFormat := nil;
5635   LineBuf       := nil;
5636   SourceMD      := nil;
5637   DestMD        := nil;
5638
5639   // Header
5640   StartPos := aStream.Position;
5641   aStream.Read(Header{%H-}, SizeOf(Header));
5642
5643   if Header.bfType = BMP_MAGIC then begin
5644     try try
5645       BmpFormat        := ReadInfo(Info, Mask);
5646       SpecialFormat    := ReadColorTable(BmpFormat, Info);
5647       if not Assigned(SpecialFormat) then
5648         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
5649       aStream.Position := StartPos + Header.bfOffBits;
5650
5651       if (BmpFormat <> tfEmpty) then begin
5652         FormatDesc := TFormatDescriptor.Get(BmpFormat);
5653         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
5654         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
5655         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
5656
5657         //get Memory
5658         DestMD    := FormatDesc.CreateMappingData;
5659         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
5660         GetMem(ImageData, ImageSize);
5661         if Assigned(SpecialFormat) then begin
5662           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
5663           SourceMD := SpecialFormat.CreateMappingData;
5664         end;
5665
5666         //read Data
5667         try try
5668           FillChar(ImageData^, ImageSize, $FF);
5669           TmpData := ImageData;
5670           if (Info.biHeight > 0) then
5671             Inc(TmpData, wbLineSize * (Info.biHeight-1));
5672           for i := 0 to Abs(Info.biHeight)-1 do begin
5673             if Assigned(SpecialFormat) then
5674               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
5675             else
5676               aStream.Read(TmpData^, wbLineSize);   //else only read data
5677             if (Info.biHeight > 0) then
5678               dec(TmpData, wbLineSize)
5679             else
5680               inc(TmpData, wbLineSize);
5681             aStream.Read(PaddingBuff{%H-}, Padding);
5682           end;
5683           SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
5684           result := true;
5685         finally
5686           if Assigned(LineBuf) then
5687             FreeMem(LineBuf);
5688           if Assigned(SourceMD) then
5689             SpecialFormat.FreeMappingData(SourceMD);
5690           FormatDesc.FreeMappingData(DestMD);
5691         end;
5692         except
5693           if Assigned(ImageData) then
5694             FreeMem(ImageData);
5695           raise;
5696         end;
5697       end else
5698         raise EglBitmap.Create('LoadBMP - No suitable format found');
5699     except
5700       aStream.Position := StartPos;
5701       raise;
5702     end;
5703     finally
5704       FreeAndNil(SpecialFormat);
5705     end;
5706   end
5707     else aStream.Position := StartPos;
5708 end;
5709
5710 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5711 procedure TglBitmapData.SaveBMP(const aStream: TStream);
5712 var
5713   Header: TBMPHeader;
5714   Info: TBMPInfo;
5715   Converter: TFormatDescriptor;
5716   FormatDesc: TFormatDescriptor;
5717   SourceFD, DestFD: Pointer;
5718   pData, srcData, dstData, ConvertBuffer: pByte;
5719
5720   Pixel: TglBitmapPixelData;
5721   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
5722   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
5723
5724   PaddingBuff: Cardinal;
5725
5726   function GetLineWidth : Integer;
5727   begin
5728     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
5729   end;
5730
5731 begin
5732   if not (ftBMP in FormatGetSupportedFiles(Format)) then
5733     raise EglBitmapUnsupportedFormat.Create(Format);
5734
5735   Converter  := nil;
5736   FormatDesc := TFormatDescriptor.Get(Format);
5737   ImageSize  := FormatDesc.GetSize(Dimension);
5738
5739   FillChar(Header{%H-}, SizeOf(Header), 0);
5740   Header.bfType      := BMP_MAGIC;
5741   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
5742   Header.bfReserved1 := 0;
5743   Header.bfReserved2 := 0;
5744   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
5745
5746   FillChar(Info{%H-}, SizeOf(Info), 0);
5747   Info.biSize        := SizeOf(Info);
5748   Info.biWidth       := Width;
5749   Info.biHeight      := Height;
5750   Info.biPlanes      := 1;
5751   Info.biCompression := BMP_COMP_RGB;
5752   Info.biSizeImage   := ImageSize;
5753
5754   try
5755     case Format of
5756       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
5757       begin
5758         Info.biBitCount  :=  8;
5759         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
5760         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
5761         Converter := TbmpColorTableFormat.Create;
5762         with (Converter as TbmpColorTableFormat) do begin
5763           SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
5764           CreateColorTable;
5765         end;
5766       end;
5767
5768       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
5769       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
5770       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
5771       begin
5772         Info.biBitCount    := 16;
5773         Info.biCompression := BMP_COMP_BITFIELDS;
5774       end;
5775
5776       tfBGR8ub3, tfRGB8ub3:
5777       begin
5778         Info.biBitCount := 24;
5779         if (Format = tfRGB8ub3) then
5780           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
5781       end;
5782
5783       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
5784       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
5785       begin
5786         Info.biBitCount    := 32;
5787         Info.biCompression := BMP_COMP_BITFIELDS;
5788       end;
5789     else
5790       raise EglBitmapUnsupportedFormat.Create(Format);
5791     end;
5792     Info.biXPelsPerMeter := 2835;
5793     Info.biYPelsPerMeter := 2835;
5794
5795     // prepare bitmasks
5796     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5797       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
5798       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
5799
5800       RedMask    := FormatDesc.Mask.r;
5801       GreenMask  := FormatDesc.Mask.g;
5802       BlueMask   := FormatDesc.Mask.b;
5803       AlphaMask  := FormatDesc.Mask.a;
5804     end;
5805
5806     // headers
5807     aStream.Write(Header, SizeOf(Header));
5808     aStream.Write(Info, SizeOf(Info));
5809
5810     // colortable
5811     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
5812       with (Converter as TbmpColorTableFormat) do
5813         aStream.Write(ColorTable[0].b,
5814           SizeOf(TbmpColorTableEnty) * Length(ColorTable));
5815
5816     // bitmasks
5817     if Info.biCompression = BMP_COMP_BITFIELDS then begin
5818       aStream.Write(RedMask,   SizeOf(Cardinal));
5819       aStream.Write(GreenMask, SizeOf(Cardinal));
5820       aStream.Write(BlueMask,  SizeOf(Cardinal));
5821       aStream.Write(AlphaMask, SizeOf(Cardinal));
5822     end;
5823
5824     // image data
5825     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);
5826     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
5827     Padding     := GetLineWidth - wbLineSize;
5828     PaddingBuff := 0;
5829
5830     pData := Data;
5831     inc(pData, (Height-1) * rbLineSize);
5832
5833     // prepare row buffer. But only for RGB because RGBA supports color masks
5834     // so it's possible to change color within the image.
5835     if Assigned(Converter) then begin
5836       FormatDesc.PreparePixel(Pixel);
5837       GetMem(ConvertBuffer, wbLineSize);
5838       SourceFD := FormatDesc.CreateMappingData;
5839       DestFD   := Converter.CreateMappingData;
5840     end else
5841       ConvertBuffer := nil;
5842
5843     try
5844       for LineIdx := 0 to Height - 1 do begin
5845         // preparing row
5846         if Assigned(Converter) then begin
5847           srcData := pData;
5848           dstData := ConvertBuffer;
5849           for PixelIdx := 0 to Info.biWidth-1 do begin
5850             FormatDesc.Unmap(srcData, Pixel, SourceFD);
5851             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
5852             Converter.Map(Pixel, dstData, DestFD);
5853           end;
5854           aStream.Write(ConvertBuffer^, wbLineSize);
5855         end else begin
5856           aStream.Write(pData^, rbLineSize);
5857         end;
5858         dec(pData, rbLineSize);
5859         if (Padding > 0) then
5860           aStream.Write(PaddingBuff, Padding);
5861       end;
5862     finally
5863       // destroy row buffer
5864       if Assigned(ConvertBuffer) then begin
5865         FormatDesc.FreeMappingData(SourceFD);
5866         Converter.FreeMappingData(DestFD);
5867         FreeMem(ConvertBuffer);
5868       end;
5869     end;
5870   finally
5871     if Assigned(Converter) then
5872       Converter.Free;
5873   end;
5874 end;
5875
5876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5877 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5878 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5879 type
5880   TTGAHeader = packed record
5881     ImageID: Byte;
5882     ColorMapType: Byte;
5883     ImageType: Byte;
5884     //ColorMapSpec: Array[0..4] of Byte;
5885     ColorMapStart: Word;
5886     ColorMapLength: Word;
5887     ColorMapEntrySize: Byte;
5888     OrigX: Word;
5889     OrigY: Word;
5890     Width: Word;
5891     Height: Word;
5892     Bpp: Byte;
5893     ImageDesc: Byte;
5894   end;
5895
5896 const
5897   TGA_UNCOMPRESSED_RGB  =  2;
5898   TGA_UNCOMPRESSED_GRAY =  3;
5899   TGA_COMPRESSED_RGB    = 10;
5900   TGA_COMPRESSED_GRAY   = 11;
5901
5902   TGA_NONE_COLOR_TABLE  = 0;
5903
5904 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5905 function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
5906 var
5907   Header: TTGAHeader;
5908   ImageData: System.PByte;
5909   StartPosition: Int64;
5910   PixelSize, LineSize: Integer;
5911   tgaFormat: TglBitmapFormat;
5912   FormatDesc: TFormatDescriptor;
5913   Counter: packed record
5914     X, Y: packed record
5915       low, high, dir: Integer;
5916     end;
5917   end;
5918
5919 const
5920   CACHE_SIZE = $4000;
5921
5922   ////////////////////////////////////////////////////////////////////////////////////////
5923   procedure ReadUncompressed;
5924   var
5925     i, j: Integer;
5926     buf, tmp1, tmp2: System.PByte;
5927   begin
5928     buf := nil;
5929     if (Counter.X.dir < 0) then
5930       GetMem(buf, LineSize);
5931     try
5932       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
5933         tmp1 := ImageData;
5934         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart
5935         if (Counter.X.dir < 0) then begin               //flip X
5936           aStream.Read(buf^, LineSize);
5937           tmp2 := buf;
5938           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line
5939           for i := 0 to Header.Width-1 do begin         //for all pixels in line
5940             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
5941               tmp1^ := tmp2^;
5942               inc(tmp1);
5943               inc(tmp2);
5944             end;
5945             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
5946           end;
5947         end else
5948           aStream.Read(tmp1^, LineSize);
5949         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
5950       end;
5951     finally
5952       if Assigned(buf) then
5953         FreeMem(buf);
5954     end;
5955   end;
5956
5957   ////////////////////////////////////////////////////////////////////////////////////////
5958   procedure ReadCompressed;
5959
5960     /////////////////////////////////////////////////////////////////
5961     var
5962       TmpData: System.PByte;
5963       LinePixelsRead: Integer;
5964     procedure CheckLine;
5965     begin
5966       if (LinePixelsRead >= Header.Width) then begin
5967         LinePixelsRead := 0;
5968         inc(Counter.Y.low, Counter.Y.dir);                //next line index
5969         TmpData := ImageData;
5970         inc(TmpData, Counter.Y.low * LineSize);           //set line
5971         if (Counter.X.dir < 0) then                       //if x flipped then
5972           inc(TmpData, LineSize - PixelSize);             //set last pixel
5973       end;
5974     end;
5975
5976     /////////////////////////////////////////////////////////////////
5977     var
5978       Cache: PByte;
5979       CacheSize, CachePos: Integer;
5980     procedure CachedRead(out Buffer; Count: Integer);
5981     var
5982       BytesRead: Integer;
5983     begin
5984       if (CachePos + Count > CacheSize) then begin
5985         //if buffer overflow save non read bytes
5986         BytesRead := 0;
5987         if (CacheSize - CachePos > 0) then begin
5988           BytesRead := CacheSize - CachePos;
5989           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
5990           inc(CachePos, BytesRead);
5991         end;
5992
5993         //load cache from file
5994         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
5995         aStream.Read(Cache^, CacheSize);
5996         CachePos := 0;
5997
5998         //read rest of requested bytes
5999         if (Count - BytesRead > 0) then begin
6000           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6001           inc(CachePos, Count - BytesRead);
6002         end;
6003       end else begin
6004         //if no buffer overflow just read the data
6005         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6006         inc(CachePos, Count);
6007       end;
6008     end;
6009
6010     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6011     begin
6012       case PixelSize of
6013         1: begin
6014           aBuffer^ := aData^;
6015           inc(aBuffer, Counter.X.dir);
6016         end;
6017         2: begin
6018           PWord(aBuffer)^ := PWord(aData)^;
6019           inc(aBuffer, 2 * Counter.X.dir);
6020         end;
6021         3: begin
6022           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6023           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6024           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6025           inc(aBuffer, 3 * Counter.X.dir);
6026         end;
6027         4: begin
6028           PCardinal(aBuffer)^ := PCardinal(aData)^;
6029           inc(aBuffer, 4 * Counter.X.dir);
6030         end;
6031       end;
6032     end;
6033
6034   var
6035     TotalPixelsToRead, TotalPixelsRead: Integer;
6036     Temp: Byte;
6037     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6038     PixelRepeat: Boolean;
6039     PixelsToRead, PixelCount: Integer;
6040   begin
6041     CacheSize := 0;
6042     CachePos  := 0;
6043
6044     TotalPixelsToRead := Header.Width * Header.Height;
6045     TotalPixelsRead   := 0;
6046     LinePixelsRead    := 0;
6047
6048     GetMem(Cache, CACHE_SIZE);
6049     try
6050       TmpData := ImageData;
6051       inc(TmpData, Counter.Y.low * LineSize);           //set line
6052       if (Counter.X.dir < 0) then                       //if x flipped then
6053         inc(TmpData, LineSize - PixelSize);             //set last pixel
6054
6055       repeat
6056         //read CommandByte
6057         CachedRead(Temp, 1);
6058         PixelRepeat  := (Temp and $80) > 0;
6059         PixelsToRead := (Temp and $7F) + 1;
6060         inc(TotalPixelsRead, PixelsToRead);
6061
6062         if PixelRepeat then
6063           CachedRead(buf[0], PixelSize);
6064         while (PixelsToRead > 0) do begin
6065           CheckLine;
6066           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6067           while (PixelCount > 0) do begin
6068             if not PixelRepeat then
6069               CachedRead(buf[0], PixelSize);
6070             PixelToBuffer(@buf[0], TmpData);
6071             inc(LinePixelsRead);
6072             dec(PixelsToRead);
6073             dec(PixelCount);
6074           end;
6075         end;
6076       until (TotalPixelsRead >= TotalPixelsToRead);
6077     finally
6078       FreeMem(Cache);
6079     end;
6080   end;
6081
6082   function IsGrayFormat: Boolean;
6083   begin
6084     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6085   end;
6086
6087 begin
6088   result := false;
6089
6090   // reading header to test file and set cursor back to begin
6091   StartPosition := aStream.Position;
6092   aStream.Read(Header{%H-}, SizeOf(Header));
6093
6094   // no colormapped files
6095   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6096     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6097   begin
6098     try
6099       if Header.ImageID <> 0 then       // skip image ID
6100         aStream.Position := aStream.Position + Header.ImageID;
6101
6102       tgaFormat := tfEmpty;
6103       case Header.Bpp of
6104          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6105                0: tgaFormat := tfLuminance8ub1;
6106                8: tgaFormat := tfAlpha8ub1;
6107             end;
6108
6109         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6110                0: tgaFormat := tfLuminance16us1;
6111                8: tgaFormat := tfLuminance8Alpha8ub2;
6112             end else case (Header.ImageDesc and $F) of
6113                0: tgaFormat := tfX1RGB5us1;
6114                1: tgaFormat := tfA1RGB5us1;
6115                4: tgaFormat := tfARGB4us1;
6116             end;
6117
6118         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6119                0: tgaFormat := tfBGR8ub3;
6120             end;
6121
6122         32: if IsGrayFormat then case (Header.ImageDesc and $F) of
6123                0: tgaFormat := tfDepth32ui1;
6124             end else case (Header.ImageDesc and $F) of
6125                0: tgaFormat := tfX2RGB10ui1;
6126                2: tgaFormat := tfA2RGB10ui1;
6127                8: tgaFormat := tfARGB8ui1;
6128             end;
6129       end;
6130
6131       if (tgaFormat = tfEmpty) then
6132         raise EglBitmap.Create('LoadTga - unsupported format');
6133
6134       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6135       PixelSize  := FormatDesc.GetSize(1, 1);
6136       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6137
6138       GetMem(ImageData, LineSize * Header.Height);
6139       try
6140         //column direction
6141         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6142           Counter.X.low  := Header.Height-1;;
6143           Counter.X.high := 0;
6144           Counter.X.dir  := -1;
6145         end else begin
6146           Counter.X.low  := 0;
6147           Counter.X.high := Header.Height-1;
6148           Counter.X.dir  := 1;
6149         end;
6150
6151         // Row direction
6152         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6153           Counter.Y.low  := 0;
6154           Counter.Y.high := Header.Height-1;
6155           Counter.Y.dir  := 1;
6156         end else begin
6157           Counter.Y.low  := Header.Height-1;;
6158           Counter.Y.high := 0;
6159           Counter.Y.dir  := -1;
6160         end;
6161
6162         // Read Image
6163         case Header.ImageType of
6164           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6165             ReadUncompressed;
6166           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6167             ReadCompressed;
6168         end;
6169
6170         SetData(ImageData, tgaFormat, Header.Width, Header.Height);
6171         result := true;
6172       except
6173         if Assigned(ImageData) then
6174           FreeMem(ImageData);
6175         raise;
6176       end;
6177     finally
6178       aStream.Position := StartPosition;
6179     end;
6180   end
6181     else aStream.Position := StartPosition;
6182 end;
6183
6184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6185 procedure TglBitmapData.SaveTGA(const aStream: TStream);
6186 var
6187   Header: TTGAHeader;
6188   Size: Integer;
6189   FormatDesc: TFormatDescriptor;
6190 begin
6191   if not (ftTGA in FormatGetSupportedFiles(Format)) then
6192     raise EglBitmapUnsupportedFormat.Create(Format);
6193
6194   //prepare header
6195   FormatDesc := TFormatDescriptor.Get(Format);
6196   FillChar(Header{%H-}, SizeOf(Header), 0);
6197   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
6198   Header.Bpp       := FormatDesc.BitsPerPixel;
6199   Header.Width     := Width;
6200   Header.Height    := Height;
6201   Header.ImageDesc := Header.ImageDesc or $20; //flip y
6202   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
6203     Header.ImageType := TGA_UNCOMPRESSED_GRAY
6204   else
6205     Header.ImageType := TGA_UNCOMPRESSED_RGB;
6206   aStream.Write(Header, SizeOf(Header));
6207
6208   // write Data
6209   Size := FormatDesc.GetSize(Dimension);
6210   aStream.Write(Data^, Size);
6211 end;
6212
6213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6214 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6216 const
6217   DDS_MAGIC: Cardinal         = $20534444;
6218
6219   // DDS_header.dwFlags
6220   DDSD_CAPS                   = $00000001;
6221   DDSD_HEIGHT                 = $00000002;
6222   DDSD_WIDTH                  = $00000004;
6223   DDSD_PIXELFORMAT            = $00001000;
6224
6225   // DDS_header.sPixelFormat.dwFlags
6226   DDPF_ALPHAPIXELS            = $00000001;
6227   DDPF_ALPHA                  = $00000002;
6228   DDPF_FOURCC                 = $00000004;
6229   DDPF_RGB                    = $00000040;
6230   DDPF_LUMINANCE              = $00020000;
6231
6232   // DDS_header.sCaps.dwCaps1
6233   DDSCAPS_TEXTURE             = $00001000;
6234
6235   // DDS_header.sCaps.dwCaps2
6236   DDSCAPS2_CUBEMAP            = $00000200;
6237
6238   D3DFMT_DXT1                 = $31545844;
6239   D3DFMT_DXT3                 = $33545844;
6240   D3DFMT_DXT5                 = $35545844;
6241
6242 type
6243   TDDSPixelFormat = packed record
6244     dwSize: Cardinal;
6245     dwFlags: Cardinal;
6246     dwFourCC: Cardinal;
6247     dwRGBBitCount: Cardinal;
6248     dwRBitMask: Cardinal;
6249     dwGBitMask: Cardinal;
6250     dwBBitMask: Cardinal;
6251     dwABitMask: Cardinal;
6252   end;
6253
6254   TDDSCaps = packed record
6255     dwCaps1: Cardinal;
6256     dwCaps2: Cardinal;
6257     dwDDSX: Cardinal;
6258     dwReserved: Cardinal;
6259   end;
6260
6261   TDDSHeader = packed record
6262     dwSize: Cardinal;
6263     dwFlags: Cardinal;
6264     dwHeight: Cardinal;
6265     dwWidth: Cardinal;
6266     dwPitchOrLinearSize: Cardinal;
6267     dwDepth: Cardinal;
6268     dwMipMapCount: Cardinal;
6269     dwReserved: array[0..10] of Cardinal;
6270     PixelFormat: TDDSPixelFormat;
6271     Caps: TDDSCaps;
6272     dwReserved2: Cardinal;
6273   end;
6274
6275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6276 function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
6277 var
6278   Header: TDDSHeader;
6279   Converter: TbmpBitfieldFormat;
6280
6281   function GetDDSFormat: TglBitmapFormat;
6282   var
6283     fd: TFormatDescriptor;
6284     i: Integer;
6285     Mask: TglBitmapRec4ul;
6286     Range: TglBitmapRec4ui;
6287     match: Boolean;
6288   begin
6289     result := tfEmpty;
6290     with Header.PixelFormat do begin
6291       // Compresses
6292       if ((dwFlags and DDPF_FOURCC) > 0) then begin
6293         case Header.PixelFormat.dwFourCC of
6294           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
6295           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
6296           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
6297         end;
6298       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
6299         // prepare masks
6300         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
6301           Mask.r := dwRBitMask;
6302           Mask.g := dwGBitMask;
6303           Mask.b := dwBBitMask;
6304         end else begin
6305           Mask.r := dwRBitMask;
6306           Mask.g := dwRBitMask;
6307           Mask.b := dwRBitMask;
6308         end;
6309         if (dwFlags and DDPF_ALPHAPIXELS > 0) then
6310           Mask.a := dwABitMask
6311         else
6312           Mask.a := 0;;
6313
6314         //find matching format
6315         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
6316         result := fd.Format;
6317         if (result <> tfEmpty) then
6318           exit;
6319
6320         //find format with same Range
6321         for i := 0 to 3 do
6322           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
6323         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6324           fd := TFormatDescriptor.Get(result);
6325           match := true;
6326           for i := 0 to 3 do
6327             if (fd.Range.arr[i] <> Range.arr[i]) then begin
6328               match := false;
6329               break;
6330             end;
6331           if match then
6332             break;
6333         end;
6334
6335         //no format with same range found -> use default
6336         if (result = tfEmpty) then begin
6337           if (dwABitMask > 0) then
6338             result := tfRGBA8ui1
6339           else
6340             result := tfRGB8ub3;
6341         end;
6342
6343         Converter := TbmpBitfieldFormat.Create;
6344         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
6345       end;
6346     end;
6347   end;
6348
6349 var
6350   StreamPos: Int64;
6351   x, y, LineSize, RowSize, Magic: Cardinal;
6352   NewImage, TmpData, RowData, SrcData: System.PByte;
6353   SourceMD, DestMD: Pointer;
6354   Pixel: TglBitmapPixelData;
6355   ddsFormat: TglBitmapFormat;
6356   FormatDesc: TFormatDescriptor;
6357
6358 begin
6359   result    := false;
6360   Converter := nil;
6361   StreamPos := aStream.Position;
6362
6363   // Magic
6364   aStream.Read(Magic{%H-}, sizeof(Magic));
6365   if (Magic <> DDS_MAGIC) then begin
6366     aStream.Position := StreamPos;
6367     exit;
6368   end;
6369
6370   //Header
6371   aStream.Read(Header{%H-}, sizeof(Header));
6372   if (Header.dwSize <> SizeOf(Header)) or
6373      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
6374         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
6375   begin
6376     aStream.Position := StreamPos;
6377     exit;
6378   end;
6379
6380   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
6381     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
6382
6383   ddsFormat := GetDDSFormat;
6384   try
6385     if (ddsFormat = tfEmpty) then
6386       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6387
6388     FormatDesc := TFormatDescriptor.Get(ddsFormat);
6389     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
6390     GetMem(NewImage, Header.dwHeight * LineSize);
6391     try
6392       TmpData := NewImage;
6393
6394       //Converter needed
6395       if Assigned(Converter) then begin
6396         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
6397         GetMem(RowData, RowSize);
6398         SourceMD := Converter.CreateMappingData;
6399         DestMD   := FormatDesc.CreateMappingData;
6400         try
6401           for y := 0 to Header.dwHeight-1 do begin
6402             TmpData := NewImage;
6403             inc(TmpData, y * LineSize);
6404             SrcData := RowData;
6405             aStream.Read(SrcData^, RowSize);
6406             for x := 0 to Header.dwWidth-1 do begin
6407               Converter.Unmap(SrcData, Pixel, SourceMD);
6408               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
6409               FormatDesc.Map(Pixel, TmpData, DestMD);
6410             end;
6411           end;
6412         finally
6413           Converter.FreeMappingData(SourceMD);
6414           FormatDesc.FreeMappingData(DestMD);
6415           FreeMem(RowData);
6416         end;
6417       end else
6418
6419       // Compressed
6420       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
6421         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
6422         for Y := 0 to Header.dwHeight-1 do begin
6423           aStream.Read(TmpData^, RowSize);
6424           Inc(TmpData, LineSize);
6425         end;
6426       end else
6427
6428       // Uncompressed
6429       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
6430         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
6431         for Y := 0 to Header.dwHeight-1 do begin
6432           aStream.Read(TmpData^, RowSize);
6433           Inc(TmpData, LineSize);
6434         end;
6435       end else
6436         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
6437
6438       SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
6439       result := true;
6440     except
6441       if Assigned(NewImage) then
6442         FreeMem(NewImage);
6443       raise;
6444     end;
6445   finally
6446     FreeAndNil(Converter);
6447   end;
6448 end;
6449
6450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6451 procedure TglBitmapData.SaveDDS(const aStream: TStream);
6452 var
6453   Header: TDDSHeader;
6454   FormatDesc: TFormatDescriptor;
6455 begin
6456   if not (ftDDS in FormatGetSupportedFiles(Format)) then
6457     raise EglBitmapUnsupportedFormat.Create(Format);
6458
6459   FormatDesc := TFormatDescriptor.Get(Format);
6460
6461   // Generell
6462   FillChar(Header{%H-}, SizeOf(Header), 0);
6463   Header.dwSize  := SizeOf(Header);
6464   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
6465
6466   Header.dwWidth  := Max(1, Width);
6467   Header.dwHeight := Max(1, Height);
6468
6469   // Caps
6470   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
6471
6472   // Pixelformat
6473   Header.PixelFormat.dwSize := sizeof(Header);
6474   if (FormatDesc.IsCompressed) then begin
6475     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
6476     case Format of
6477       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
6478       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
6479       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
6480     end;
6481   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
6482     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
6483     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6484     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6485   end else if FormatDesc.IsGrayscale then begin
6486     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
6487     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6488     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6489     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6490   end else begin
6491     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
6492     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
6493     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;
6494     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;
6495     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;
6496     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;
6497   end;
6498
6499   if (FormatDesc.HasAlpha) then
6500     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
6501
6502   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
6503   aStream.Write(Header, SizeOf(Header));
6504   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
6505 end;
6506
6507 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6508 function TglBitmapData.FlipHorz: Boolean;
6509 var
6510   fd: TglBitmapFormatDescriptor;
6511   Col, RowSize, PixelSize: Integer;
6512   pTempDest, pDest, pSource: PByte;
6513 begin
6514   result    := false;
6515   fd        := FormatDescriptor;
6516   PixelSize := Ceil(fd.BytesPerPixel);
6517   RowSize   := fd.GetSize(Width, 1);
6518   if Assigned(Data) and not fd.IsCompressed then begin
6519     pSource := Data;
6520     GetMem(pDest, RowSize);
6521     try
6522       pTempDest := pDest;
6523       Inc(pTempDest, RowSize);
6524       for Col := 0 to Width-1 do begin
6525         dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
6526         Move(pSource^, pTempDest^, PixelSize);
6527         Inc(pSource, PixelSize);
6528       end;
6529       SetData(pDest, Format, Width);
6530       result := true;
6531     except
6532       if Assigned(pDest) then
6533         FreeMem(pDest);
6534       raise;
6535     end;
6536   end;
6537 end;
6538
6539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6540 function TglBitmapData.FlipVert: Boolean;
6541 var
6542   fd: TglBitmapFormatDescriptor;
6543   Row, RowSize, PixelSize: Integer;
6544   TempDestData, DestData, SourceData: PByte;
6545 begin
6546   result    := false;
6547   fd        := FormatDescriptor;
6548   PixelSize := Ceil(fd.BytesPerPixel);
6549   RowSize   := fd.GetSize(Width, 1);
6550   if Assigned(Data) then begin
6551     SourceData := Data;
6552     GetMem(DestData, Height * RowSize);
6553     try
6554       TempDestData := DestData;
6555       Inc(TempDestData, Width * (Height -1) * PixelSize);
6556       for Row := 0 to Height -1 do begin
6557         Move(SourceData^, TempDestData^, RowSize);
6558         Dec(TempDestData, RowSize);
6559         Inc(SourceData, RowSize);
6560       end;
6561       SetData(DestData, Format, Width, Height);
6562       result := true;
6563     except
6564       if Assigned(DestData) then
6565         FreeMem(DestData);
6566       raise;
6567     end;
6568   end;
6569 end;
6570
6571 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6572 procedure TglBitmapData.LoadFromFile(const aFilename: String);
6573 var
6574   fs: TFileStream;
6575 begin
6576   if not FileExists(aFilename) then
6577     raise EglBitmap.Create('file does not exist: ' + aFilename);
6578   fs := TFileStream.Create(aFilename, fmOpenRead);
6579   try
6580     fs.Position := 0;
6581     LoadFromStream(fs);
6582     fFilename := aFilename;
6583   finally
6584     fs.Free;
6585   end;
6586 end;
6587
6588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6589 procedure TglBitmapData.LoadFromStream(const aStream: TStream);
6590 begin
6591   {$IFDEF GLB_SUPPORT_PNG_READ}
6592   if not LoadPNG(aStream) then
6593   {$ENDIF}
6594   {$IFDEF GLB_SUPPORT_JPEG_READ}
6595   if not LoadJPEG(aStream) then
6596   {$ENDIF}
6597   if not LoadDDS(aStream) then
6598   if not LoadTGA(aStream) then
6599   if not LoadBMP(aStream) then
6600   if not LoadRAW(aStream) then
6601     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
6602 end;
6603
6604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6605 procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
6606   const aFunc: TglBitmapFunction; const aArgs: Pointer);
6607 var
6608   tmpData: PByte;
6609   size: Integer;
6610 begin
6611   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
6612   GetMem(tmpData, size);
6613   try
6614     FillChar(tmpData^, size, #$FF);
6615     SetData(tmpData, aFormat, aSize.X, aSize.Y);
6616   except
6617     if Assigned(tmpData) then
6618       FreeMem(tmpData);
6619     raise;
6620   end;
6621   Convert(Self, aFunc, false, aFormat, aArgs);
6622 end;
6623
6624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6625 procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
6626 var
6627   rs: TResourceStream;
6628 begin
6629   PrepareResType(aResource, aResType);
6630   rs := TResourceStream.Create(aInstance, aResource, aResType);
6631   try
6632     LoadFromStream(rs);
6633   finally
6634     rs.Free;
6635   end;
6636 end;
6637
6638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6639 procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
6640 var
6641   rs: TResourceStream;
6642 begin
6643   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
6644   try
6645     LoadFromStream(rs);
6646   finally
6647     rs.Free;
6648   end;
6649 end;
6650
6651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6652 procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
6653 var
6654   fs: TFileStream;
6655 begin
6656   fs := TFileStream.Create(aFileName, fmCreate);
6657   try
6658     fs.Position := 0;
6659     SaveToStream(fs, aFileType);
6660   finally
6661     fs.Free;
6662   end;
6663 end;
6664
6665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6666 procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
6667 begin
6668   case aFileType of
6669     {$IFDEF GLB_SUPPORT_PNG_WRITE}
6670     ftPNG:  SavePNG(aStream);
6671     {$ENDIF}
6672     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6673     ftJPEG: SaveJPEG(aStream);
6674     {$ENDIF}
6675     ftDDS:  SaveDDS(aStream);
6676     ftTGA:  SaveTGA(aStream);
6677     ftBMP:  SaveBMP(aStream);
6678     ftRAW:  SaveRAW(aStream);
6679   end;
6680 end;
6681
6682 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6683 function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
6684 begin
6685   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
6686 end;
6687
6688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6689 function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
6690   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
6691 var
6692   DestData, TmpData, SourceData: pByte;
6693   TempHeight, TempWidth: Integer;
6694   SourceFD, DestFD: TFormatDescriptor;
6695   SourceMD, DestMD: Pointer;
6696
6697   FuncRec: TglBitmapFunctionRec;
6698 begin
6699   Assert(Assigned(Data));
6700   Assert(Assigned(aSource));
6701   Assert(Assigned(aSource.Data));
6702
6703   result := false;
6704   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
6705     SourceFD := TFormatDescriptor.Get(aSource.Format);
6706     DestFD   := TFormatDescriptor.Get(aFormat);
6707
6708     if (SourceFD.IsCompressed) then
6709       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
6710     if (DestFD.IsCompressed) then
6711       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
6712
6713     // inkompatible Formats so CreateTemp
6714     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
6715       aCreateTemp := true;
6716
6717     // Values
6718     TempHeight := Max(1, aSource.Height);
6719     TempWidth  := Max(1, aSource.Width);
6720
6721     FuncRec.Sender := Self;
6722     FuncRec.Args   := aArgs;
6723
6724     TmpData := nil;
6725     if aCreateTemp then begin
6726       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
6727       DestData := TmpData;
6728     end else
6729       DestData := Data;
6730
6731     try
6732       SourceFD.PreparePixel(FuncRec.Source);
6733       DestFD.PreparePixel  (FuncRec.Dest);
6734
6735       SourceMD := SourceFD.CreateMappingData;
6736       DestMD   := DestFD.CreateMappingData;
6737
6738       FuncRec.Size            := aSource.Dimension;
6739       FuncRec.Position.Fields := FuncRec.Size.Fields;
6740
6741       try
6742         SourceData := aSource.Data;
6743         FuncRec.Position.Y := 0;
6744         while FuncRec.Position.Y < TempHeight do begin
6745           FuncRec.Position.X := 0;
6746           while FuncRec.Position.X < TempWidth do begin
6747             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
6748             aFunc(FuncRec);
6749             DestFD.Map(FuncRec.Dest, DestData, DestMD);
6750             inc(FuncRec.Position.X);
6751           end;
6752           inc(FuncRec.Position.Y);
6753         end;
6754
6755         // Updating Image or InternalFormat
6756         if aCreateTemp then
6757           SetData(TmpData, aFormat, aSource.Width, aSource.Height)
6758         else if (aFormat <> fFormat) then
6759           Format := aFormat;
6760
6761         result := true;
6762       finally
6763         SourceFD.FreeMappingData(SourceMD);
6764         DestFD.FreeMappingData(DestMD);
6765       end;
6766     except
6767       if aCreateTemp and Assigned(TmpData) then
6768         FreeMem(TmpData);
6769       raise;
6770     end;
6771   end;
6772 end;
6773
6774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6775 function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
6776 var
6777   SourceFD, DestFD: TFormatDescriptor;
6778   SourcePD, DestPD: TglBitmapPixelData;
6779   ShiftData: TShiftData;
6780
6781   function DataIsIdentical: Boolean;
6782   begin
6783     result := SourceFD.MaskMatch(DestFD.Mask);
6784   end;
6785
6786   function CanCopyDirect: Boolean;
6787   begin
6788     result :=
6789       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6790       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6791       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6792       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6793   end;
6794
6795   function CanShift: Boolean;
6796   begin
6797     result :=
6798       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
6799       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
6800       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
6801       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
6802   end;
6803
6804   function GetShift(aSource, aDest: Cardinal) : ShortInt;
6805   begin
6806     result := 0;
6807     while (aSource > aDest) and (aSource > 0) do begin
6808       inc(result);
6809       aSource := aSource shr 1;
6810     end;
6811   end;
6812
6813 begin
6814   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
6815     SourceFD := TFormatDescriptor.Get(Format);
6816     DestFD   := TFormatDescriptor.Get(aFormat);
6817
6818     if DataIsIdentical then begin
6819       result := true;
6820       Format := aFormat;
6821       exit;
6822     end;
6823
6824     SourceFD.PreparePixel(SourcePD);
6825     DestFD.PreparePixel  (DestPD);
6826
6827     if CanCopyDirect then
6828       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
6829     else if CanShift then begin
6830       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
6831       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
6832       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
6833       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
6834       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
6835     end else
6836       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
6837   end else
6838     result := true;
6839 end;
6840
6841 {$IFDEF GLB_SDL}
6842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6843 function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
6844 var
6845   Row, RowSize: Integer;
6846   SourceData, TmpData: PByte;
6847   TempDepth: Integer;
6848   FormatDesc: TFormatDescriptor;
6849
6850   function GetRowPointer(Row: Integer): pByte;
6851   begin
6852     result := aSurface.pixels;
6853     Inc(result, Row * RowSize);
6854   end;
6855
6856 begin
6857   result := false;
6858
6859   FormatDesc := TFormatDescriptor.Get(Format);
6860   if FormatDesc.IsCompressed then
6861     raise EglBitmapUnsupportedFormat.Create(Format);
6862
6863   if Assigned(Data) then begin
6864     case Trunc(FormatDesc.PixelSize) of
6865       1: TempDepth :=  8;
6866       2: TempDepth := 16;
6867       3: TempDepth := 24;
6868       4: TempDepth := 32;
6869     else
6870       raise EglBitmapUnsupportedFormat.Create(Format);
6871     end;
6872
6873     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
6874       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
6875     SourceData := Data;
6876     RowSize    := FormatDesc.GetSize(FileWidth, 1);
6877
6878     for Row := 0 to FileHeight-1 do begin
6879       TmpData := GetRowPointer(Row);
6880       if Assigned(TmpData) then begin
6881         Move(SourceData^, TmpData^, RowSize);
6882         inc(SourceData, RowSize);
6883       end;
6884     end;
6885     result := true;
6886   end;
6887 end;
6888
6889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6890 function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
6891 var
6892   pSource, pData, pTempData: PByte;
6893   Row, RowSize, TempWidth, TempHeight: Integer;
6894   IntFormat: TglBitmapFormat;
6895   fd: TFormatDescriptor;
6896   Mask: TglBitmapMask;
6897
6898   function GetRowPointer(Row: Integer): pByte;
6899   begin
6900     result := aSurface^.pixels;
6901     Inc(result, Row * RowSize);
6902   end;
6903
6904 begin
6905   result := false;
6906   if (Assigned(aSurface)) then begin
6907     with aSurface^.format^ do begin
6908       Mask.r := RMask;
6909       Mask.g := GMask;
6910       Mask.b := BMask;
6911       Mask.a := AMask;
6912       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
6913       if (IntFormat = tfEmpty) then
6914         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
6915     end;
6916
6917     fd := TFormatDescriptor.Get(IntFormat);
6918     TempWidth  := aSurface^.w;
6919     TempHeight := aSurface^.h;
6920     RowSize := fd.GetSize(TempWidth, 1);
6921     GetMem(pData, TempHeight * RowSize);
6922     try
6923       pTempData := pData;
6924       for Row := 0 to TempHeight -1 do begin
6925         pSource := GetRowPointer(Row);
6926         if (Assigned(pSource)) then begin
6927           Move(pSource^, pTempData^, RowSize);
6928           Inc(pTempData, RowSize);
6929         end;
6930       end;
6931       SetData(pData, IntFormat, TempWidth, TempHeight);
6932       result := true;
6933     except
6934       if Assigned(pData) then
6935         FreeMem(pData);
6936       raise;
6937     end;
6938   end;
6939 end;
6940
6941 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6942 function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
6943 var
6944   Row, Col, AlphaInterleave: Integer;
6945   pSource, pDest: PByte;
6946
6947   function GetRowPointer(Row: Integer): pByte;
6948   begin
6949     result := aSurface.pixels;
6950     Inc(result, Row * Width);
6951   end;
6952
6953 begin
6954   result := false;
6955   if Assigned(Data) then begin
6956     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
6957       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
6958
6959       AlphaInterleave := 0;
6960       case Format of
6961         tfLuminance8Alpha8ub2:
6962           AlphaInterleave := 1;
6963         tfBGRA8ub4, tfRGBA8ub4:
6964           AlphaInterleave := 3;
6965       end;
6966
6967       pSource := Data;
6968       for Row := 0 to Height -1 do begin
6969         pDest := GetRowPointer(Row);
6970         if Assigned(pDest) then begin
6971           for Col := 0 to Width -1 do begin
6972             Inc(pSource, AlphaInterleave);
6973             pDest^ := pSource^;
6974             Inc(pDest);
6975             Inc(pSource);
6976           end;
6977         end;
6978       end;
6979       result := true;
6980     end;
6981   end;
6982 end;
6983
6984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6985 function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
6986 var
6987   bmp: TglBitmap2D;
6988 begin
6989   bmp := TglBitmap2D.Create;
6990   try
6991     bmp.AssignFromSurface(aSurface);
6992     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
6993   finally
6994     bmp.Free;
6995   end;
6996 end;
6997 {$ENDIF}
6998
6999 {$IFDEF GLB_DELPHI}
7000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7001 function CreateGrayPalette: HPALETTE;
7002 var
7003   Idx: Integer;
7004   Pal: PLogPalette;
7005 begin
7006   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
7007
7008   Pal.palVersion := $300;
7009   Pal.palNumEntries := 256;
7010
7011   for Idx := 0 to Pal.palNumEntries - 1 do begin
7012     Pal.palPalEntry[Idx].peRed   := Idx;
7013     Pal.palPalEntry[Idx].peGreen := Idx;
7014     Pal.palPalEntry[Idx].peBlue  := Idx;
7015     Pal.palPalEntry[Idx].peFlags := 0;
7016   end;
7017   Result := CreatePalette(Pal^);
7018   FreeMem(Pal);
7019 end;
7020
7021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7022 function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
7023 var
7024   Row, RowSize: Integer;
7025   pSource, pData: PByte;
7026 begin
7027   result := false;
7028   if Assigned(Data) then begin
7029     if Assigned(aBitmap) then begin
7030       aBitmap.Width  := Width;
7031       aBitmap.Height := Height;
7032
7033       case Format of
7034         tfAlpha8ub1, tfLuminance8ub1: begin
7035           aBitmap.PixelFormat := pf8bit;
7036           aBitmap.Palette     := CreateGrayPalette;
7037         end;
7038         tfRGB5A1us1:
7039           aBitmap.PixelFormat := pf15bit;
7040         tfR5G6B5us1:
7041           aBitmap.PixelFormat := pf16bit;
7042         tfRGB8ub3, tfBGR8ub3:
7043           aBitmap.PixelFormat := pf24bit;
7044         tfRGBA8ub4, tfBGRA8ub4:
7045           aBitmap.PixelFormat := pf32bit;
7046       else
7047         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
7048       end;
7049
7050       RowSize := FormatDescriptor.GetSize(Width, 1);
7051       pSource := Data;
7052       for Row := 0 to Height-1 do begin
7053         pData := aBitmap.Scanline[Row];
7054         Move(pSource^, pData^, RowSize);
7055         Inc(pSource, RowSize);
7056         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)
7057           SwapRGB(pData, Width, Format = tfRGBA8ub4);
7058       end;
7059       result := true;
7060     end;
7061   end;
7062 end;
7063
7064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7065 function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
7066 var
7067   pSource, pData, pTempData: PByte;
7068   Row, RowSize, TempWidth, TempHeight: Integer;
7069   IntFormat: TglBitmapFormat;
7070 begin
7071   result := false;
7072
7073   if (Assigned(aBitmap)) then begin
7074     case aBitmap.PixelFormat of
7075       pf8bit:
7076         IntFormat := tfLuminance8ub1;
7077       pf15bit:
7078         IntFormat := tfRGB5A1us1;
7079       pf16bit:
7080         IntFormat := tfR5G6B5us1;
7081       pf24bit:
7082         IntFormat := tfBGR8ub3;
7083       pf32bit:
7084         IntFormat := tfBGRA8ub4;
7085     else
7086       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
7087     end;
7088
7089     TempWidth  := aBitmap.Width;
7090     TempHeight := aBitmap.Height;
7091     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
7092     GetMem(pData, TempHeight * RowSize);
7093     try
7094       pTempData := pData;
7095       for Row := 0 to TempHeight -1 do begin
7096         pSource := aBitmap.Scanline[Row];
7097         if (Assigned(pSource)) then begin
7098           Move(pSource^, pTempData^, RowSize);
7099           Inc(pTempData, RowSize);
7100         end;
7101       end;
7102       SetData(pData, IntFormat, TempWidth, TempHeight);
7103       result := true;
7104     except
7105       if Assigned(pData) then
7106         FreeMem(pData);
7107       raise;
7108     end;
7109   end;
7110 end;
7111
7112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7113 function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
7114 var
7115   Row, Col, AlphaInterleave: Integer;
7116   pSource, pDest: PByte;
7117 begin
7118   result := false;
7119
7120   if Assigned(Data) then begin
7121     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
7122       if Assigned(aBitmap) then begin
7123         aBitmap.PixelFormat := pf8bit;
7124         aBitmap.Palette     := CreateGrayPalette;
7125         aBitmap.Width       := Width;
7126         aBitmap.Height      := Height;
7127
7128         case Format of
7129           tfLuminance8Alpha8ub2:
7130             AlphaInterleave := 1;
7131           tfRGBA8ub4, tfBGRA8ub4:
7132             AlphaInterleave := 3;
7133           else
7134             AlphaInterleave := 0;
7135         end;
7136
7137         // Copy Data
7138         pSource := Data;
7139
7140         for Row := 0 to Height -1 do begin
7141           pDest := aBitmap.Scanline[Row];
7142           if Assigned(pDest) then begin
7143             for Col := 0 to Width -1 do begin
7144               Inc(pSource, AlphaInterleave);
7145               pDest^ := pSource^;
7146               Inc(pDest);
7147               Inc(pSource);
7148             end;
7149           end;
7150         end;
7151         result := true;
7152       end;
7153     end;
7154   end;
7155 end;
7156
7157 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7158 function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7159 var
7160   data: TglBitmapData;
7161 begin
7162   data := TglBitmapData.Create;
7163   try
7164     data.AssignFromBitmap(aBitmap);
7165     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7166   finally
7167     data.Free;
7168   end;
7169 end;
7170 {$ENDIF}
7171
7172 {$IFDEF GLB_LAZARUS}
7173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7174 function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7175 var
7176   rid: TRawImageDescription;
7177   FormatDesc: TFormatDescriptor;
7178 begin
7179   if not Assigned(Data) then
7180     raise EglBitmap.Create('no pixel data assigned. load data before save');
7181
7182   result := false;
7183   if not Assigned(aImage) or (Format = tfEmpty) then
7184     exit;
7185   FormatDesc := TFormatDescriptor.Get(Format);
7186   if FormatDesc.IsCompressed then
7187     exit;
7188
7189   FillChar(rid{%H-}, SizeOf(rid), 0);
7190   if FormatDesc.IsGrayscale then
7191     rid.Format := ricfGray
7192   else
7193     rid.Format := ricfRGBA;
7194
7195   rid.Width        := Width;
7196   rid.Height       := Height;
7197   rid.Depth        := FormatDesc.BitsPerPixel;
7198   rid.BitOrder     := riboBitsInOrder;
7199   rid.ByteOrder    := riboLSBFirst;
7200   rid.LineOrder    := riloTopToBottom;
7201   rid.LineEnd      := rileTight;
7202   rid.BitsPerPixel := FormatDesc.BitsPerPixel;
7203   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);
7204   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);
7205   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);
7206   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);
7207   rid.RedShift     := FormatDesc.Shift.r;
7208   rid.GreenShift   := FormatDesc.Shift.g;
7209   rid.BlueShift    := FormatDesc.Shift.b;
7210   rid.AlphaShift   := FormatDesc.Shift.a;
7211
7212   rid.MaskBitsPerPixel  := 0;
7213   rid.PaletteColorCount := 0;
7214
7215   aImage.DataDescription := rid;
7216   aImage.CreateData;
7217
7218   if not Assigned(aImage.PixelData) then
7219     raise EglBitmap.Create('error while creating LazIntfImage');
7220   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
7221
7222   result := true;
7223 end;
7224
7225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7226 function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
7227 var
7228   f: TglBitmapFormat;
7229   FormatDesc: TFormatDescriptor;
7230   ImageData: PByte;
7231   ImageSize: Integer;
7232   CanCopy: Boolean;
7233   Mask: TglBitmapRec4ul;
7234
7235   procedure CopyConvert;
7236   var
7237     bfFormat: TbmpBitfieldFormat;
7238     pSourceLine, pDestLine: PByte;
7239     pSourceMD, pDestMD: Pointer;
7240     Shift, Prec: TglBitmapRec4ub;
7241     x, y: Integer;
7242     pixel: TglBitmapPixelData;
7243   begin
7244     bfFormat  := TbmpBitfieldFormat.Create;
7245     with aImage.DataDescription do begin
7246       Prec.r := RedPrec;
7247       Prec.g := GreenPrec;
7248       Prec.b := BluePrec;
7249       Prec.a := AlphaPrec;
7250       Shift.r := RedShift;
7251       Shift.g := GreenShift;
7252       Shift.b := BlueShift;
7253       Shift.a := AlphaShift;
7254       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
7255     end;
7256     pSourceMD := bfFormat.CreateMappingData;
7257     pDestMD   := FormatDesc.CreateMappingData;
7258     try
7259       for y := 0 to aImage.Height-1 do begin
7260         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
7261         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
7262         for x := 0 to aImage.Width-1 do begin
7263           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
7264           FormatDesc.Map(pixel, pDestLine, pDestMD);
7265         end;
7266       end;
7267     finally
7268       FormatDesc.FreeMappingData(pDestMD);
7269       bfFormat.FreeMappingData(pSourceMD);
7270       bfFormat.Free;
7271     end;
7272   end;
7273
7274 begin
7275   result := false;
7276   if not Assigned(aImage) then
7277     exit;
7278
7279   with aImage.DataDescription do begin
7280     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;
7281     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
7282     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
7283     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
7284   end;
7285   FormatDesc := TFormatDescriptor.GetFromMask(Mask);
7286   f          := FormatDesc.Format;
7287   if (f = tfEmpty) then
7288     exit;
7289
7290   CanCopy :=
7291     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and
7292     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
7293
7294   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
7295   ImageData := GetMem(ImageSize);
7296   try
7297     if CanCopy then
7298       Move(aImage.PixelData^, ImageData^, ImageSize)
7299     else
7300       CopyConvert;
7301     SetData(ImageData, f, aImage.Width, aImage.Height);
7302   except
7303     if Assigned(ImageData) then
7304       FreeMem(ImageData);
7305     raise;
7306   end;
7307
7308   result := true;
7309 end;
7310
7311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7312 function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
7313 var
7314   rid: TRawImageDescription;
7315   FormatDesc: TFormatDescriptor;
7316   Pixel: TglBitmapPixelData;
7317   x, y: Integer;
7318   srcMD: Pointer;
7319   src, dst: PByte;
7320 begin
7321   result := false;
7322   if not Assigned(aImage) or (Format = tfEmpty) then
7323     exit;
7324   FormatDesc := TFormatDescriptor.Get(Format);
7325   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7326     exit;
7327
7328   FillChar(rid{%H-}, SizeOf(rid), 0);
7329   rid.Format       := ricfGray;
7330   rid.Width        := Width;
7331   rid.Height       := Height;
7332   rid.Depth        := CountSetBits(FormatDesc.Range.a);
7333   rid.BitOrder     := riboBitsInOrder;
7334   rid.ByteOrder    := riboLSBFirst;
7335   rid.LineOrder    := riloTopToBottom;
7336   rid.LineEnd      := rileTight;
7337   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
7338   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);
7339   rid.GreenPrec    := 0;
7340   rid.BluePrec     := 0;
7341   rid.AlphaPrec    := 0;
7342   rid.RedShift     := 0;
7343   rid.GreenShift   := 0;
7344   rid.BlueShift    := 0;
7345   rid.AlphaShift   := 0;
7346
7347   rid.MaskBitsPerPixel  := 0;
7348   rid.PaletteColorCount := 0;
7349
7350   aImage.DataDescription := rid;
7351   aImage.CreateData;
7352
7353   srcMD := FormatDesc.CreateMappingData;
7354   try
7355     FormatDesc.PreparePixel(Pixel);
7356     src := Data;
7357     dst := aImage.PixelData;
7358     for y := 0 to Height-1 do
7359       for x := 0 to Width-1 do begin
7360         FormatDesc.Unmap(src, Pixel, srcMD);
7361         case rid.BitsPerPixel of
7362            8: begin
7363             dst^ := Pixel.Data.a;
7364             inc(dst);
7365           end;
7366           16: begin
7367             PWord(dst)^ := Pixel.Data.a;
7368             inc(dst, 2);
7369           end;
7370           24: begin
7371             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
7372             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
7373             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
7374             inc(dst, 3);
7375           end;
7376           32: begin
7377             PCardinal(dst)^ := Pixel.Data.a;
7378             inc(dst, 4);
7379           end;
7380         else
7381           raise EglBitmapUnsupportedFormat.Create(Format);
7382         end;
7383       end;
7384   finally
7385     FormatDesc.FreeMappingData(srcMD);
7386   end;
7387   result := true;
7388 end;
7389
7390 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7391 function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7392 var
7393   data: TglBitmapData;
7394 begin
7395   data := TglBitmapData.Create;
7396   try
7397     data.AssignFromLazIntfImage(aImage);
7398     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7399   finally
7400     data.Free;
7401   end;
7402 end;
7403 {$ENDIF}
7404
7405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7406 function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
7407   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7408 var
7409   rs: TResourceStream;
7410 begin
7411   PrepareResType(aResource, aResType);
7412   rs := TResourceStream.Create(aInstance, aResource, aResType);
7413   try
7414     result := AddAlphaFromStream(rs, aFunc, aArgs);
7415   finally
7416     rs.Free;
7417   end;
7418 end;
7419
7420 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7421 function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
7422   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7423 var
7424   rs: TResourceStream;
7425 begin
7426   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
7427   try
7428     result := AddAlphaFromStream(rs, aFunc, aArgs);
7429   finally
7430     rs.Free;
7431   end;
7432 end;
7433
7434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7435 function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7436 begin
7437   if TFormatDescriptor.Get(Format).IsCompressed then
7438     raise EglBitmapUnsupportedFormat.Create(Format);
7439   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
7440 end;
7441
7442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7443 function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7444 var
7445   FS: TFileStream;
7446 begin
7447   FS := TFileStream.Create(aFileName, fmOpenRead);
7448   try
7449     result := AddAlphaFromStream(FS, aFunc, aArgs);
7450   finally
7451     FS.Free;
7452   end;
7453 end;
7454
7455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7456 function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7457 var
7458   data: TglBitmapData;
7459 begin
7460   data := TglBitmapData.Create(aStream);
7461   try
7462     result := AddAlphaFromDataObj(data, aFunc, aArgs);
7463   finally
7464     data.Free;
7465   end;
7466 end;
7467
7468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7469 function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
7470 var
7471   DestData, DestData2, SourceData: pByte;
7472   TempHeight, TempWidth: Integer;
7473   SourceFD, DestFD: TFormatDescriptor;
7474   SourceMD, DestMD, DestMD2: Pointer;
7475
7476   FuncRec: TglBitmapFunctionRec;
7477 begin
7478   result := false;
7479
7480   Assert(Assigned(Data));
7481   Assert(Assigned(aDataObj));
7482   Assert(Assigned(aDataObj.Data));
7483
7484   if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
7485     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
7486
7487     SourceFD := TFormatDescriptor.Get(aDataObj.Format);
7488     DestFD   := TFormatDescriptor.Get(Format);
7489
7490     if not Assigned(aFunc) then begin
7491       aFunc        := glBitmapAlphaFunc;
7492       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
7493     end else
7494       FuncRec.Args := aArgs;
7495
7496     // Values
7497     TempWidth  := aDataObj.Width;
7498     TempHeight := aDataObj.Height;
7499     if (TempWidth <= 0) or (TempHeight <= 0) then
7500       exit;
7501
7502     FuncRec.Sender          := Self;
7503     FuncRec.Size            := Dimension;
7504     FuncRec.Position.Fields := FuncRec.Size.Fields;
7505
7506     DestData   := Data;
7507     DestData2  := Data;
7508     SourceData := aDataObj.Data;
7509
7510     // Mapping
7511     SourceFD.PreparePixel(FuncRec.Source);
7512     DestFD.PreparePixel  (FuncRec.Dest);
7513
7514     SourceMD := SourceFD.CreateMappingData;
7515     DestMD   := DestFD.CreateMappingData;
7516     DestMD2  := DestFD.CreateMappingData;
7517     try
7518       FuncRec.Position.Y := 0;
7519       while FuncRec.Position.Y < TempHeight do begin
7520         FuncRec.Position.X := 0;
7521         while FuncRec.Position.X < TempWidth do begin
7522           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
7523           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
7524           aFunc(FuncRec);
7525           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
7526           inc(FuncRec.Position.X);
7527         end;
7528         inc(FuncRec.Position.Y);
7529       end;
7530     finally
7531       SourceFD.FreeMappingData(SourceMD);
7532       DestFD.FreeMappingData(DestMD);
7533       DestFD.FreeMappingData(DestMD2);
7534     end;
7535   end;
7536 end;
7537
7538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7539 function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
7540 begin
7541   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
7542 end;
7543
7544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7545 function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
7546 var
7547   PixelData: TglBitmapPixelData;
7548 begin
7549   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7550   result := AddAlphaFromColorKeyFloat(
7551     aRed   / PixelData.Range.r,
7552     aGreen / PixelData.Range.g,
7553     aBlue  / PixelData.Range.b,
7554     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
7555 end;
7556
7557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7558 function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
7559 var
7560   values: array[0..2] of Single;
7561   tmp: Cardinal;
7562   i: Integer;
7563   PixelData: TglBitmapPixelData;
7564 begin
7565   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7566   with PixelData do begin
7567     values[0] := aRed;
7568     values[1] := aGreen;
7569     values[2] := aBlue;
7570
7571     for i := 0 to 2 do begin
7572       tmp          := Trunc(Range.arr[i] * aDeviation);
7573       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
7574       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
7575     end;
7576     Data.a  := 0;
7577     Range.a := 0;
7578   end;
7579   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
7580 end;
7581
7582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7583 function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
7584 begin
7585   result := AddAlphaFromValueFloat(aAlpha / $FF);
7586 end;
7587
7588 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7589 function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
7590 var
7591   PixelData: TglBitmapPixelData;
7592 begin
7593   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7594   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
7595 end;
7596
7597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7598 function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
7599 var
7600   PixelData: TglBitmapPixelData;
7601 begin
7602   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7603   with PixelData do
7604     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
7605   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
7606 end;
7607
7608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7609 function TglBitmapData.RemoveAlpha: Boolean;
7610 var
7611   FormatDesc: TFormatDescriptor;
7612 begin
7613   result := false;
7614   FormatDesc := TFormatDescriptor.Get(Format);
7615   if Assigned(Data) then begin
7616     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
7617       raise EglBitmapUnsupportedFormat.Create(Format);
7618     result := ConvertTo(FormatDesc.WithoutAlpha);
7619   end;
7620 end;
7621
7622 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7623 procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
7624   const aAlpha: Byte);
7625 begin
7626   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
7627 end;
7628
7629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7630 procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
7631 var
7632   PixelData: TglBitmapPixelData;
7633 begin
7634   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
7635   FillWithColorFloat(
7636     aRed   / PixelData.Range.r,
7637     aGreen / PixelData.Range.g,
7638     aBlue  / PixelData.Range.b,
7639     aAlpha / PixelData.Range.a);
7640 end;
7641
7642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7643 procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
7644 var
7645   PixelData: TglBitmapPixelData;
7646 begin
7647   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
7648   with PixelData do begin
7649     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
7650     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
7651     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
7652     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
7653   end;
7654   Convert(glBitmapFillWithColorFunc, false, @PixelData);
7655 end;
7656
7657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7658 procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
7659 begin
7660   if (Data <> aData) then begin
7661     if (Assigned(Data)) then
7662       FreeMem(Data);
7663     fData := aData;
7664   end;
7665
7666   if Assigned(fData) then begin
7667     FillChar(fDimension, SizeOf(fDimension), 0);
7668     if aWidth <> -1 then begin
7669       fDimension.Fields := fDimension.Fields + [ffX];
7670       fDimension.X := aWidth;
7671     end;
7672
7673     if aHeight <> -1 then begin
7674       fDimension.Fields := fDimension.Fields + [ffY];
7675       fDimension.Y := aHeight;
7676     end;
7677
7678     fFormat := aFormat;
7679   end else
7680     fFormat := tfEmpty;
7681
7682   UpdateScanlines;
7683 end;
7684
7685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7686 function TglBitmapData.Clone: TglBitmapData;
7687 var
7688   Temp: TglBitmapData;
7689   TempPtr: PByte;
7690   Size: Integer;
7691 begin
7692   result := nil;
7693   Temp := (ClassType.Create as TglBitmapData);
7694   try
7695     // copy texture data if assigned
7696     if Assigned(Data) then begin
7697       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
7698       GetMem(TempPtr, Size);
7699       try
7700         Move(Data^, TempPtr^, Size);
7701         Temp.SetData(TempPtr, Format, Width, Height);
7702       except
7703         if Assigned(TempPtr) then
7704           FreeMem(TempPtr);
7705         raise;
7706       end;
7707     end else begin
7708       TempPtr := nil;
7709       Temp.SetData(TempPtr, Format, Width, Height);
7710     end;
7711
7712           // copy properties
7713     Temp.fFormat := Format;
7714     result := Temp;
7715   except
7716     FreeAndNil(Temp);
7717     raise;
7718   end;
7719 end;
7720
7721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7722 procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
7723 var
7724   mask: PtrInt;
7725 begin
7726   mask :=
7727      (Byte(aRed)   and 1)        or
7728     ((Byte(aGreen) and 1) shl 1) or
7729     ((Byte(aBlue)  and 1) shl 2) or
7730     ((Byte(aAlpha) and 1) shl 3);
7731   if (mask > 0) then
7732     Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
7733 end;
7734
7735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7736 type
7737   TMatrixItem = record
7738     X, Y: Integer;
7739     W: Single;
7740   end;
7741
7742   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7743   TglBitmapToNormalMapRec = Record
7744     Scale: Single;
7745     Heights: array of Single;
7746     MatrixU : array of TMatrixItem;
7747     MatrixV : array of TMatrixItem;
7748   end;
7749
7750 const
7751   ONE_OVER_255 = 1 / 255;
7752
7753   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7754 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7755 var
7756   Val: Single;
7757 begin
7758   with FuncRec do begin
7759     Val :=
7760       Source.Data.r * LUMINANCE_WEIGHT_R +
7761       Source.Data.g * LUMINANCE_WEIGHT_G +
7762       Source.Data.b * LUMINANCE_WEIGHT_B;
7763     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7764   end;
7765 end;
7766
7767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7768 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7769 begin
7770   with FuncRec do
7771     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7772 end;
7773
7774 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7775 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7776 type
7777   TVec = Array[0..2] of Single;
7778 var
7779   Idx: Integer;
7780   du, dv: Double;
7781   Len: Single;
7782   Vec: TVec;
7783
7784   function GetHeight(X, Y: Integer): Single;
7785   begin
7786     with FuncRec do begin
7787       X := Max(0, Min(Size.X -1, X));
7788       Y := Max(0, Min(Size.Y -1, Y));
7789       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7790     end;
7791   end;
7792
7793 begin
7794   with FuncRec do begin
7795     with PglBitmapToNormalMapRec(Args)^ do begin
7796       du := 0;
7797       for Idx := Low(MatrixU) to High(MatrixU) do
7798         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7799
7800       dv := 0;
7801       for Idx := Low(MatrixU) to High(MatrixU) do
7802         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7803
7804       Vec[0] := -du * Scale;
7805       Vec[1] := -dv * Scale;
7806       Vec[2] := 1;
7807     end;
7808
7809     // Normalize
7810     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7811     if Len <> 0 then begin
7812       Vec[0] := Vec[0] * Len;
7813       Vec[1] := Vec[1] * Len;
7814       Vec[2] := Vec[2] * Len;
7815     end;
7816
7817     // Farbe zuweisem
7818     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7819     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7820     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7821   end;
7822 end;
7823
7824 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7825 procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7826 var
7827   Rec: TglBitmapToNormalMapRec;
7828
7829   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7830   begin
7831     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7832       Matrix[Index].X := X;
7833       Matrix[Index].Y := Y;
7834       Matrix[Index].W := W;
7835     end;
7836   end;
7837
7838 begin
7839   if TFormatDescriptor.Get(Format).IsCompressed then
7840     raise EglBitmapUnsupportedFormat.Create(Format);
7841
7842   if aScale > 100 then
7843     Rec.Scale := 100
7844   else if aScale < -100 then
7845     Rec.Scale := -100
7846   else
7847     Rec.Scale := aScale;
7848
7849   SetLength(Rec.Heights, Width * Height);
7850   try
7851     case aFunc of
7852       nm4Samples: begin
7853         SetLength(Rec.MatrixU, 2);
7854         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7855         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7856
7857         SetLength(Rec.MatrixV, 2);
7858         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7859         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7860       end;
7861
7862       nmSobel: begin
7863         SetLength(Rec.MatrixU, 6);
7864         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7865         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7866         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7867         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7868         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7869         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7870
7871         SetLength(Rec.MatrixV, 6);
7872         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7873         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7874         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7875         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7876         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7877         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7878       end;
7879
7880       nm3x3: begin
7881         SetLength(Rec.MatrixU, 6);
7882         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7883         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7884         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7885         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7886         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7887         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7888
7889         SetLength(Rec.MatrixV, 6);
7890         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7891         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7892         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7893         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7894         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7895         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7896       end;
7897
7898       nm5x5: begin
7899         SetLength(Rec.MatrixU, 20);
7900         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7901         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7902         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7903         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7904         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7905         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7906         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7907         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7908         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7909         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7910         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7911         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7912         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7913         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7914         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7915         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7916         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7917         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7918         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7919         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7920
7921         SetLength(Rec.MatrixV, 20);
7922         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7923         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7924         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7925         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7926         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7927         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7928         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7929         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7930         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7931         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7932         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7933         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7934         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7935         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7936         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7937         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7938         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7939         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7940         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7941         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7942       end;
7943     end;
7944
7945     // Daten Sammeln
7946     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7947       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7948     else
7949       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
7950     Convert(glBitmapToNormalMapFunc, false, @Rec);
7951   finally
7952     SetLength(Rec.Heights, 0);
7953   end;
7954 end;
7955
7956 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7957 constructor TglBitmapData.Create;
7958 begin
7959   inherited Create;
7960   fFormat := glBitmapDefaultFormat;
7961 end;
7962
7963 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7964 constructor TglBitmapData.Create(const aFileName: String);
7965 begin
7966   Create;
7967   LoadFromFile(aFileName);
7968 end;
7969
7970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7971 constructor TglBitmapData.Create(const aStream: TStream);
7972 begin
7973   Create;
7974   LoadFromStream(aStream);
7975 end;
7976
7977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7978 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
7979 var
7980   ImageSize: Integer;
7981 begin
7982   Create;
7983   if not Assigned(aData) then begin
7984     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
7985     GetMem(aData, ImageSize);
7986     try
7987       FillChar(aData^, ImageSize, #$FF);
7988       SetData(aData, aFormat, aSize.X, aSize.Y);
7989     except
7990       if Assigned(aData) then
7991         FreeMem(aData);
7992       raise;
7993     end;
7994   end else begin
7995     SetData(aData, aFormat, aSize.X, aSize.Y);
7996   end;
7997 end;
7998
7999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8000 constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
8001 begin
8002   Create;
8003   LoadFromFunc(aSize, aFormat, aFunc, aArgs);
8004 end;
8005
8006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8007 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
8008 begin
8009   Create;
8010   LoadFromResource(aInstance, aResource, aResType);
8011 end;
8012
8013 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8014 constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
8015 begin
8016   Create;
8017   LoadFromResourceID(aInstance, aResourceID, aResType);
8018 end;
8019
8020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8021 destructor TglBitmapData.Destroy;
8022 begin
8023   SetData(nil, tfEmpty);
8024   inherited Destroy;
8025 end;
8026
8027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8028 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8030 function TglBitmap.GetWidth: Integer;
8031 begin
8032   if (ffX in fDimension.Fields) then
8033     result := fDimension.X
8034   else
8035     result := -1;
8036 end;
8037
8038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8039 function TglBitmap.GetHeight: Integer;
8040 begin
8041   if (ffY in fDimension.Fields) then
8042     result := fDimension.Y
8043   else
8044     result := -1;
8045 end;
8046
8047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8048 procedure TglBitmap.SetCustomData(const aValue: Pointer);
8049 begin
8050   if fCustomData = aValue then
8051     exit;
8052   fCustomData := aValue;
8053 end;
8054
8055 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8056 procedure TglBitmap.SetCustomName(const aValue: String);
8057 begin
8058   if fCustomName = aValue then
8059     exit;
8060   fCustomName := aValue;
8061 end;
8062
8063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8064 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
8065 begin
8066   if fCustomNameW = aValue then
8067     exit;
8068   fCustomNameW := aValue;
8069 end;
8070
8071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8072 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
8073 begin
8074   if fDeleteTextureOnFree = aValue then
8075     exit;
8076   fDeleteTextureOnFree := aValue;
8077 end;
8078
8079 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8080 procedure TglBitmap.SetID(const aValue: Cardinal);
8081 begin
8082   if fID = aValue then
8083     exit;
8084   fID := aValue;
8085 end;
8086
8087 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8088 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
8089 begin
8090   if fMipMap = aValue then
8091     exit;
8092   fMipMap := aValue;
8093 end;
8094
8095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8096 procedure TglBitmap.SetTarget(const aValue: Cardinal);
8097 begin
8098   if fTarget = aValue then
8099     exit;
8100   fTarget := aValue;
8101 end;
8102
8103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8104 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
8105 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8106 var
8107   MaxAnisotropic: Integer;
8108 {$IFEND}
8109 begin
8110   fAnisotropic := aValue;
8111   if (ID > 0) then begin
8112 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
8113     if GL_EXT_texture_filter_anisotropic then begin
8114       if fAnisotropic > 0 then begin
8115         Bind(false);
8116         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
8117         if aValue > MaxAnisotropic then
8118           fAnisotropic := MaxAnisotropic;
8119         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
8120       end;
8121     end else begin
8122       fAnisotropic := 0;
8123     end;
8124 {$ELSE}
8125     fAnisotropic := 0;
8126 {$IFEND}
8127   end;
8128 end;
8129
8130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8131 procedure TglBitmap.CreateID;
8132 begin
8133   if (ID <> 0) then
8134     glDeleteTextures(1, @fID);
8135   glGenTextures(1, @fID);
8136   Bind(false);
8137 end;
8138
8139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8140 procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
8141 begin
8142   // Set Up Parameters
8143   SetWrap(fWrapS, fWrapT, fWrapR);
8144   SetFilter(fFilterMin, fFilterMag);
8145   SetAnisotropic(fAnisotropic);
8146
8147 {$IFNDEF OPENGL_ES}
8148   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
8149   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8150     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8151 {$ENDIF}
8152
8153 {$IFNDEF OPENGL_ES}
8154   // Mip Maps Generation Mode
8155   aBuildWithGlu := false;
8156   if (MipMap = mmMipmap) then begin
8157     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
8158       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
8159     else
8160       aBuildWithGlu := true;
8161   end else if (MipMap = mmMipmapGlu) then
8162     aBuildWithGlu := true;
8163 {$ELSE}
8164   if (MipMap = mmMipmap) then
8165     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
8166 {$ENDIF}
8167 end;
8168
8169 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8170 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8172 procedure TglBitmap.AfterConstruction;
8173 begin
8174   inherited AfterConstruction;
8175
8176   fID         := 0;
8177   fTarget     := 0;
8178 {$IFNDEF OPENGL_ES}
8179   fIsResident := false;
8180 {$ENDIF}
8181
8182   fMipMap              := glBitmapDefaultMipmap;
8183   fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
8184
8185   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
8186   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
8187 {$IFNDEF OPENGL_ES}
8188   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
8189 {$ENDIF}
8190 end;
8191
8192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8193 procedure TglBitmap.BeforeDestruction;
8194 begin
8195   if (fID > 0) and fDeleteTextureOnFree then
8196     glDeleteTextures(1, @fID);
8197   inherited BeforeDestruction;
8198 end;
8199
8200 {$IFNDEF OPENGL_ES}
8201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8202 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
8203 begin
8204   fBorderColor[0] := aRed;
8205   fBorderColor[1] := aGreen;
8206   fBorderColor[2] := aBlue;
8207   fBorderColor[3] := aAlpha;
8208   if (ID > 0) then begin
8209     Bind(false);
8210     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
8211   end;
8212 end;
8213 {$ENDIF}
8214
8215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8216 procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
8217 begin
8218   //check MIN filter
8219   case aMin of
8220     GL_NEAREST:
8221       fFilterMin := GL_NEAREST;
8222     GL_LINEAR:
8223       fFilterMin := GL_LINEAR;
8224     GL_NEAREST_MIPMAP_NEAREST:
8225       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
8226     GL_LINEAR_MIPMAP_NEAREST:
8227       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
8228     GL_NEAREST_MIPMAP_LINEAR:
8229       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
8230     GL_LINEAR_MIPMAP_LINEAR:
8231       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
8232     else
8233       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
8234   end;
8235
8236   //check MAG filter
8237   case aMag of
8238     GL_NEAREST:
8239       fFilterMag := GL_NEAREST;
8240     GL_LINEAR:
8241       fFilterMag := GL_LINEAR;
8242     else
8243       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
8244   end;
8245
8246   //apply filter
8247   if (ID > 0) then begin
8248     Bind(false);
8249     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
8250
8251     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
8252       case fFilterMin of
8253         GL_NEAREST, GL_LINEAR:
8254           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8255         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
8256           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
8257         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
8258           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
8259       end;
8260     end else
8261       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
8262   end;
8263 end;
8264
8265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8266 procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
8267
8268   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
8269   begin
8270     case aValue of
8271 {$IFNDEF OPENGL_ES}
8272       GL_CLAMP:
8273         aTarget := GL_CLAMP;
8274 {$ENDIF}
8275
8276       GL_REPEAT:
8277         aTarget := GL_REPEAT;
8278
8279       GL_CLAMP_TO_EDGE: begin
8280 {$IFNDEF OPENGL_ES}
8281         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
8282           aTarget := GL_CLAMP
8283         else
8284 {$ENDIF}
8285           aTarget := GL_CLAMP_TO_EDGE;
8286       end;
8287
8288 {$IFNDEF OPENGL_ES}
8289       GL_CLAMP_TO_BORDER: begin
8290         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
8291           aTarget := GL_CLAMP_TO_BORDER
8292         else
8293           aTarget := GL_CLAMP;
8294       end;
8295 {$ENDIF}
8296
8297 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8298       GL_MIRRORED_REPEAT: begin
8299   {$IFNDEF OPENGL_ES}
8300         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
8301   {$ELSE}
8302         if GL_VERSION_2_0 then
8303   {$ENDIF}
8304           aTarget := GL_MIRRORED_REPEAT
8305         else
8306           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
8307       end;
8308 {$IFEND}
8309     else
8310       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
8311     end;
8312   end;
8313
8314 begin
8315   CheckAndSetWrap(S, fWrapS);
8316   CheckAndSetWrap(T, fWrapT);
8317   CheckAndSetWrap(R, fWrapR);
8318
8319   if (ID > 0) then begin
8320     Bind(false);
8321     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
8322     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
8323 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8324     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
8325     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
8326 {$IFEND}
8327   end;
8328 end;
8329
8330 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8331 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8332 procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
8333
8334   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
8335   begin
8336     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or
8337        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then
8338       fSwizzle[aIndex] := aValue
8339     else
8340       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
8341   end;
8342
8343 begin
8344 {$IFNDEF OPENGL_ES}
8345   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
8346     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8347 {$ELSE}
8348   if not GL_VERSION_3_0 then
8349     raise EglBitmapNotSupported.Create('texture swizzle is not supported');
8350 {$ENDIF}
8351   CheckAndSetValue(r, 0);
8352   CheckAndSetValue(g, 1);
8353   CheckAndSetValue(b, 2);
8354   CheckAndSetValue(a, 3);
8355
8356   if (ID > 0) then begin
8357     Bind(false);
8358 {$IFNDEF OPENGL_ES}
8359     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
8360 {$ELSE}
8361     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
8362     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
8363     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
8364     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
8365 {$ENDIF}
8366   end;
8367 end;
8368 {$IFEND}
8369
8370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8371 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
8372 begin
8373   if aEnableTextureUnit then
8374     glEnable(Target);
8375   if (ID > 0) then
8376     glBindTexture(Target, ID);
8377 end;
8378
8379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8380 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
8381 begin
8382   if aDisableTextureUnit then
8383     glDisable(Target);
8384   glBindTexture(Target, 0);
8385 end;
8386
8387 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8388 procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8389 var
8390   w, h: Integer;
8391 begin
8392   w := aDataObj.Width;
8393   h := aDataObj.Height;
8394   fDimension.Fields := [];
8395   if (w > 0) then
8396     fDimension.Fields := fDimension.Fields + [ffX];
8397   if (h > 0) then
8398     fDimension.Fields := fDimension.Fields + [ffY];
8399   fDimension.X := w;
8400   fDimension.Y := h;
8401 end;
8402
8403 {$IFNDEF OPENGL_ES}
8404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8405 function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
8406 var
8407   Temp: PByte;
8408   TempWidth, TempHeight: Integer;
8409   TempIntFormat: GLint;
8410   IntFormat: TglBitmapFormat;
8411   FormatDesc: TFormatDescriptor;
8412 begin
8413   result := false;
8414   Bind;
8415
8416   // Request Data
8417   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
8418   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
8419   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
8420
8421   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
8422   IntFormat  := FormatDesc.Format;
8423
8424   // Getting data from OpenGL
8425   FormatDesc := TFormatDescriptor.Get(IntFormat);
8426   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
8427   try
8428     if FormatDesc.IsCompressed then begin
8429       if not Assigned(glGetCompressedTexImage) then
8430         raise EglBitmap.Create('compressed formats not supported by video adapter');
8431       glGetCompressedTexImage(Target, 0, Temp)
8432     end else
8433       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8434     aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
8435     result := true;
8436   except
8437     if Assigned(Temp) then
8438       FreeMem(Temp);
8439     raise;
8440   end;
8441 end;
8442 {$ENDIF}
8443
8444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8445 constructor TglBitmap.Create;
8446 begin
8447   if (ClassType = TglBitmap) then
8448     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
8449   inherited Create;
8450 end;
8451
8452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8453 constructor TglBitmap.Create(const aData: TglBitmapData);
8454 begin
8455   Create;
8456   UploadData(aData);
8457 end;
8458
8459 {$IFNDEF OPENGL_ES}
8460 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8461 //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8463 procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
8464 var
8465   fd: TglBitmapFormatDescriptor;
8466 begin
8467   // Upload data
8468   fd := aDataObj.FormatDescriptor;
8469   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8470     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8471
8472   if fd.IsCompressed then begin
8473     if not Assigned(glCompressedTexImage1D) then
8474       raise EglBitmap.Create('compressed formats not supported by video adapter');
8475     glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
8476   end else if aBuildWithGlu then
8477     gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8478   else
8479     glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8480 end;
8481
8482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8483 procedure TglBitmap1D.AfterConstruction;
8484 begin
8485   inherited;
8486   Target := GL_TEXTURE_1D;
8487 end;
8488
8489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8490 procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8491 var
8492   BuildWithGlu, TexRec: Boolean;
8493   TexSize: Integer;
8494 begin
8495   if not Assigned(aDataObj) then
8496     exit;
8497
8498   // Check Texture Size
8499   if (aCheckSize) then begin
8500     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8501
8502     if (aDataObj.Width > TexSize) then
8503       raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8504
8505     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8506               (Target = GL_TEXTURE_RECTANGLE);
8507     if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8508       raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8509   end;
8510
8511   if (fID = 0) then
8512     CreateID;
8513   SetupParameters(BuildWithGlu);
8514   UploadDataIntern(aDataObj, BuildWithGlu);
8515   glAreTexturesResident(1, @fID, @fIsResident);
8516
8517   inherited UploadData(aDataObj, aCheckSize);
8518 end;
8519 {$ENDIF}
8520
8521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8522 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8524 procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
8525 var
8526   fd: TglBitmapFormatDescriptor;
8527 begin
8528   fd := aDataObj.FormatDescriptor;
8529   if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
8530     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
8531
8532   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
8533
8534   if fd.IsCompressed then begin
8535     if not Assigned(glCompressedTexImage2D) then
8536       raise EglBitmap.Create('compressed formats not supported by video adapter');
8537     glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
8538 {$IFNDEF OPENGL_ES}
8539   end else if aBuildWithGlu then begin
8540     gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
8541 {$ENDIF}
8542   end else begin
8543     glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
8544   end;
8545 end;
8546
8547 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8548 procedure TglBitmap2D.AfterConstruction;
8549 begin
8550   inherited;
8551   Target := GL_TEXTURE_2D;
8552 end;
8553
8554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8555 procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8556 var
8557   {$IFNDEF OPENGL_ES}
8558   BuildWithGlu, TexRec: Boolean;
8559   {$ENDIF}
8560   PotTex: Boolean;
8561   TexSize: Integer;
8562 begin
8563   if not Assigned(aDataObj) then
8564     exit;
8565
8566   // Check Texture Size
8567   if (aCheckSize) then begin
8568     glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8569
8570     if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
8571       raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8572
8573     PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
8574 {$IF NOT DEFINED(OPENGL_ES)}
8575     TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
8576     if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8577       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8578 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8579     if not PotTex and not GL_OES_texture_npot then
8580       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8581 {$ELSE}
8582     if not PotTex then
8583       raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8584 {$IFEND}
8585   end;
8586
8587   if (fID = 0) then
8588     CreateID;
8589   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8590   UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8591 {$IFNDEF OPENGL_ES}
8592   glAreTexturesResident(1, @fID, @fIsResident);
8593 {$ENDIF}
8594
8595   inherited UploadData(aDataObj, aCheckSize);
8596 end;
8597
8598 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8599 class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
8600 var
8601   Temp: pByte;
8602   Size, w, h: Integer;
8603   FormatDesc: TFormatDescriptor;
8604 begin
8605   FormatDesc := TFormatDescriptor.Get(aFormat);
8606   if FormatDesc.IsCompressed then
8607     raise EglBitmapUnsupportedFormat.Create(aFormat);
8608
8609   w    := aRight  - aLeft;
8610   h    := aBottom - aTop;
8611   Size := FormatDesc.GetSize(w, h);
8612   GetMem(Temp, Size);
8613   try
8614     glPixelStorei(GL_PACK_ALIGNMENT, 1);
8615     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
8616     aDataObj.SetData(Temp, aFormat, w, h);
8617     aDataObj.FlipVert;
8618   except
8619     if Assigned(Temp) then
8620       FreeMem(Temp);
8621     raise;
8622   end;
8623 end;
8624
8625 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8627 //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8629 procedure TglBitmapCubeMap.AfterConstruction;
8630 begin
8631   inherited;
8632
8633 {$IFNDEF OPENGL_ES}
8634   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8635     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8636 {$ELSE}
8637   if not (GL_VERSION_2_0) then
8638     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8639 {$ENDIF}
8640
8641   SetWrap;
8642   Target   := GL_TEXTURE_CUBE_MAP;
8643 {$IFNDEF OPENGL_ES}
8644   fGenMode := GL_REFLECTION_MAP;
8645 {$ENDIF}
8646 end;
8647
8648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8649 procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
8650 begin
8651   Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
8652 end;
8653
8654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8655 procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
8656 var
8657   {$IFNDEF OPENGL_ES}
8658   BuildWithGlu: Boolean;
8659   {$ENDIF}
8660   TexSize: Integer;
8661 begin
8662   if (aCheckSize) then begin
8663     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8664
8665     if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
8666       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8667
8668 {$IF NOT DEFINED(OPENGL_ES)}
8669     if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8670       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8671 {$ELSEIF DEFINED(OPENGL_ES_EXT)}
8672     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
8673       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8674 {$ELSE}
8675     if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
8676       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
8677 {$IFEND}
8678   end;
8679
8680   if (fID = 0) then
8681     CreateID;
8682   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
8683   UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
8684
8685   inherited UploadData(aDataObj, aCheckSize);
8686 end;
8687
8688 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8689 procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
8690 begin
8691   inherited Bind (aEnableTextureUnit);
8692 {$IFNDEF OPENGL_ES}
8693   if aEnableTexCoordsGen then begin
8694     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8695     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8696     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8697     glEnable(GL_TEXTURE_GEN_S);
8698     glEnable(GL_TEXTURE_GEN_T);
8699     glEnable(GL_TEXTURE_GEN_R);
8700   end;
8701 {$ENDIF}
8702 end;
8703
8704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8705 procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
8706 begin
8707   inherited Unbind(aDisableTextureUnit);
8708 {$IFNDEF OPENGL_ES}
8709   if aDisableTexCoordsGen then begin
8710     glDisable(GL_TEXTURE_GEN_S);
8711     glDisable(GL_TEXTURE_GEN_T);
8712     glDisable(GL_TEXTURE_GEN_R);
8713   end;
8714 {$ENDIF}
8715 end;
8716 {$IFEND}
8717
8718 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
8719 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8720 //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8721 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8722 type
8723   TVec = Array[0..2] of Single;
8724   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8725
8726   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8727   TglBitmapNormalMapRec = record
8728     HalfSize : Integer;
8729     Func: TglBitmapNormalMapGetVectorFunc;
8730   end;
8731
8732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8733 procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8734 begin
8735   aVec[0] := aHalfSize;
8736   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8737   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
8738 end;
8739
8740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8741 procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8742 begin
8743   aVec[0] := - aHalfSize;
8744   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8745   aVec[2] := aPosition.X + 0.5 - aHalfSize;
8746 end;
8747
8748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8749 procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8750 begin
8751   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8752   aVec[1] := aHalfSize;
8753   aVec[2] := aPosition.Y + 0.5 - aHalfSize;
8754 end;
8755
8756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8757 procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8758 begin
8759   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8760   aVec[1] := - aHalfSize;
8761   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
8762 end;
8763
8764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8765 procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8766 begin
8767   aVec[0] := aPosition.X + 0.5 - aHalfSize;
8768   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8769   aVec[2] := aHalfSize;
8770 end;
8771
8772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8773 procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
8774 begin
8775   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
8776   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
8777   aVec[2] := - aHalfSize;
8778 end;
8779
8780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8781 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8782 var
8783   i: Integer;
8784   Vec: TVec;
8785   Len: Single;
8786 begin
8787   with FuncRec do begin
8788     with PglBitmapNormalMapRec(Args)^ do begin
8789       Func(Vec, Position, HalfSize);
8790
8791       // Normalize
8792       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8793       if Len <> 0 then begin
8794         Vec[0] := Vec[0] * Len;
8795         Vec[1] := Vec[1] * Len;
8796         Vec[2] := Vec[2] * Len;
8797       end;
8798
8799       // Scale Vector and AddVectro
8800       Vec[0] := Vec[0] * 0.5 + 0.5;
8801       Vec[1] := Vec[1] * 0.5 + 0.5;
8802       Vec[2] := Vec[2] * 0.5 + 0.5;
8803     end;
8804
8805     // Set Color
8806     for i := 0 to 2 do
8807       Dest.Data.arr[i] := Round(Vec[i] * 255);
8808   end;
8809 end;
8810
8811 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8812 procedure TglBitmapNormalMap.AfterConstruction;
8813 begin
8814   inherited;
8815 {$IFNDEF OPENGL_ES}
8816   fGenMode := GL_NORMAL_MAP;
8817 {$ENDIF}
8818 end;
8819
8820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
8821 procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
8822 var
8823   Rec: TglBitmapNormalMapRec;
8824   SizeRec: TglBitmapSize;
8825   DataObj: TglBitmapData;
8826 begin
8827   Rec.HalfSize := aSize div 2;
8828
8829   SizeRec.Fields := [ffX, ffY];
8830   SizeRec.X := aSize;
8831   SizeRec.Y := aSize;
8832
8833   DataObj := TglBitmapData.Create;
8834   try
8835     // Positive X
8836     Rec.Func := glBitmapNormalMapPosX;
8837     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8838     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
8839
8840     // Negative X
8841     Rec.Func := glBitmapNormalMapNegX;
8842     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8843     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
8844
8845     // Positive Y
8846     Rec.Func := glBitmapNormalMapPosY;
8847     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8848     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
8849
8850     // Negative Y
8851     Rec.Func := glBitmapNormalMapNegY;
8852     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8853     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
8854
8855     // Positive Z
8856     Rec.Func := glBitmapNormalMapPosZ;
8857     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8858     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
8859
8860     // Negative Z
8861     Rec.Func := glBitmapNormalMapNegZ;
8862     DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
8863     UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
8864   finally
8865     FreeAndNil(DataObj);
8866   end;
8867 end;
8868 {$IFEND}
8869
8870 initialization
8871   glBitmapSetDefaultFormat (tfEmpty);
8872   glBitmapSetDefaultMipmap (mmMipmap);
8873   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8874   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8875 {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
8876   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
8877 {$IFEND}
8878
8879   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8880   glBitmapSetDefaultDeleteTextureOnFree    (true);
8881
8882   TFormatDescriptor.Init;
8883
8884 finalization
8885   TFormatDescriptor.Finalize;
8886
8887 end.