ddee6ca8afac6cba485f0201fdb858f5f4656d77
[glBitmap.git] / glBitmap.pas
1 {***********************************************************
2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
4
5 modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
6
7 ------------------------------------------------------------
8 The contents of this file are used with permission, subject to
9 the Mozilla Public License Version 1.1 (the "License"); you may
10 not use this file except in compliance with the License. You may
11 obtain a copy of the License at
12 http://www.mozilla.org/MPL/MPL-1.1.html
13 ------------------------------------------------------------
14 Version 3.0.1
15 ------------------------------------------------------------
16 History
17 20-11-2013
18 - refactoring of the complete library
19 21-03-2010
20 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
21   then it's your problem if that isn't true. This prevents the unit for incompatibility
22   with newer versions of Delphi.
23 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
24 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
25 10-08-2008
26 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
27 - Additional Datapointer for functioninterface now has the name CustomData
28 24-07-2008
29 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
30 - If you load an texture from an file the property Filename will be set to the name of the file
31 - Three new properties to attach custom data to the Texture objects
32   - CustomName  (free for use string)
33   - CustomNameW (free for use widestring)
34   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
35 27-05-2008
36 - RLE TGAs loaded much faster
37 26-05-2008
38 - fixed some problem with reading RLE TGAs.
39 21-05-2008
40 - function clone now only copys data if it's assigned and now it also copies the ID
41 - it seems that lazarus dont like comments in comments.
42 01-05-2008
43 - It's possible to set the id of the texture
44 - define GLB_NO_NATIVE_GL deactivated by default
45 27-04-2008
46 - Now supports the following libraries
47   - SDL and SDL_image
48   - libPNG
49   - libJPEG
50 - Linux compatibillity via free pascal compatibility (delphi sources optional)
51 - BMPs now loaded manuel
52 - Large restructuring
53 - Property DataPtr now has the name Data
54 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
55 - Unused Depth removed
56 - Function FreeData to freeing image data added
57 24-10-2007
58 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
59 15-11-2006
60 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
61 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
62 - Function ReadOpenGLExtension is now only intern
63 29-06-2006
64 - pngimage now disabled by default like all other versions.
65 26-06-2006
66 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
67 22-06-2006
68 - Fixed some Problem with Delphi 5
69 - Now uses the newest version of pngimage. Makes saving pngs much easier.
70 22-03-2006
71 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
72 09-03-2006
73 - Internal Format ifDepth8 added
74 - function GrabScreen now supports all uncompressed formats
75 31-01-2006
76 - AddAlphaFromglBitmap implemented
77 29-12-2005
78 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
79 28-12-2005
80 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
81   property Width, Height, Depth are still existing and new property Dimension are avail
82 11-12-2005
83 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
84 19-10-2005
85 - Added function GrabScreen to class TglBitmap2D
86 18-10-2005
87 - Added support to Save images
88 - Added function Clone to Clone Instance
89 11-10-2005
90 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
91   Usefull for Future
92 - Several speed optimizations
93 09-10-2005
94 - Internal structure change. Loading of TGA, PNG and DDS improved.
95   Data, format and size will now set directly with SetDataPtr.
96 - AddFunc now works with all Types of Images and Formats
97 - Some Funtions moved to Baseclass TglBitmap
98 06-10-2005
99 - Added Support to decompress DXT3 and DXT5 compressed Images.
100 - Added Mapping to convert data from one format into an other.
101 05-10-2005
102 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
103   supported Input format (supported by GetPixel) into any uncompresed Format
104 - Added Support to decompress DXT1 compressed Images.
105 - SwapColors replaced by ConvertTo
106 04-10-2005
107 - Added Support for compressed DDSs
108 - Added new internal formats (DXT1, DXT3, DXT5)
109 29-09-2005
110 - Parameter Components renamed to InternalFormat
111 23-09-2005
112 - Some AllocMem replaced with GetMem (little speed change)
113 - better exception handling. Better protection from memory leaks.
114 22-09-2005
115 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
116 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
117 07-09-2005
118 - Added support for Grayscale textures
119 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
120 10-07-2005
121 - Added support for GL_VERSION_2_0
122 - Added support for GL_EXT_texture_filter_anisotropic
123 04-07-2005
124 - Function FillWithColor fills the Image with one Color
125 - Function LoadNormalMap added
126 30-06-2005
127 - ToNormalMap allows to Create an NormalMap from the Alphachannel
128 - ToNormalMap now supports Sobel (nmSobel) function.
129 29-06-2005
130 - support for RLE Compressed RGB TGAs added
131 28-06-2005
132 - Class TglBitmapNormalMap added to support Normalmap generation
133 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
134   3 Filters are supported. (4 Samples, 3x3 and 5x5)
135 16-06-2005
136 - Method LoadCubeMapClass removed
137 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
138 - virtual abstract method GenTexture in class TglBitmap now is protected
139 12-06-2005
140 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
141 10-06-2005
142 - little enhancement for IsPowerOfTwo
143 - TglBitmap1D.GenTexture now tests NPOT Textures
144 06-06-2005
145 - some little name changes. All properties or function with Texture in name are
146   now without texture in name. We have allways texture so we dosn't name it.
147 03-06-2005
148 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
149   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
150 02-06-2005
151 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
152 25-04-2005
153 - Function Unbind added
154 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
155 21-04-2005
156 - class TglBitmapCubeMap added (allows to Create Cubemaps)
157 29-03-2005
158 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
159   To Enable png's use the define pngimage
160 22-03-2005
161 - New Functioninterface added
162 - Function GetPixel added
163 27-11-2004
164 - Property BuildMipMaps renamed to MipMap
165 21-11-2004
166 - property Name removed.
167 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
168 22-05-2004
169 - property name added. Only used in glForms!
170 26-11-2003
171 - property FreeDataAfterGenTexture is now available as default (default = true)
172 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
173 - function MoveMemory replaced with function Move (little speed change)
174 - several calculations stored in variables (little speed change)
175 29-09-2003
176 - property BuildMipsMaps added (default = true)
177   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
178 - property FreeDataAfterGenTexture added (default = true)
179   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
180 - parameter DisableOtherTextureUnits of Bind removed
181 - parameter FreeDataAfterGeneration of GenTextures removed
182 12-09-2003
183 - TglBitmap dosn't delete data if class was destroyed (fixed)
184 09-09-2003
185 - Bind now enables TextureUnits (by params)
186 - GenTextures can leave data (by param)
187 - LoadTextures now optimal
188 03-09-2003
189 - Performance optimization in AddFunc
190 - procedure Bind moved to subclasses
191 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
192 19-08-2003
193 - Texturefilter and texturewrap now also as defaults
194   Minfilter = GL_LINEAR_MIPMAP_LINEAR
195   Magfilter = GL_LINEAR
196   Wrap(str) = GL_CLAMP_TO_EDGE
197 - Added new format tfCompressed to create a compressed texture.
198 - propertys IsCompressed, TextureSize and IsResident added
199   IsCompressed and TextureSize only contains data from level 0
200 18-08-2003
201 - Added function AddFunc to add PerPixelEffects to Image
202 - LoadFromFunc now based on AddFunc
203 - Invert now based on AddFunc
204 - SwapColors now based on AddFunc
205 16-08-2003
206 - Added function FlipHorz
207 15-08-2003
208 - Added function LaodFromFunc to create images with function
209 - Added function FlipVert
210 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
211 29-07-2003
212 - Added Alphafunctions to calculate alpha per function
213 - Added Alpha from ColorKey using alphafunctions
214 28-07-2003
215 - First full functionally Version of glBitmap
216 - Support for 24Bit and 32Bit TGA Pictures added
217 25-07-2003
218 - begin of programming
219 ***********************************************************}
220 unit glBitmap;
221
222 // Please uncomment the defines below to configure the glBitmap to your preferences.
223 // If you have configured the unit you can uncomment the warning above.
224 {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
225
226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
227 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
228 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
229 // activate to enable build-in OpenGL support with statically linked methods
230 // use dglOpenGL.pas if not enabled
231 {.$DEFINE GLB_NATIVE_OGL_STATIC}
232
233 // activate to enable build-in OpenGL support with dynamically linked methods
234 // use dglOpenGL.pas if not enabled
235 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
236
237
238 // activate to enable the support for SDL_surfaces
239 {.$DEFINE GLB_SDL}
240
241 // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
242 {.$DEFINE GLB_DELPHI}
243
244 // activate to enable the support for TLazIntfImage from Lazarus
245 {.$DEFINE GLB_LAZARUS}
246
247
248
249 // activate to enable the support of SDL_image to load files. (READ ONLY)
250 // If you enable SDL_image all other libraries will be ignored!
251 {.$DEFINE GLB_SDL_IMAGE}
252
253
254
255 // activate to enable Lazarus TPortableNetworkGraphic support
256 // if you enable this pngImage and libPNG will be ignored
257 {.$DEFINE GLB_LAZ_PNG}
258
259 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
260 // if you enable pngimage the libPNG will be ignored
261 {.$DEFINE GLB_PNGIMAGE}
262
263 // activate to use the libPNG -> http://www.libpng.org/
264 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
265 {.$DEFINE GLB_LIB_PNG}
266
267
268
269 // activate to enable Lazarus TJPEGImage support
270 // if you enable this delphi jpegs and libJPEG will be ignored
271 {.$DEFINE GLB_LAZ_JPEG}
272
273 // if you enable delphi jpegs the libJPEG will be ignored
274 {.$DEFINE GLB_DELPHI_JPEG}
275
276 // activate to use the libJPEG -> http://www.ijg.org/
277 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
278 {.$DEFINE GLB_LIB_JPEG}
279
280
281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
282 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
284 // Delphi Versions
285 {$IFDEF fpc}
286   {$MODE Delphi}
287
288   {$IFDEF CPUI386}
289     {$DEFINE CPU386}
290     {$ASMMODE INTEL}
291   {$ENDIF}
292
293   {$IFNDEF WINDOWS}
294     {$linklib c}
295   {$ENDIF}
296 {$ENDIF}
297
298 // Operation System
299 {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
300   {$DEFINE GLB_WIN}
301 {$ELSEIF DEFINED(LINUX)}
302   {$DEFINE GLB_LINUX}
303 {$IFEND}
304
305 // native OpenGL Support
306 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
307   {$DEFINE GLB_NATIVE_OGL}
308 {$IFEND}
309
310 // checking define combinations
311 //SDL Image
312 {$IFDEF GLB_SDL_IMAGE}
313   {$IFNDEF GLB_SDL}
314     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
315     {$DEFINE GLB_SDL}
316   {$ENDIF}
317
318   {$IFDEF GLB_LAZ_PNG}
319     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
320     {$undef GLB_LAZ_PNG}
321   {$ENDIF}
322
323   {$IFDEF GLB_PNGIMAGE}
324     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
325     {$undef GLB_PNGIMAGE}
326   {$ENDIF}
327
328   {$IFDEF GLB_LAZ_JPEG}
329     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
330     {$undef GLB_LAZ_JPEG}
331   {$ENDIF}
332
333   {$IFDEF GLB_DELPHI_JPEG}
334     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
335     {$undef GLB_DELPHI_JPEG}
336   {$ENDIF}
337
338   {$IFDEF GLB_LIB_PNG}
339     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
340     {$undef GLB_LIB_PNG}
341   {$ENDIF}
342
343   {$IFDEF GLB_LIB_JPEG}
344     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
345     {$undef GLB_LIB_JPEG}
346   {$ENDIF}
347
348   {$DEFINE GLB_SUPPORT_PNG_READ}
349   {$DEFINE GLB_SUPPORT_JPEG_READ}
350 {$ENDIF}
351
352 // Lazarus TPortableNetworkGraphic
353 {$IFDEF GLB_LAZ_PNG}
354   {$IFNDEF GLB_LAZARUS}
355     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
356     {$DEFINE GLB_LAZARUS}
357   {$ENDIF}
358
359   {$IFDEF GLB_PNGIMAGE}
360     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
361     {$undef GLB_PNGIMAGE}
362   {$ENDIF}
363
364   {$IFDEF GLB_LIB_PNG}
365     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
366     {$undef GLB_LIB_PNG}
367   {$ENDIF}
368
369   {$DEFINE GLB_SUPPORT_PNG_READ}
370   {$DEFINE GLB_SUPPORT_PNG_WRITE}
371 {$ENDIF}
372
373 // PNG Image
374 {$IFDEF GLB_PNGIMAGE}
375   {$IFDEF GLB_LIB_PNG}
376     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
377     {$undef GLB_LIB_PNG}
378   {$ENDIF}
379
380   {$DEFINE GLB_SUPPORT_PNG_READ}
381   {$DEFINE GLB_SUPPORT_PNG_WRITE}
382 {$ENDIF}
383
384 // libPNG
385 {$IFDEF GLB_LIB_PNG}
386   {$DEFINE GLB_SUPPORT_PNG_READ}
387   {$DEFINE GLB_SUPPORT_PNG_WRITE}
388 {$ENDIF}
389
390 // Lazarus TJPEGImage
391 {$IFDEF GLB_LAZ_JPEG}
392   {$IFNDEF GLB_LAZARUS}
393     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
394     {$DEFINE GLB_LAZARUS}
395   {$ENDIF}
396
397   {$IFDEF GLB_DELPHI_JPEG}
398     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
399     {$undef GLB_DELPHI_JPEG}
400   {$ENDIF}
401
402   {$IFDEF GLB_LIB_JPEG}
403     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
404     {$undef GLB_LIB_JPEG}
405   {$ENDIF}
406
407   {$DEFINE GLB_SUPPORT_JPEG_READ}
408   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
409 {$ENDIF}
410
411 // JPEG Image
412 {$IFDEF GLB_DELPHI_JPEG}
413   {$IFDEF GLB_LIB_JPEG}
414     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
415     {$undef GLB_LIB_JPEG}
416   {$ENDIF}
417
418   {$DEFINE GLB_SUPPORT_JPEG_READ}
419   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
420 {$ENDIF}
421
422 // libJPEG
423 {$IFDEF GLB_LIB_JPEG}
424   {$DEFINE GLB_SUPPORT_JPEG_READ}
425   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
426 {$ENDIF}
427
428 // native OpenGL
429 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
430   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
431 {$IFEND}
432
433 // general options
434 {$EXTENDEDSYNTAX ON}
435 {$LONGSTRINGS ON}
436 {$ALIGN ON}
437 {$IFNDEF FPC}
438   {$OPTIMIZATION ON}
439 {$ENDIF}
440
441 interface
442
443 uses
444   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                          {$ENDIF}
445   {$IF DEFINED(GLB_WIN) AND
446        (DEFINED(GLB_NATIVE_OGL) OR
447         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}
448
449   {$IFDEF GLB_SDL}              SDL,                                {$ENDIF}
450   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}
451   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}
452
453   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                          {$ENDIF}
454   {$IFDEF GLB_PNGIMAGE}         pngimage,                           {$ENDIF}
455   {$IFDEF GLB_LIB_PNG}          libPNG,                             {$ENDIF}
456   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                               {$ENDIF}
457   {$IFDEF GLB_LIB_JPEG}         libJPEG,                            {$ENDIF}
458
459   Classes, SysUtils;
460
461 {$IFDEF GLB_NATIVE_OGL}
462 const
463   GL_TRUE   = 1;
464   GL_FALSE  = 0;
465
466   GL_ZERO = 0;
467   GL_ONE  = 1;
468
469   GL_VERSION    = $1F02;
470   GL_EXTENSIONS = $1F03;
471
472   GL_TEXTURE_1D         = $0DE0;
473   GL_TEXTURE_2D         = $0DE1;
474   GL_TEXTURE_RECTANGLE  = $84F5;
475
476   GL_NORMAL_MAP                   = $8511;
477   GL_TEXTURE_CUBE_MAP             = $8513;
478   GL_REFLECTION_MAP               = $8512;
479   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;
480   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;
481   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;
482   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;
483   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;
484   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;
485
486   GL_TEXTURE_WIDTH            = $1000;
487   GL_TEXTURE_HEIGHT           = $1001;
488   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
489   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;
490
491   GL_S = $2000;
492   GL_T = $2001;
493   GL_R = $2002;
494   GL_Q = $2003;
495
496   GL_TEXTURE_GEN_S = $0C60;
497   GL_TEXTURE_GEN_T = $0C61;
498   GL_TEXTURE_GEN_R = $0C62;
499   GL_TEXTURE_GEN_Q = $0C63;
500
501   GL_RED    = $1903;
502   GL_GREEN  = $1904;
503   GL_BLUE   = $1905;
504
505   GL_ALPHA    = $1906;
506   GL_ALPHA4   = $803B;
507   GL_ALPHA8   = $803C;
508   GL_ALPHA12  = $803D;
509   GL_ALPHA16  = $803E;
510
511   GL_LUMINANCE    = $1909;
512   GL_LUMINANCE4   = $803F;
513   GL_LUMINANCE8   = $8040;
514   GL_LUMINANCE12  = $8041;
515   GL_LUMINANCE16  = $8042;
516
517   GL_LUMINANCE_ALPHA      = $190A;
518   GL_LUMINANCE4_ALPHA4    = $8043;
519   GL_LUMINANCE6_ALPHA2    = $8044;
520   GL_LUMINANCE8_ALPHA8    = $8045;
521   GL_LUMINANCE12_ALPHA4   = $8046;
522   GL_LUMINANCE12_ALPHA12  = $8047;
523   GL_LUMINANCE16_ALPHA16  = $8048;
524
525   GL_RGB      = $1907;
526   GL_BGR      = $80E0;
527   GL_R3_G3_B2 = $2A10;
528   GL_RGB4     = $804F;
529   GL_RGB5     = $8050;
530   GL_RGB565   = $8D62;
531   GL_RGB8     = $8051;
532   GL_RGB10    = $8052;
533   GL_RGB12    = $8053;
534   GL_RGB16    = $8054;
535
536   GL_RGBA     = $1908;
537   GL_BGRA     = $80E1;
538   GL_RGBA2    = $8055;
539   GL_RGBA4    = $8056;
540   GL_RGB5_A1  = $8057;
541   GL_RGBA8    = $8058;
542   GL_RGB10_A2 = $8059;
543   GL_RGBA12   = $805A;
544   GL_RGBA16   = $805B;
545
546   GL_DEPTH_COMPONENT    = $1902;
547   GL_DEPTH_COMPONENT16  = $81A5;
548   GL_DEPTH_COMPONENT24  = $81A6;
549   GL_DEPTH_COMPONENT32  = $81A7;
550
551   GL_COMPRESSED_RGB                 = $84ED;
552   GL_COMPRESSED_RGBA                = $84EE;
553   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
554   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
555   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
556   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
557
558   GL_UNSIGNED_BYTE            = $1401;
559   GL_UNSIGNED_BYTE_3_3_2      = $8032;
560   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
561
562   GL_UNSIGNED_SHORT             = $1403;
563   GL_UNSIGNED_SHORT_5_6_5       = $8363;
564   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
565   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
566   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
567   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
568   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
569
570   GL_UNSIGNED_INT                 = $1405;
571   GL_UNSIGNED_INT_8_8_8_8         = $8035;
572   GL_UNSIGNED_INT_10_10_10_2      = $8036;
573   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
574   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
575
576   { Texture Filter }
577   GL_TEXTURE_MAG_FILTER     = $2800;
578   GL_TEXTURE_MIN_FILTER     = $2801;
579   GL_NEAREST                = $2600;
580   GL_NEAREST_MIPMAP_NEAREST = $2700;
581   GL_NEAREST_MIPMAP_LINEAR  = $2702;
582   GL_LINEAR                 = $2601;
583   GL_LINEAR_MIPMAP_NEAREST  = $2701;
584   GL_LINEAR_MIPMAP_LINEAR   = $2703;
585
586   { Texture Wrap }
587   GL_TEXTURE_WRAP_S   = $2802;
588   GL_TEXTURE_WRAP_T   = $2803;
589   GL_TEXTURE_WRAP_R   = $8072;
590   GL_CLAMP            = $2900;
591   GL_REPEAT           = $2901;
592   GL_CLAMP_TO_EDGE    = $812F;
593   GL_CLAMP_TO_BORDER  = $812D;
594   GL_MIRRORED_REPEAT  = $8370;
595
596   { Other }
597   GL_GENERATE_MIPMAP      = $8191;
598   GL_TEXTURE_BORDER_COLOR = $1004;
599   GL_MAX_TEXTURE_SIZE     = $0D33;
600   GL_PACK_ALIGNMENT       = $0D05;
601   GL_UNPACK_ALIGNMENT     = $0CF5;
602
603   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
604   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
605   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;
606   GL_TEXTURE_GEN_MODE               = $2500;
607
608 {$IF DEFINED(GLB_WIN)}
609   libglu    = 'glu32.dll';
610   libopengl = 'opengl32.dll';
611 {$ELSEIF DEFINED(GLB_LINUX)}
612   libglu    = 'libGLU.so.1';
613   libopengl = 'libGL.so.1';
614 {$IFEND}
615
616 type
617   GLboolean = BYTEBOOL;
618   GLint     = Integer;
619   GLsizei   = Integer;
620   GLuint    = Cardinal;
621   GLfloat   = Single;
622   GLenum    = Cardinal;
623
624   PGLvoid    = Pointer;
625   PGLboolean = ^GLboolean;
626   PGLint     = ^GLint;
627   PGLuint    = ^GLuint;
628   PGLfloat   = ^GLfloat;
629
630   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
631   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
632   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
633
634 {$IF DEFINED(GLB_WIN)}
635   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
636 {$ELSEIF DEFINED(GLB_LINUX)}
637   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
638   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
639 {$IFEND}
640
641 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
642   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
643   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
644
645   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
646   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
647
648   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
649   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
650   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
651   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
652   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
653   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
654   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
655
656   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
657   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
658   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
659   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
660
661   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
662   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
663   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
664
665   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
666   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
667   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
668
669   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
670   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
671
672 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
673   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
674   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
675
676   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
677   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
678
679   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
680   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
681   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
682   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
683   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
684   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
685   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
686
687   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
688   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
689   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
690   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
691
692   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
693   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
694   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
695
696   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
697   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
698   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
699
700   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
701   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
702 {$IFEND}
703
704 var
705   GL_VERSION_1_2,
706   GL_VERSION_1_3,
707   GL_VERSION_1_4,
708   GL_VERSION_2_0,
709   GL_VERSION_3_3,
710
711   GL_SGIS_generate_mipmap,
712
713   GL_ARB_texture_border_clamp,
714   GL_ARB_texture_mirrored_repeat,
715   GL_ARB_texture_rectangle,
716   GL_ARB_texture_non_power_of_two,
717   GL_ARB_texture_swizzle,
718   GL_ARB_texture_cube_map,
719
720   GL_IBM_texture_mirrored_repeat,
721
722   GL_NV_texture_rectangle,
723
724   GL_EXT_texture_edge_clamp,
725   GL_EXT_texture_rectangle,
726   GL_EXT_texture_swizzle,
727   GL_EXT_texture_cube_map,
728   GL_EXT_texture_filter_anisotropic: Boolean;
729
730   glCompressedTexImage1D: TglCompressedTexImage1D;
731   glCompressedTexImage2D: TglCompressedTexImage2D;
732   glGetCompressedTexImage: TglGetCompressedTexImage;
733
734 {$IF DEFINED(GLB_WIN)}
735   wglGetProcAddress: TwglGetProcAddress;
736 {$ELSEIF DEFINED(GLB_LINUX)}
737   glXGetProcAddress: TglXGetProcAddress;
738   glXGetProcAddressARB: TglXGetProcAddress;
739 {$IFEND}
740
741 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
742   glEnable: TglEnable;
743   glDisable: TglDisable;
744
745   glGetString: TglGetString;
746   glGetIntegerv: TglGetIntegerv;
747
748   glTexParameteri: TglTexParameteri;
749   glTexParameteriv: TglTexParameteriv;
750   glTexParameterfv: TglTexParameterfv;
751   glGetTexParameteriv: TglGetTexParameteriv;
752   glGetTexParameterfv: TglGetTexParameterfv;
753   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
754   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
755
756   glTexGeni: TglTexGeni;
757   glGenTextures: TglGenTextures;
758   glBindTexture: TglBindTexture;
759   glDeleteTextures: TglDeleteTextures;
760
761   glAreTexturesResident: TglAreTexturesResident;
762   glReadPixels: TglReadPixels;
763   glPixelStorei: TglPixelStorei;
764
765   glTexImage1D: TglTexImage1D;
766   glTexImage2D: TglTexImage2D;
767   glGetTexImage: TglGetTexImage;
768
769   gluBuild1DMipmaps: TgluBuild1DMipmaps;
770   gluBuild2DMipmaps: TgluBuild2DMipmaps;
771 {$ENDIF}
772 {$ENDIF}
773
774 type
775 ////////////////////////////////////////////////////////////////////////////////////////////////////
776 // the name of formats is composed of the following constituents:
777 // - multiple chanals:
778 //    - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved)
779 //    - width of the chanel in bit       (4, 8, 16, ...)
780 // - data type                           (e.g. ub, us, ui)
781 // - number of data types
782
783 {$IFNDEF fpc}
784   QWord   = System.UInt64;
785   PQWord  = ^QWord;
786
787   PtrInt  = Longint;
788   PtrUInt = DWord;
789 {$ENDIF}
790
791   TglBitmapFormat = (
792     tfEmpty = 0,                //must be smallest value!
793
794     tfAlpha4ub1,                // 1 x unsigned byte
795     tfAlpha8ub1,                // 1 x unsigned byte
796     tfAlpha16us1,               // 1 x unsigned short
797
798     tfLuminance4ub1,            // 1 x unsigned byte
799     tfLuminance8ub1,            // 1 x unsigned byte
800     tfLuminance16us1,           // 1 x unsigned short
801
802     tfLuminance4Alpha4ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
803     tfLuminance6Alpha2ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
804     tfLuminance8Alpha8ub2,      // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
805     tfLuminance12Alpha4us2,     // 1 x unsigned short (lum), 1 x unsigned short (alpha)
806     tfLuminance16Alpha16us2,    // 1 x unsigned short (lum), 1 x unsigned short (alpha)
807
808     tfR3G3B2ub1,                // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
809     tfRGBX4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
810     tfXRGB4us1,                 // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
811     tfR5G6B5us1,                // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
812     tfRGB5X1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
813     tfX1RGB5us1,                // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
814     tfRGB8ub3,                  // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
815     tfRGBX8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
816     tfXRGB8ui1,                 // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
817     tfRGB10X2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
818     tfX2RGB10ui1,               // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
819     tfRGB16us3,                 // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
820
821     tfRGBA4us1,                 // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
822     tfARGB4us1,                 // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
823     tfRGB5A1us1,                // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
824     tfA1RGB5us1,                // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
825     tfRGBA8ui1,                 // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
826     tfARGB8ui1,                 // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
827     tfRGBA8ub4,                 // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
828     tfRGB10A2ui1,               // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
829     tfA2RGB10ui1,               // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
830     tfRGBA16us4,                // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
831
832     tfBGRX4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
833     tfXBGR4us1,                 // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
834     tfB5G6R5us1,                // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
835     tfBGR5X1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
836     tfX1BGR5us1,                // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
837     tfBGR8ub3,                  // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
838     tfBGRX8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
839     tfXBGR8ui1,                 // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
840     tfBGR10X2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
841     tfX2BGR10ui1,               // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
842     tfBGR16us3,                 // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
843
844     tfBGRA4us1,                 // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
845     tfABGR4us1,                 // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
846     tfBGR5A1us1,                // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
847     tfA1BGR5us1,                // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
848     tfBGRA8ui1,                 // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
849     tfABGR8ui1,                 // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
850     tfBGRA8ub4,                 // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
851     tfBGR10A2ui1,               // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
852     tfA2BGR10ui1,               // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
853     tfBGRA16us4,                // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
854
855     tfDepth16us1,               // 1 x unsigned short (depth)
856     tfDepth24ui1,               // 1 x unsigned int (depth)
857     tfDepth32ui1,               // 1 x unsigned int (depth)
858
859     tfS3tcDtx1RGBA,
860     tfS3tcDtx3RGBA,
861     tfS3tcDtx5RGBA
862   );
863
864   TglBitmapFileType = (
865      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
866      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
867      ftDDS,
868      ftTGA,
869      ftBMP,
870      ftRAW);
871    TglBitmapFileTypes = set of TglBitmapFileType;
872
873    TglBitmapMipMap = (
874      mmNone,
875      mmMipmap,
876      mmMipmapGlu);
877
878    TglBitmapNormalMapFunc = (
879      nm4Samples,
880      nmSobel,
881      nm3x3,
882      nm5x5);
883
884  ////////////////////////////////////////////////////////////////////////////////////////////////////
885    EglBitmap                  = class(Exception);
886    EglBitmapNotSupported      = class(Exception);
887    EglBitmapSizeToLarge       = class(EglBitmap);
888    EglBitmapNonPowerOfTwo     = class(EglBitmap);
889    EglBitmapUnsupportedFormat = class(EglBitmap)
890    public
891      constructor Create(const aFormat: TglBitmapFormat); overload;
892      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
893    end;
894
895 ////////////////////////////////////////////////////////////////////////////////////////////////////
896   TglBitmapRec4ui = packed record
897   case Integer of
898     0: (r, g, b, a: Cardinal);
899     1: (arr: array[0..3] of Cardinal);
900   end;
901
902   TglBitmapRec4ub = packed record
903   case Integer of
904     0: (r, g, b, a: Byte);
905     1: (arr: array[0..3] of Byte);
906   end;
907
908   TglBitmapRec4ul = packed record
909   case Integer of
910     0: (r, g, b, a: QWord);
911     1: (arr: array[0..3] of QWord);
912   end;
913
914   TglBitmapFormatDescriptor = class(TObject)
915   private
916     // cached properties
917     fBytesPerPixel: Single;
918     fChannelCount: Integer;
919     fMask: TglBitmapRec4ul;
920     fRange: TglBitmapRec4ui;
921
922     function GetHasRed: Boolean;
923     function GetHasGreen: Boolean;
924     function GetHasBlue: Boolean;
925     function GetHasAlpha: Boolean;
926     function GetHasColor: Boolean;
927     function GetIsGrayscale: Boolean;
928   protected
929     fFormat:        TglBitmapFormat;
930     fWithAlpha:     TglBitmapFormat;
931     fWithoutAlpha:  TglBitmapFormat;
932     fOpenGLFormat:  TglBitmapFormat;
933     fRGBInverted:   TglBitmapFormat;
934     fUncompressed:  TglBitmapFormat;
935
936     fBitsPerPixel: Integer;
937     fIsCompressed: Boolean;
938
939     fPrecision: TglBitmapRec4ub;
940     fShift:     TglBitmapRec4ub;
941
942     fglFormat:         GLenum;
943     fglInternalFormat: GLenum;
944     fglDataFormat:     GLenum;
945
946     procedure SetValues; virtual;
947     procedure CalcValues;
948   public
949     property Format:        TglBitmapFormat read fFormat;
950     property ChannelCount:  Integer         read fChannelCount;
951     property IsCompressed:  Boolean         read fIsCompressed;
952     property BitsPerPixel:  Integer         read fBitsPerPixel;
953     property BytesPerPixel: Single          read fBytesPerPixel;
954
955     property Precision: TglBitmapRec4ub read fPrecision;
956     property Shift:     TglBitmapRec4ub read fShift;
957     property Range:     TglBitmapRec4ui read fRange;
958     property Mask:      TglBitmapRec4ul read fMask;
959
960     property RGBInverted:  TglBitmapFormat read fRGBInverted;
961     property WithAlpha:    TglBitmapFormat read fWithAlpha;
962     property WithoutAlpha: TglBitmapFormat read fWithAlpha;
963     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
964     property Uncompressed: TglBitmapFormat read fUncompressed;
965
966     property glFormat:         GLenum  read fglFormat;
967     property glInternalFormat: GLenum  read fglInternalFormat;
968     property glDataFormat:     GLenum  read fglDataFormat;
969
970     property HasRed:       Boolean read GetHasRed;
971     property HasGreen:     Boolean read GetHasGreen;
972     property HasBlue:      Boolean read GetHasBlue;
973     property HasAlpha:     Boolean read GetHasAlpha;
974     property HasColor:     Boolean read GetHasColor;
975     property IsGrayscale:  Boolean read GetIsGrayscale;
976
977     constructor Create;
978   public
979     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
980   end;
981
982 ////////////////////////////////////////////////////////////////////////////////////////////////////
983   TglBitmapPixelData = packed record
984     Data:   TglBitmapRec4ui;
985     Range:  TglBitmapRec4ui;
986     Format: TglBitmapFormat;
987   end;
988   PglBitmapPixelData = ^TglBitmapPixelData;
989
990   TglBitmapPixelPositionFields = set of (ffX, ffY);
991   TglBitmapPixelPosition = record
992     Fields : TglBitmapPixelPositionFields;
993     X : Word;
994     Y : Word;
995   end;
996
997 ////////////////////////////////////////////////////////////////////////////////////////////////////
998   TglBitmap = class;
999   TglBitmapFunctionRec = record
1000     Sender:   TglBitmap;
1001     Size:     TglBitmapPixelPosition;
1002     Position: TglBitmapPixelPosition;
1003     Source:   TglBitmapPixelData;
1004     Dest:     TglBitmapPixelData;
1005     Args:     Pointer;
1006   end;
1007   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
1008
1009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1010   TglBitmap = class
1011   private
1012     function GetFormatDesc: TglBitmapFormatDescriptor;
1013   protected
1014     fID: GLuint;
1015     fTarget: GLuint;
1016     fAnisotropic: Integer;
1017     fDeleteTextureOnFree: Boolean;
1018     fFreeDataOnDestroy: Boolean;
1019     fFreeDataAfterGenTexture: Boolean;
1020     fData: PByte;
1021     fIsResident: GLboolean;
1022     fBorderColor: array[0..3] of Single;
1023
1024     fDimension: TglBitmapPixelPosition;
1025     fMipMap: TglBitmapMipMap;
1026     fFormat: TglBitmapFormat;
1027
1028     // Mapping
1029     fPixelSize: Integer;
1030     fRowSize: Integer;
1031
1032     // Filtering
1033     fFilterMin: GLenum;
1034     fFilterMag: GLenum;
1035
1036     // TexturWarp
1037     fWrapS: GLenum;
1038     fWrapT: GLenum;
1039     fWrapR: GLenum;
1040
1041     //Swizzle
1042     fSwizzle: array[0..3] of GLenum;
1043
1044     // CustomData
1045     fFilename: String;
1046     fCustomName: String;
1047     fCustomNameW: WideString;
1048     fCustomData: Pointer;
1049
1050     //Getter
1051     function GetWidth:  Integer; virtual;
1052     function GetHeight: Integer; virtual;
1053
1054     function GetFileWidth:  Integer; virtual;
1055     function GetFileHeight: Integer; virtual;
1056
1057     //Setter
1058     procedure SetCustomData(const aValue: Pointer);
1059     procedure SetCustomName(const aValue: String);
1060     procedure SetCustomNameW(const aValue: WideString);
1061     procedure SetFreeDataOnDestroy(const aValue: Boolean);
1062     procedure SetDeleteTextureOnFree(const aValue: Boolean);
1063     procedure SetFormat(const aValue: TglBitmapFormat);
1064     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
1065     procedure SetID(const aValue: Cardinal);
1066     procedure SetMipMap(const aValue: TglBitmapMipMap);
1067     procedure SetTarget(const aValue: Cardinal);
1068     procedure SetAnisotropic(const aValue: Integer);
1069
1070     procedure CreateID;
1071     procedure SetupParameters(out aBuildWithGlu: Boolean);
1072     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1073       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
1074     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
1075
1076     function FlipHorz: Boolean; virtual;
1077     function FlipVert: Boolean; virtual;
1078
1079     property Width:  Integer read GetWidth;
1080     property Height: Integer read GetHeight;
1081
1082     property FileWidth:  Integer read GetFileWidth;
1083     property FileHeight: Integer read GetFileHeight;
1084   public
1085     //Properties
1086     property ID:           Cardinal        read fID          write SetID;
1087     property Target:       Cardinal        read fTarget      write SetTarget;
1088     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1089     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1090     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1091
1092     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1093
1094     property Filename:    String     read fFilename;
1095     property CustomName:  String     read fCustomName  write SetCustomName;
1096     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1097     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1098
1099     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1100     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1101     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1102
1103     property Dimension:  TglBitmapPixelPosition  read fDimension;
1104     property Data:       PByte                   read fData;
1105     property IsResident: GLboolean               read fIsResident;
1106
1107     procedure AfterConstruction; override;
1108     procedure BeforeDestruction; override;
1109
1110     procedure PrepareResType(var aResource: String; var aResType: PChar);
1111
1112     //Load
1113     procedure LoadFromFile(const aFilename: String);
1114     procedure LoadFromStream(const aStream: TStream); virtual;
1115     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1116       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1117     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1118     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1119
1120     //Save
1121     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1122     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1123
1124     //Convert
1125     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1126     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1127       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1128   public
1129     //Alpha & Co
1130     {$IFDEF GLB_SDL}
1131     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1132     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1133     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1134     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1135       const aArgs: Pointer = nil): Boolean;
1136     {$ENDIF}
1137
1138     {$IFDEF GLB_DELPHI}
1139     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1140     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1141     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1142     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1143       const aArgs: Pointer = nil): Boolean;
1144     {$ENDIF}
1145
1146     {$IFDEF GLB_LAZARUS}
1147     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1148     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1149     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1150     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1151       const aArgs: Pointer = nil): Boolean;
1152     {$ENDIF}
1153
1154     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1155       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1156     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1157       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1158
1159     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1160     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1161     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1162     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1163
1164     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1165     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1166     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1167
1168     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1169     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1170     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1171
1172     function RemoveAlpha: Boolean; virtual;
1173   public
1174     //Common
1175     function Clone: TglBitmap;
1176     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1177     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1178     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1179     procedure FreeData;
1180
1181     //ColorFill
1182     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1183     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1184     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1185
1186     //TexParameters
1187     procedure SetFilter(const aMin, aMag: GLenum);
1188     procedure SetWrap(
1189       const S: GLenum = GL_CLAMP_TO_EDGE;
1190       const T: GLenum = GL_CLAMP_TO_EDGE;
1191       const R: GLenum = GL_CLAMP_TO_EDGE);
1192     procedure SetSwizzle(const r, g, b, a: GLenum);
1193
1194     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1195     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1196
1197     //Constructors
1198     constructor Create; overload;
1199     constructor Create(const aFileName: String); overload;
1200     constructor Create(const aStream: TStream); overload;
1201     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1202     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1203     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1204     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1205   private
1206     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1207     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1208
1209     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1210     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1211
1212     function LoadRAW(const aStream: TStream): Boolean;
1213     procedure SaveRAW(const aStream: TStream);
1214
1215     function LoadBMP(const aStream: TStream): Boolean;
1216     procedure SaveBMP(const aStream: TStream);
1217
1218     function LoadTGA(const aStream: TStream): Boolean;
1219     procedure SaveTGA(const aStream: TStream);
1220
1221     function LoadDDS(const aStream: TStream): Boolean;
1222     procedure SaveDDS(const aStream: TStream);
1223   end;
1224
1225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1226   TglBitmap1D = class(TglBitmap)
1227   protected
1228     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1229       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1230     procedure UploadData(const aBuildWithGlu: Boolean);
1231   public
1232     property Width;
1233     procedure AfterConstruction; override;
1234     function FlipHorz: Boolean; override;
1235     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1236   end;
1237
1238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1239   TglBitmap2D = class(TglBitmap)
1240   protected
1241     fLines: array of PByte;
1242     function GetScanline(const aIndex: Integer): Pointer;
1243     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1244       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1245     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1246   public
1247     property Width;
1248     property Height;
1249     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1250
1251     procedure AfterConstruction; override;
1252
1253     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1254     procedure GetDataFromTexture;
1255     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1256
1257     function FlipHorz: Boolean; override;
1258     function FlipVert: Boolean; override;
1259
1260     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1261       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1262   end;
1263
1264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1265   TglBitmapCubeMap = class(TglBitmap2D)
1266   protected
1267     fGenMode: Integer;
1268     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1269   public
1270     procedure AfterConstruction; override;
1271     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1272     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1273     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1274   end;
1275
1276 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1277   TglBitmapNormalMap = class(TglBitmapCubeMap)
1278   public
1279     procedure AfterConstruction; override;
1280     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1281   end;
1282
1283 const
1284   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1285
1286 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1287 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1288 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1289 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1290 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1291 procedure glBitmapSetDefaultWrap(
1292   const S: Cardinal = GL_CLAMP_TO_EDGE;
1293   const T: Cardinal = GL_CLAMP_TO_EDGE;
1294   const R: Cardinal = GL_CLAMP_TO_EDGE);
1295
1296 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1297 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1298 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1299 function glBitmapGetDefaultFormat: TglBitmapFormat;
1300 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1301 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1302
1303 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1304 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1305 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1306 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1307 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1308 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1309
1310 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1311
1312 var
1313   glBitmapDefaultDeleteTextureOnFree: Boolean;
1314   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1315   glBitmapDefaultFormat: TglBitmapFormat;
1316   glBitmapDefaultMipmap: TglBitmapMipMap;
1317   glBitmapDefaultFilterMin: Cardinal;
1318   glBitmapDefaultFilterMag: Cardinal;
1319   glBitmapDefaultWrapS: Cardinal;
1320   glBitmapDefaultWrapT: Cardinal;
1321   glBitmapDefaultWrapR: Cardinal;
1322   glDefaultSwizzle: array[0..3] of GLenum;
1323
1324 {$IFDEF GLB_DELPHI}
1325 function CreateGrayPalette: HPALETTE;
1326 {$ENDIF}
1327
1328 implementation
1329
1330 uses
1331   Math, syncobjs, typinfo
1332   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1333
1334 ////////////////////////////////////////////////////////////////////////////////////////////////////
1335 type
1336   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1337   public
1338     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1339     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1340
1341     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1342     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1343
1344     function CreateMappingData: Pointer; virtual;
1345     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1346
1347     function IsEmpty: Boolean; virtual;
1348     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
1349
1350     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1351
1352     constructor Create; virtual;
1353   public
1354     class procedure Init;
1355     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1356     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1357     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
1358     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
1359     class procedure Clear;
1360     class procedure Finalize;
1361   end;
1362   TFormatDescriptorClass = class of TFormatDescriptor;
1363
1364   TfdEmpty = class(TFormatDescriptor);
1365
1366 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1367   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
1368     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1369     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1370   end;
1371
1372   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
1373     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1374     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1375   end;
1376
1377   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
1378     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1379     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1380   end;
1381
1382   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
1383     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1384     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1385   end;
1386
1387   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
1388     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1389     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1390   end;
1391
1392   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1393     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1394     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1395   end;
1396
1397   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
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   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
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   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
1409     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1410     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1411   end;
1412
1413   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
1414     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1415     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1416   end;
1417
1418   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
1419     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1420     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1421   end;
1422
1423   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
1424     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1425     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1426   end;
1427
1428   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
1429     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1430     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1431   end;
1432
1433   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
1434     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1435     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1436   end;
1437
1438   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1439     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1440     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1441   end;
1442
1443   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
1444     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1445     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1446   end;
1447
1448   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
1449     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1450     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1451   end;
1452
1453   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1454     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1455     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1456   end;
1457
1458   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
1459     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1460     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1461   end;
1462
1463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1464   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
1465     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1466     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1467   end;
1468
1469   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
1470     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1471     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1472   end;
1473
1474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1475   TfdAlpha4ub1 = class(TfdAlphaUB1)
1476     procedure SetValues; override;
1477   end;
1478
1479   TfdAlpha8ub1 = class(TfdAlphaUB1)
1480     procedure SetValues; override;
1481   end;
1482
1483   TfdAlpha16us1 = class(TfdAlphaUS1)
1484     procedure SetValues; override;
1485   end;
1486
1487   TfdLuminance4ub1 = class(TfdLuminanceUB1)
1488     procedure SetValues; override;
1489   end;
1490
1491   TfdLuminance8ub1 = class(TfdLuminanceUB1)
1492     procedure SetValues; override;
1493   end;
1494
1495   TfdLuminance16us1 = class(TfdLuminanceUS1)
1496     procedure SetValues; override;
1497   end;
1498
1499   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
1500     procedure SetValues; override;
1501   end;
1502
1503   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
1504     procedure SetValues; override;
1505   end;
1506
1507   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
1508     procedure SetValues; override;
1509   end;
1510
1511   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
1512     procedure SetValues; override;
1513   end;
1514
1515   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
1516     procedure SetValues; override;
1517   end;
1518
1519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1520   TfdR3G3B2ub1 = class(TfdUniversalUB1)
1521     procedure SetValues; override;
1522   end;
1523
1524   TfdRGBX4us1 = class(TfdUniversalUS1)
1525     procedure SetValues; override;
1526   end;
1527
1528   TfdXRGB4us1 = class(TfdUniversalUS1)
1529     procedure SetValues; override;
1530   end;
1531
1532   TfdR5G6B5us1 = class(TfdUniversalUS1)
1533     procedure SetValues; override;
1534   end;
1535
1536   TfdRGB5X1us1 = class(TfdUniversalUS1)
1537     procedure SetValues; override;
1538   end;
1539
1540   TfdX1RGB5us1 = class(TfdUniversalUS1)
1541     procedure SetValues; override;
1542   end;
1543
1544   TfdRGB8ub3 = class(TfdRGBub3)
1545     procedure SetValues; override;
1546   end;
1547
1548   TfdRGBX8ui1 = class(TfdUniversalUI1)
1549     procedure SetValues; override;
1550   end;
1551
1552   TfdXRGB8ui1 = class(TfdUniversalUI1)
1553     procedure SetValues; override;
1554   end;
1555
1556   TfdRGB10X2ui1 = class(TfdUniversalUI1)
1557     procedure SetValues; override;
1558   end;
1559
1560   TfdX2RGB10ui1 = class(TfdUniversalUI1)
1561     procedure SetValues; override;
1562   end;
1563
1564   TfdRGB16us3 = class(TfdRGBus3)
1565     procedure SetValues; override;
1566   end;
1567
1568   TfdRGBA4us1 = class(TfdUniversalUS1)
1569     procedure SetValues; override;
1570   end;
1571
1572   TfdARGB4us1 = class(TfdUniversalUS1)
1573     procedure SetValues; override;
1574   end;
1575
1576   TfdRGB5A1us1 = class(TfdUniversalUS1)
1577     procedure SetValues; override;
1578   end;
1579
1580   TfdA1RGB5us1 = class(TfdUniversalUS1)
1581     procedure SetValues; override;
1582   end;
1583
1584   TfdRGBA8ui1 = class(TfdUniversalUI1)
1585     procedure SetValues; override;
1586   end;
1587
1588   TfdARGB8ui1 = class(TfdUniversalUI1)
1589     procedure SetValues; override;
1590   end;
1591
1592   TfdRGBA8ub4 = class(TfdRGBAub4)
1593     procedure SetValues; override;
1594   end;
1595
1596   TfdRGB10A2ui1 = class(TfdUniversalUI1)
1597     procedure SetValues; override;
1598   end;
1599
1600   TfdA2RGB10ui1 = class(TfdUniversalUI1)
1601     procedure SetValues; override;
1602   end;
1603
1604   TfdRGBA16us4 = class(TfdRGBAus4)
1605     procedure SetValues; override;
1606   end;
1607
1608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1609   TfdBGRX4us1 = class(TfdUniversalUS1)
1610     procedure SetValues; override;
1611   end;
1612
1613   TfdXBGR4us1 = class(TfdUniversalUS1)
1614     procedure SetValues; override;
1615   end;
1616
1617   TfdB5G6R5us1 = class(TfdUniversalUS1)
1618     procedure SetValues; override;
1619   end;
1620
1621   TfdBGR5X1us1 = class(TfdUniversalUS1)
1622     procedure SetValues; override;
1623   end;
1624
1625   TfdX1BGR5us1 = class(TfdUniversalUS1)
1626     procedure SetValues; override;
1627   end;
1628
1629   TfdBGR8ub3 = class(TfdBGRub3)
1630     procedure SetValues; override;
1631   end;
1632
1633   TfdBGRX8ui1 = class(TfdUniversalUI1)
1634     procedure SetValues; override;
1635   end;
1636
1637   TfdXBGR8ui1 = class(TfdUniversalUI1)
1638     procedure SetValues; override;
1639   end;
1640
1641   TfdBGR10X2ui1 = class(TfdUniversalUI1)
1642     procedure SetValues; override;
1643   end;
1644
1645   TfdX2BGR10ui1 = class(TfdUniversalUI1)
1646     procedure SetValues; override;
1647   end;
1648
1649   TfdBGR16us3 = class(TfdBGRus3)
1650     procedure SetValues; override;
1651   end;
1652
1653   TfdBGRA4us1 = class(TfdUniversalUS1)
1654     procedure SetValues; override;
1655   end;
1656
1657   TfdABGR4us1 = class(TfdUniversalUS1)
1658     procedure SetValues; override;
1659   end;
1660
1661   TfdBGR5A1us1 = class(TfdUniversalUS1)
1662     procedure SetValues; override;
1663   end;
1664
1665   TfdA1BGR5us1 = class(TfdUniversalUS1)
1666     procedure SetValues; override;
1667   end;
1668
1669   TfdBGRA8ui1 = class(TfdUniversalUI1)
1670     procedure SetValues; override;
1671   end;
1672
1673   TfdABGR8ui1 = class(TfdUniversalUI1)
1674     procedure SetValues; override;
1675   end;
1676
1677   TfdBGRA8ub4 = class(TfdBGRAub4)
1678     procedure SetValues; override;
1679   end;
1680
1681   TfdBGR10A2ui1 = class(TfdUniversalUI1)
1682     procedure SetValues; override;
1683   end;
1684
1685   TfdA2BGR10ui1 = class(TfdUniversalUI1)
1686     procedure SetValues; override;
1687   end;
1688
1689   TfdBGRA16us4 = class(TfdBGRAus4)
1690     procedure SetValues; override;
1691   end;
1692
1693   TfdDepth16us1 = class(TfdDepthUS1)
1694     procedure SetValues; override;
1695   end;
1696
1697   TfdDepth24ui1 = class(TfdDepthUI1)
1698     procedure SetValues; override;
1699   end;
1700
1701   TfdDepth32ui1 = class(TfdDepthUI1)
1702     procedure SetValues; override;
1703   end;
1704
1705   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1706     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1707     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1708     procedure SetValues; override;
1709   end;
1710
1711   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1712     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1713     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1714     procedure SetValues; override;
1715   end;
1716
1717   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1718     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1719     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1720     procedure SetValues; override;
1721   end;
1722
1723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1724   TbmpBitfieldFormat = class(TFormatDescriptor)
1725   public
1726     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
1727     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1728     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1729     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1730   end;
1731
1732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1733   TbmpColorTableEnty = packed record
1734     b, g, r, a: Byte;
1735   end;
1736   TbmpColorTable = array of TbmpColorTableEnty;
1737   TbmpColorTableFormat = class(TFormatDescriptor)
1738   private
1739     fBitsPerPixel: Integer;
1740     fColorTable: TbmpColorTable;
1741   protected
1742     procedure SetValues; override;
1743   public
1744     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;
1745     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;
1746
1747     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
1748     procedure CalcValues;
1749     procedure CreateColorTable;
1750
1751     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1752     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1753     destructor Destroy; override;
1754   end;
1755
1756 const
1757   LUMINANCE_WEIGHT_R = 0.30;
1758   LUMINANCE_WEIGHT_G = 0.59;
1759   LUMINANCE_WEIGHT_B = 0.11;
1760
1761   ALPHA_WEIGHT_R = 0.30;
1762   ALPHA_WEIGHT_G = 0.59;
1763   ALPHA_WEIGHT_B = 0.11;
1764
1765   DEPTH_WEIGHT_R = 0.333333333;
1766   DEPTH_WEIGHT_G = 0.333333333;
1767   DEPTH_WEIGHT_B = 0.333333333;
1768
1769   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1770     TfdEmpty,
1771
1772     TfdAlpha4ub1,
1773     TfdAlpha8ub1,
1774     TfdAlpha16us1,
1775
1776     TfdLuminance4ub1,
1777     TfdLuminance8ub1,
1778     TfdLuminance16us1,
1779
1780     TfdLuminance4Alpha4ub2,
1781     TfdLuminance6Alpha2ub2,
1782     TfdLuminance8Alpha8ub2,
1783     TfdLuminance12Alpha4us2,
1784     TfdLuminance16Alpha16us2,
1785
1786     TfdR3G3B2ub1,
1787     TfdRGBX4us1,
1788     TfdXRGB4us1,
1789     TfdR5G6B5us1,
1790     TfdRGB5X1us1,
1791     TfdX1RGB5us1,
1792     TfdRGB8ub3,
1793     TfdRGBX8ui1,
1794     TfdXRGB8ui1,
1795     TfdRGB10X2ui1,
1796     TfdX2RGB10ui1,
1797     TfdRGB16us3,
1798
1799     TfdRGBA4us1,
1800     TfdARGB4us1,
1801     TfdRGB5A1us1,
1802     TfdA1RGB5us1,
1803     TfdRGBA8ui1,
1804     TfdARGB8ui1,
1805     TfdRGBA8ub4,
1806     TfdRGB10A2ui1,
1807     TfdA2RGB10ui1,
1808     TfdRGBA16us4,
1809
1810     TfdBGRX4us1,
1811     TfdXBGR4us1,
1812     TfdB5G6R5us1,
1813     TfdBGR5X1us1,
1814     TfdX1BGR5us1,
1815     TfdBGR8ub3,
1816     TfdBGRX8ui1,
1817     TfdXBGR8ui1,
1818     TfdBGR10X2ui1,
1819     TfdX2BGR10ui1,
1820     TfdBGR16us3,
1821
1822     TfdBGRA4us1,
1823     TfdABGR4us1,
1824     TfdBGR5A1us1,
1825     TfdA1BGR5us1,
1826     TfdBGRA8ui1,
1827     TfdABGR8ui1,
1828     TfdBGRA8ub4,
1829     TfdBGR10A2ui1,
1830     TfdA2BGR10ui1,
1831     TfdBGRA16us4,
1832
1833     TfdDepth16us1,
1834     TfdDepth24ui1,
1835     TfdDepth32ui1,
1836
1837     TfdS3tcDtx1RGBA,
1838     TfdS3tcDtx3RGBA,
1839     TfdS3tcDtx5RGBA
1840   );
1841
1842 var
1843   FormatDescriptorCS: TCriticalSection;
1844   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1845
1846 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1847 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1848 begin
1849   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1850 end;
1851
1852 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1853 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1854 begin
1855   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1856 end;
1857
1858 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1859 function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
1860 begin
1861   result.Fields := [];
1862
1863   if X >= 0 then
1864     result.Fields := result.Fields + [ffX];
1865   if Y >= 0 then
1866     result.Fields := result.Fields + [ffY];
1867
1868   result.X := Max(0, X);
1869   result.Y := Max(0, Y);
1870 end;
1871
1872 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1873 function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
1874 begin
1875   result.r := r;
1876   result.g := g;
1877   result.b := b;
1878   result.a := a;
1879 end;
1880
1881 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1882 function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
1883 begin
1884   result.r := r;
1885   result.g := g;
1886   result.b := b;
1887   result.a := a;
1888 end;
1889
1890 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1891 function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
1892 begin
1893   result.r := r;
1894   result.g := g;
1895   result.b := b;
1896   result.a := a;
1897 end;
1898
1899 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1900 function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
1901 var
1902   i: Integer;
1903 begin
1904   result := false;
1905   for i := 0 to high(r1.arr) do
1906     if (r1.arr[i] <> r2.arr[i]) then
1907       exit;
1908   result := true;
1909 end;
1910
1911 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1912 function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
1913 var
1914   i: Integer;
1915 begin
1916   result := false;
1917   for i := 0 to high(r1.arr) do
1918     if (r1.arr[i] <> r2.arr[i]) then
1919       exit;
1920   result := true;
1921 end;
1922
1923 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1924 function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
1925 var
1926   desc: TFormatDescriptor;
1927   p, tmp: PByte;
1928   x, y, i: Integer;
1929   md: Pointer;
1930   px: TglBitmapPixelData;
1931 begin
1932   result := nil;
1933   desc := TFormatDescriptor.Get(aFormat);
1934   if (desc.IsCompressed) or (desc.glFormat = 0) then
1935     exit;
1936
1937   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
1938   md := desc.CreateMappingData;
1939   try
1940     tmp := p;
1941     desc.PreparePixel(px);
1942     for y := 0 to 4 do
1943       for x := 0 to 4 do begin
1944         px.Data := glBitmapRec4ui(0, 0, 0, 0);
1945         for i := 0 to 3 do begin
1946           if ((y < 3) and (y = i)) or
1947              ((y = 3) and (i < 3)) or
1948              ((y = 4) and (i = 3))
1949           then
1950             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
1951           else if ((y < 4) and (i = 3)) or
1952                   ((y = 4) and (i < 3))
1953           then
1954             px.Data.arr[i] := px.Range.arr[i]
1955           else
1956             px.Data.arr[i] := 0; //px.Range.arr[i];
1957         end;
1958         desc.Map(px, tmp, md);
1959       end;
1960   finally
1961     desc.FreeMappingData(md);
1962   end;
1963
1964   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
1965   result.FreeDataOnDestroy       := true;
1966   result.FreeDataAfterGenTexture := false;
1967   result.SetFilter(GL_NEAREST, GL_NEAREST);
1968 end;
1969
1970 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1971 function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
1972 begin
1973   result.r := r;
1974   result.g := g;
1975   result.b := b;
1976   result.a := a;
1977 end;
1978
1979 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1980 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1981 begin
1982   result := [];
1983
1984   if (aFormat in [
1985         //8bpp
1986         tfAlpha4ub1, tfAlpha8ub1,
1987         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
1988
1989         //16bpp
1990         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
1991         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
1992         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
1993
1994         //24bpp
1995         tfBGR8ub3, tfRGB8ub3,
1996
1997         //32bpp
1998         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
1999         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
2000   then
2001     result := result + [ ftBMP ];
2002
2003   if (aFormat in [
2004         //8bbp
2005         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
2006
2007         //16bbp
2008         tfAlpha16us1, tfLuminance16us1,
2009         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
2010         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
2011
2012         //24bbp
2013         tfBGR8ub3,
2014
2015         //32bbp
2016         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
2017         tfDepth24ui1, tfDepth32ui1])
2018   then
2019     result := result + [ftTGA];
2020
2021   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
2022     result := result + [ftDDS];
2023
2024 {$IFDEF GLB_SUPPORT_PNG_WRITE}
2025   if aFormat in [
2026       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
2027       tfRGB8ub3, tfRGBA8ui1,
2028       tfBGR8ub3, tfBGRA8ui1] then
2029     result := result + [ftPNG];
2030 {$ENDIF}
2031
2032 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
2033   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
2034     result := result + [ftJPEG];
2035 {$ENDIF}
2036 end;
2037
2038 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2039 function IsPowerOfTwo(aNumber: Integer): Boolean;
2040 begin
2041   while (aNumber and 1) = 0 do
2042     aNumber := aNumber shr 1;
2043   result := aNumber = 1;
2044 end;
2045
2046 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2047 function GetTopMostBit(aBitSet: QWord): Integer;
2048 begin
2049   result := 0;
2050   while aBitSet > 0 do begin
2051     inc(result);
2052     aBitSet := aBitSet shr 1;
2053   end;
2054 end;
2055
2056 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2057 function CountSetBits(aBitSet: QWord): Integer;
2058 begin
2059   result := 0;
2060   while aBitSet > 0 do begin
2061     if (aBitSet and 1) = 1 then
2062       inc(result);
2063     aBitSet := aBitSet shr 1;
2064   end;
2065 end;
2066
2067 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2068 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
2069 begin
2070   result := Trunc(
2071     LUMINANCE_WEIGHT_R * aPixel.Data.r +
2072     LUMINANCE_WEIGHT_G * aPixel.Data.g +
2073     LUMINANCE_WEIGHT_B * aPixel.Data.b);
2074 end;
2075
2076 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2077 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
2078 begin
2079   result := Trunc(
2080     DEPTH_WEIGHT_R * aPixel.Data.r +
2081     DEPTH_WEIGHT_G * aPixel.Data.g +
2082     DEPTH_WEIGHT_B * aPixel.Data.b);
2083 end;
2084
2085 {$IFDEF GLB_NATIVE_OGL}
2086 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2087 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2088 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2089 var
2090   GL_LibHandle: Pointer = nil;
2091
2092 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
2093 begin
2094   if not Assigned(aLibHandle) then
2095     aLibHandle := GL_LibHandle;
2096
2097 {$IF DEFINED(GLB_WIN)}
2098   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
2099   if Assigned(result) then
2100     exit;
2101
2102   if Assigned(wglGetProcAddress) then
2103     result := wglGetProcAddress(aProcName);
2104 {$ELSEIF DEFINED(GLB_LINUX)}
2105   if Assigned(glXGetProcAddress) then begin
2106     result := glXGetProcAddress(aProcName);
2107     if Assigned(result) then
2108       exit;
2109   end;
2110
2111   if Assigned(glXGetProcAddressARB) then begin
2112     result := glXGetProcAddressARB(aProcName);
2113     if Assigned(result) then
2114       exit;
2115   end;
2116
2117   result := dlsym(aLibHandle, aProcName);
2118 {$IFEND}
2119   if not Assigned(result) and aRaiseOnErr then
2120     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
2121 end;
2122
2123 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2124 var
2125   GLU_LibHandle: Pointer = nil;
2126   OpenGLInitialized: Boolean;
2127   InitOpenGLCS: TCriticalSection;
2128
2129 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 procedure glbInitOpenGL;
2131
2132   ////////////////////////////////////////////////////////////////////////////////
2133   function glbLoadLibrary(const aName: PChar): Pointer;
2134   begin
2135     {$IF DEFINED(GLB_WIN)}
2136     result := {%H-}Pointer(LoadLibrary(aName));
2137     {$ELSEIF DEFINED(GLB_LINUX)}
2138     result := dlopen(Name, RTLD_LAZY);
2139     {$ELSE}
2140     result := nil;
2141     {$IFEND}
2142   end;
2143
2144   ////////////////////////////////////////////////////////////////////////////////
2145   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2146   begin
2147     result := false;
2148     if not Assigned(aLibHandle) then
2149       exit;
2150
2151     {$IF DEFINED(GLB_WIN)}
2152     Result := FreeLibrary({%H-}HINST(aLibHandle));
2153     {$ELSEIF DEFINED(GLB_LINUX)}
2154     Result := dlclose(aLibHandle) = 0;
2155     {$IFEND}
2156   end;
2157
2158 begin
2159   if Assigned(GL_LibHandle) then
2160     glbFreeLibrary(GL_LibHandle);
2161
2162   if Assigned(GLU_LibHandle) then
2163     glbFreeLibrary(GLU_LibHandle);
2164
2165   GL_LibHandle := glbLoadLibrary(libopengl);
2166   if not Assigned(GL_LibHandle) then
2167     raise EglBitmap.Create('unable to load library: ' + libopengl);
2168
2169   GLU_LibHandle := glbLoadLibrary(libglu);
2170   if not Assigned(GLU_LibHandle) then
2171     raise EglBitmap.Create('unable to load library: ' + libglu);
2172
2173 {$IF DEFINED(GLB_WIN)}
2174   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2175 {$ELSEIF DEFINED(GLB_LINUX)}
2176   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2177   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2178 {$IFEND}
2179
2180   glEnable := glbGetProcAddress('glEnable');
2181   glDisable := glbGetProcAddress('glDisable');
2182   glGetString := glbGetProcAddress('glGetString');
2183   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2184   glTexParameteri := glbGetProcAddress('glTexParameteri');
2185   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2186   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2187   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2188   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2189   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2190   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2191   glTexGeni := glbGetProcAddress('glTexGeni');
2192   glGenTextures := glbGetProcAddress('glGenTextures');
2193   glBindTexture := glbGetProcAddress('glBindTexture');
2194   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2195   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2196   glReadPixels := glbGetProcAddress('glReadPixels');
2197   glPixelStorei := glbGetProcAddress('glPixelStorei');
2198   glTexImage1D := glbGetProcAddress('glTexImage1D');
2199   glTexImage2D := glbGetProcAddress('glTexImage2D');
2200   glGetTexImage := glbGetProcAddress('glGetTexImage');
2201
2202   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2203   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2204 end;
2205 {$ENDIF}
2206
2207 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2208 procedure glbReadOpenGLExtensions;
2209 var
2210   Buffer: AnsiString;
2211   MajorVersion, MinorVersion: Integer;
2212
2213   ///////////////////////////////////////////////////////////////////////////////////////////
2214   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2215   var
2216     Separator: Integer;
2217   begin
2218     aMinor := 0;
2219     aMajor := 0;
2220
2221     Separator := Pos(AnsiString('.'), aBuffer);
2222     if (Separator > 1) and (Separator < Length(aBuffer)) and
2223        (aBuffer[Separator - 1] in ['0'..'9']) and
2224        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2225
2226       Dec(Separator);
2227       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2228         Dec(Separator);
2229
2230       Delete(aBuffer, 1, Separator);
2231       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2232
2233       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2234         Inc(Separator);
2235
2236       Delete(aBuffer, Separator, 255);
2237       Separator := Pos(AnsiString('.'), aBuffer);
2238
2239       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2240       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2241     end;
2242   end;
2243
2244   ///////////////////////////////////////////////////////////////////////////////////////////
2245   function CheckExtension(const Extension: AnsiString): Boolean;
2246   var
2247     ExtPos: Integer;
2248   begin
2249     ExtPos := Pos(Extension, Buffer);
2250     result := ExtPos > 0;
2251     if result then
2252       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2253   end;
2254
2255   ///////////////////////////////////////////////////////////////////////////////////////////
2256   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2257   begin
2258     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2259   end;
2260
2261 begin
2262 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2263   InitOpenGLCS.Enter;
2264   try
2265     if not OpenGLInitialized then begin
2266       glbInitOpenGL;
2267       OpenGLInitialized := true;
2268     end;
2269   finally
2270     InitOpenGLCS.Leave;
2271   end;
2272 {$ENDIF}
2273
2274   // Version
2275   Buffer := glGetString(GL_VERSION);
2276   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2277
2278   GL_VERSION_1_2 := CheckVersion(1, 2);
2279   GL_VERSION_1_3 := CheckVersion(1, 3);
2280   GL_VERSION_1_4 := CheckVersion(1, 4);
2281   GL_VERSION_2_0 := CheckVersion(2, 0);
2282   GL_VERSION_3_3 := CheckVersion(3, 3);
2283
2284   // Extensions
2285   Buffer := glGetString(GL_EXTENSIONS);
2286   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2287   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2288   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2289   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2290   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2291   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2292   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2293   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2294   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2295   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2296   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2297   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2298   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2299   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2300
2301   if GL_VERSION_1_3 then begin
2302     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2303     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2304     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2305   end else begin
2306     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2307     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2308     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2309   end;
2310 end;
2311 {$ENDIF}
2312
2313 {$IFDEF GLB_SDL_IMAGE}
2314 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2315 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2317 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2318 begin
2319   result := TStream(context^.unknown.data1).Seek(offset, whence);
2320 end;
2321
2322 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2323 begin
2324   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2325 end;
2326
2327 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2328 begin
2329   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2330 end;
2331
2332 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2333 begin
2334   result := 0;
2335 end;
2336
2337 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2338 begin
2339   result := SDL_AllocRW;
2340
2341   if result = nil then
2342     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2343
2344   result^.seek := glBitmapRWseek;
2345   result^.read := glBitmapRWread;
2346   result^.write := glBitmapRWwrite;
2347   result^.close := glBitmapRWclose;
2348   result^.unknown.data1 := Stream;
2349 end;
2350 {$ENDIF}
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2354 begin
2355   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2360 begin
2361   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2366 begin
2367   glBitmapDefaultMipmap := aValue;
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2372 begin
2373   glBitmapDefaultFormat := aFormat;
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2378 begin
2379   glBitmapDefaultFilterMin := aMin;
2380   glBitmapDefaultFilterMag := aMag;
2381 end;
2382
2383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2384 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2385 begin
2386   glBitmapDefaultWrapS := S;
2387   glBitmapDefaultWrapT := T;
2388   glBitmapDefaultWrapR := R;
2389 end;
2390
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2393 begin
2394   glDefaultSwizzle[0] := r;
2395   glDefaultSwizzle[1] := g;
2396   glDefaultSwizzle[2] := b;
2397   glDefaultSwizzle[3] := a;
2398 end;
2399
2400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2401 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2402 begin
2403   result := glBitmapDefaultDeleteTextureOnFree;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2408 begin
2409   result := glBitmapDefaultFreeDataAfterGenTextures;
2410 end;
2411
2412 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2413 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2414 begin
2415   result := glBitmapDefaultMipmap;
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function glBitmapGetDefaultFormat: TglBitmapFormat;
2420 begin
2421   result := glBitmapDefaultFormat;
2422 end;
2423
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2426 begin
2427   aMin := glBitmapDefaultFilterMin;
2428   aMag := glBitmapDefaultFilterMag;
2429 end;
2430
2431 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2432 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2433 begin
2434   S := glBitmapDefaultWrapS;
2435   T := glBitmapDefaultWrapT;
2436   R := glBitmapDefaultWrapR;
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2441 begin
2442   r := glDefaultSwizzle[0];
2443   g := glDefaultSwizzle[1];
2444   b := glDefaultSwizzle[2];
2445   a := glDefaultSwizzle[3];
2446 end;
2447
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2450 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2451 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2452 var
2453   w, h: Integer;
2454 begin
2455   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2456     w := Max(1, aSize.X);
2457     h := Max(1, aSize.Y);
2458     result := GetSize(w, h);
2459   end else
2460     result := 0;
2461 end;
2462
2463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2464 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2465 begin
2466   result := 0;
2467   if (aWidth <= 0) or (aHeight <= 0) then
2468     exit;
2469   result := Ceil(aWidth * aHeight * BytesPerPixel);
2470 end;
2471
2472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2473 function TFormatDescriptor.CreateMappingData: Pointer;
2474 begin
2475   result := nil;
2476 end;
2477
2478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2479 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2480 begin
2481   //DUMMY
2482 end;
2483
2484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2485 function TFormatDescriptor.IsEmpty: Boolean;
2486 begin
2487   result := (fFormat = tfEmpty);
2488 end;
2489
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
2492 var
2493   i: Integer;
2494   m: TglBitmapRec4ul;
2495 begin
2496   result := false;
2497   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
2498     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2499   m := Mask;
2500   for i := 0 to 3 do
2501     if (aMask.arr[i] <> m.arr[i]) then
2502       exit;
2503   result := true;
2504 end;
2505
2506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2507 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2508 begin
2509   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2510   aPixel.Data   := Range;
2511   aPixel.Format := fFormat;
2512   aPixel.Range  := Range;
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 constructor TFormatDescriptor.Create;
2517 begin
2518   inherited Create;
2519 end;
2520
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2523 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2524 procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2525 begin
2526   aData^ := aPixel.Data.a;
2527   inc(aData);
2528 end;
2529
2530 procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2531 begin
2532   aPixel.Data.r := 0;
2533   aPixel.Data.g := 0;
2534   aPixel.Data.b := 0;
2535   aPixel.Data.a := aData^;
2536   inc(aData);
2537 end;
2538
2539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2540 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2541 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2542 procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2543 begin
2544   aData^ := LuminanceWeight(aPixel);
2545   inc(aData);
2546 end;
2547
2548 procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2549 begin
2550   aPixel.Data.r := aData^;
2551   aPixel.Data.g := aData^;
2552   aPixel.Data.b := aData^;
2553   aPixel.Data.a := 0;
2554   inc(aData);
2555 end;
2556
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2559 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2560 procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2561 var
2562   i: Integer;
2563 begin
2564   aData^ := 0;
2565   for i := 0 to 3 do
2566     if (Range.arr[i] > 0) then
2567       aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2568   inc(aData);
2569 end;
2570
2571 procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2572 var
2573   i: Integer;
2574 begin
2575   for i := 0 to 3 do
2576     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
2577   inc(aData);
2578 end;
2579
2580 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2581 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2584 begin
2585   inherited Map(aPixel, aData, aMapData);
2586   aData^ := aPixel.Data.a;
2587   inc(aData);
2588 end;
2589
2590 procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2591 begin
2592   inherited Unmap(aData, aPixel, aMapData);
2593   aPixel.Data.a := aData^;
2594   inc(aData);
2595 end;
2596
2597 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2598 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2600 procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2601 begin
2602   aData^ := aPixel.Data.r;
2603   inc(aData);
2604   aData^ := aPixel.Data.g;
2605   inc(aData);
2606   aData^ := aPixel.Data.b;
2607   inc(aData);
2608 end;
2609
2610 procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2611 begin
2612   aPixel.Data.r := aData^;
2613   inc(aData);
2614   aPixel.Data.g := aData^;
2615   inc(aData);
2616   aPixel.Data.b := aData^;
2617   inc(aData);
2618   aPixel.Data.a := 0;
2619 end;
2620
2621 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2622 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2624 procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2625 begin
2626   aData^ := aPixel.Data.b;
2627   inc(aData);
2628   aData^ := aPixel.Data.g;
2629   inc(aData);
2630   aData^ := aPixel.Data.r;
2631   inc(aData);
2632 end;
2633
2634 procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2635 begin
2636   aPixel.Data.b := aData^;
2637   inc(aData);
2638   aPixel.Data.g := aData^;
2639   inc(aData);
2640   aPixel.Data.r := aData^;
2641   inc(aData);
2642   aPixel.Data.a := 0;
2643 end;
2644
2645 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2646 //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2649 begin
2650   inherited Map(aPixel, aData, aMapData);
2651   aData^ := aPixel.Data.a;
2652   inc(aData);
2653 end;
2654
2655 procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2656 begin
2657   inherited Unmap(aData, aPixel, aMapData);
2658   aPixel.Data.a := aData^;
2659   inc(aData);
2660 end;
2661
2662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2663 //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2664 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2665 procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2666 begin
2667   inherited Map(aPixel, aData, aMapData);
2668   aData^ := aPixel.Data.a;
2669   inc(aData);
2670 end;
2671
2672 procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2673 begin
2674   inherited Unmap(aData, aPixel, aMapData);
2675   aPixel.Data.a := aData^;
2676   inc(aData);
2677 end;
2678
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2682 procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2683 begin
2684   PWord(aData)^ := aPixel.Data.a;
2685   inc(aData, 2);
2686 end;
2687
2688 procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2689 begin
2690   aPixel.Data.r := 0;
2691   aPixel.Data.g := 0;
2692   aPixel.Data.b := 0;
2693   aPixel.Data.a := PWord(aData)^;
2694   inc(aData, 2);
2695 end;
2696
2697 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2698 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2700 procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2701 begin
2702   PWord(aData)^ := LuminanceWeight(aPixel);
2703   inc(aData, 2);
2704 end;
2705
2706 procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2707 begin
2708   aPixel.Data.r := PWord(aData)^;
2709   aPixel.Data.g := PWord(aData)^;
2710   aPixel.Data.b := PWord(aData)^;
2711   aPixel.Data.a := 0;
2712   inc(aData, 2);
2713 end;
2714
2715 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2716 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2718 procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2719 var
2720   i: Integer;
2721 begin
2722   PWord(aData)^ := 0;
2723   for i := 0 to 3 do
2724     if (Range.arr[i] > 0) then
2725       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2726   inc(aData, 2);
2727 end;
2728
2729 procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2730 var
2731   i: Integer;
2732 begin
2733   for i := 0 to 3 do
2734     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
2735   inc(aData, 2);
2736 end;
2737
2738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2739 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2742 begin
2743   PWord(aData)^ := DepthWeight(aPixel);
2744   inc(aData, 2);
2745 end;
2746
2747 procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2748 begin
2749   aPixel.Data.r := PWord(aData)^;
2750   aPixel.Data.g := PWord(aData)^;
2751   aPixel.Data.b := PWord(aData)^;
2752   aPixel.Data.a := PWord(aData)^;;
2753   inc(aData, 2);
2754 end;
2755
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2760 begin
2761   inherited Map(aPixel, aData, aMapData);
2762   PWord(aData)^ := aPixel.Data.a;
2763   inc(aData, 2);
2764 end;
2765
2766 procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2767 begin
2768   inherited Unmap(aData, aPixel, aMapData);
2769   aPixel.Data.a := PWord(aData)^;
2770   inc(aData, 2);
2771 end;
2772
2773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2774 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2775 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2776 procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2777 begin
2778   PWord(aData)^ := aPixel.Data.r;
2779   inc(aData, 2);
2780   PWord(aData)^ := aPixel.Data.g;
2781   inc(aData, 2);
2782   PWord(aData)^ := aPixel.Data.b;
2783   inc(aData, 2);
2784 end;
2785
2786 procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2787 begin
2788   aPixel.Data.r := PWord(aData)^;
2789   inc(aData, 2);
2790   aPixel.Data.g := PWord(aData)^;
2791   inc(aData, 2);
2792   aPixel.Data.b := PWord(aData)^;
2793   inc(aData, 2);
2794   aPixel.Data.a := 0;
2795 end;
2796
2797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2798 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2799 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2800 procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2801 begin
2802   PWord(aData)^ := aPixel.Data.b;
2803   inc(aData, 2);
2804   PWord(aData)^ := aPixel.Data.g;
2805   inc(aData, 2);
2806   PWord(aData)^ := aPixel.Data.r;
2807   inc(aData, 2);
2808 end;
2809
2810 procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2811 begin
2812   aPixel.Data.b := PWord(aData)^;
2813   inc(aData, 2);
2814   aPixel.Data.g := PWord(aData)^;
2815   inc(aData, 2);
2816   aPixel.Data.r := PWord(aData)^;
2817   inc(aData, 2);
2818   aPixel.Data.a := 0;
2819 end;
2820
2821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2822 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2825 begin
2826   inherited Map(aPixel, aData, aMapData);
2827   PWord(aData)^ := aPixel.Data.a;
2828   inc(aData, 2);
2829 end;
2830
2831 procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2832 begin
2833   inherited Unmap(aData, aPixel, aMapData);
2834   aPixel.Data.a := PWord(aData)^;
2835   inc(aData, 2);
2836 end;
2837
2838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2839 //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2841 procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2842 begin
2843   PWord(aData)^ := aPixel.Data.a;
2844   inc(aData, 2);
2845   inherited Map(aPixel, aData, aMapData);
2846 end;
2847
2848 procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2849 begin
2850   aPixel.Data.a := PWord(aData)^;
2851   inc(aData, 2);
2852   inherited Unmap(aData, aPixel, aMapData);
2853 end;
2854
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2858 procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2859 begin
2860   inherited Map(aPixel, aData, aMapData);
2861   PWord(aData)^ := aPixel.Data.a;
2862   inc(aData, 2);
2863 end;
2864
2865 procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2866 begin
2867   inherited Unmap(aData, aPixel, aMapData);
2868   aPixel.Data.a := PWord(aData)^;
2869   inc(aData, 2);
2870 end;
2871
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2876 begin
2877   PWord(aData)^ := aPixel.Data.a;
2878   inc(aData, 2);
2879   inherited Map(aPixel, aData, aMapData);
2880 end;
2881
2882 procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2883 begin
2884   aPixel.Data.a := PWord(aData)^;
2885   inc(aData, 2);
2886   inherited Unmap(aData, aPixel, aMapData);
2887 end;
2888
2889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2890 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2892 procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2893 var
2894   i: Integer;
2895 begin
2896   PCardinal(aData)^ := 0;
2897   for i := 0 to 3 do
2898     if (Range.arr[i] > 0) then
2899       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
2900   inc(aData, 4);
2901 end;
2902
2903 procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2904 var
2905   i: Integer;
2906 begin
2907   for i := 0 to 3 do
2908     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
2909   inc(aData, 2);
2910 end;
2911
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2916 begin
2917   PCardinal(aData)^ := DepthWeight(aPixel);
2918   inc(aData, 4);
2919 end;
2920
2921 procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2922 begin
2923   aPixel.Data.r := PCardinal(aData)^;
2924   aPixel.Data.g := PCardinal(aData)^;
2925   aPixel.Data.b := PCardinal(aData)^;
2926   aPixel.Data.a := PCardinal(aData)^;
2927   inc(aData, 4);
2928 end;
2929
2930 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2932 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2933 procedure TfdAlpha4ub1.SetValues;
2934 begin
2935   inherited SetValues;
2936   fBitsPerPixel     := 8;
2937   fFormat           := tfAlpha4ub1;
2938   fWithAlpha        := tfAlpha4ub1;
2939   fOpenGLFormat     := tfAlpha4ub1;
2940   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2941   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2942   fglFormat         := GL_ALPHA;
2943   fglInternalFormat := GL_ALPHA4;
2944   fglDataFormat     := GL_UNSIGNED_BYTE;
2945 end;
2946
2947 procedure TfdAlpha8ub1.SetValues;
2948 begin
2949   inherited SetValues;
2950   fBitsPerPixel     := 8;
2951   fFormat           := tfAlpha8ub1;
2952   fWithAlpha        := tfAlpha8ub1;
2953   fOpenGLFormat     := tfAlpha8ub1;
2954   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);
2955   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2956   fglFormat         := GL_ALPHA;
2957   fglInternalFormat := GL_ALPHA8;
2958   fglDataFormat     := GL_UNSIGNED_BYTE;
2959 end;
2960
2961 procedure TfdAlpha16us1.SetValues;
2962 begin
2963   inherited SetValues;
2964   fBitsPerPixel     := 16;
2965   fFormat           := tfAlpha16us1;
2966   fWithAlpha        := tfAlpha16us1;
2967   fOpenGLFormat     := tfAlpha16us1;
2968   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);
2969   fShift            := glBitmapRec4ub(0, 0, 0,  0);
2970   fglFormat         := GL_ALPHA;
2971   fglInternalFormat := GL_ALPHA16;
2972   fglDataFormat     := GL_UNSIGNED_SHORT;
2973 end;
2974
2975 procedure TfdLuminance4ub1.SetValues;
2976 begin
2977   inherited SetValues;
2978   fBitsPerPixel     := 8;
2979   fFormat           := tfLuminance4ub1;
2980   fWithAlpha        := tfLuminance4Alpha4ub2;
2981   fWithoutAlpha     := tfLuminance4ub1;
2982   fOpenGLFormat     := tfLuminance4ub1;
2983   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2984   fShift            := glBitmapRec4ub(0, 0, 0, 0);
2985   fglFormat         := GL_LUMINANCE;
2986   fglInternalFormat := GL_LUMINANCE4;
2987   fglDataFormat     := GL_UNSIGNED_BYTE;
2988 end;
2989
2990 procedure TfdLuminance8ub1.SetValues;
2991 begin
2992   inherited SetValues;
2993   fBitsPerPixel     := 8;
2994   fFormat           := tfLuminance8ub1;
2995   fWithAlpha        := tfLuminance8Alpha8ub2;
2996   fWithoutAlpha     := tfLuminance8ub1;
2997   fOpenGLFormat     := tfLuminance8ub1;
2998   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);
2999   fShift            := glBitmapRec4ub(0, 0, 0, 0);
3000   fglFormat         := GL_LUMINANCE;
3001   fglInternalFormat := GL_LUMINANCE8;
3002   fglDataFormat     := GL_UNSIGNED_BYTE;
3003 end;
3004
3005 procedure TfdLuminance16us1.SetValues;
3006 begin
3007   inherited SetValues;
3008   fBitsPerPixel     := 16;
3009   fFormat           := tfLuminance16us1;
3010   fWithAlpha        := tfLuminance16Alpha16us2;
3011   fWithoutAlpha     := tfLuminance16us1;
3012   fOpenGLFormat     := tfLuminance16us1;
3013   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3014   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3015   fglFormat         := GL_LUMINANCE;
3016   fglInternalFormat := GL_LUMINANCE16;
3017   fglDataFormat     := GL_UNSIGNED_SHORT;
3018 end;
3019
3020 procedure TfdLuminance4Alpha4ub2.SetValues;
3021 begin
3022   inherited SetValues;
3023   fBitsPerPixel     := 16;
3024   fFormat           := tfLuminance4Alpha4ub2;
3025   fWithAlpha        := tfLuminance4Alpha4ub2;
3026   fWithoutAlpha     := tfLuminance4ub1;
3027   fOpenGLFormat     := tfLuminance4Alpha4ub2;
3028   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3029   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3030   fglFormat         := GL_LUMINANCE_ALPHA;
3031   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3032   fglDataFormat     := GL_UNSIGNED_BYTE;
3033 end;
3034
3035 procedure TfdLuminance6Alpha2ub2.SetValues;
3036 begin
3037   inherited SetValues;
3038   fBitsPerPixel     := 16;
3039   fFormat           := tfLuminance6Alpha2ub2;
3040   fWithAlpha        := tfLuminance6Alpha2ub2;
3041   fWithoutAlpha     := tfLuminance8ub1;
3042   fOpenGLFormat     := tfLuminance6Alpha2ub2;
3043   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3044   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3045   fglFormat         := GL_LUMINANCE_ALPHA;
3046   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3047   fglDataFormat     := GL_UNSIGNED_BYTE;
3048 end;
3049
3050 procedure TfdLuminance8Alpha8ub2.SetValues;
3051 begin
3052   inherited SetValues;
3053   fBitsPerPixel     := 16;
3054   fFormat           := tfLuminance8Alpha8ub2;
3055   fWithAlpha        := tfLuminance8Alpha8ub2;
3056   fWithoutAlpha     := tfLuminance8ub1;
3057   fOpenGLFormat     := tfLuminance8Alpha8ub2;
3058   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);
3059   fShift            := glBitmapRec4ub(0, 0, 0, 8);
3060   fglFormat         := GL_LUMINANCE_ALPHA;
3061   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3062   fglDataFormat     := GL_UNSIGNED_BYTE;
3063 end;
3064
3065 procedure TfdLuminance12Alpha4us2.SetValues;
3066 begin
3067   inherited SetValues;
3068   fBitsPerPixel     := 32;
3069   fFormat           := tfLuminance12Alpha4us2;
3070   fWithAlpha        := tfLuminance12Alpha4us2;
3071   fWithoutAlpha     := tfLuminance16us1;
3072   fOpenGLFormat     := tfLuminance12Alpha4us2;
3073   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3074   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3075   fglFormat         := GL_LUMINANCE_ALPHA;
3076   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3077   fglDataFormat     := GL_UNSIGNED_SHORT;
3078 end;
3079
3080 procedure TfdLuminance16Alpha16us2.SetValues;
3081 begin
3082   inherited SetValues;
3083   fBitsPerPixel     := 32;
3084   fFormat           := tfLuminance16Alpha16us2;
3085   fWithAlpha        := tfLuminance16Alpha16us2;
3086   fWithoutAlpha     := tfLuminance16us1;
3087   fOpenGLFormat     := tfLuminance16Alpha16us2;
3088   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3089   fShift            := glBitmapRec4ub( 0,  0,  0, 16);
3090   fglFormat         := GL_LUMINANCE_ALPHA;
3091   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3092   fglDataFormat     := GL_UNSIGNED_SHORT;
3093 end;
3094
3095 procedure TfdR3G3B2ub1.SetValues;
3096 begin
3097   inherited SetValues;
3098   fBitsPerPixel     := 8;
3099   fFormat           := tfR3G3B2ub1;
3100   fWithAlpha        := tfRGBA4us1;
3101   fWithoutAlpha     := tfR3G3B2ub1;
3102   fOpenGLFormat     := tfR3G3B2ub1;
3103   fRGBInverted      := tfEmpty;
3104   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);
3105   fShift            := glBitmapRec4ub(5, 2, 0, 0);
3106   fglFormat         := GL_RGB;
3107   fglInternalFormat := GL_R3_G3_B2;
3108   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;
3109 end;
3110
3111 procedure TfdRGBX4us1.SetValues;
3112 begin
3113   inherited SetValues;
3114   fBitsPerPixel     := 16;
3115   fFormat           := tfRGBX4us1;
3116   fWithAlpha        := tfRGBA4us1;
3117   fWithoutAlpha     := tfRGBX4us1;
3118   fOpenGLFormat     := tfRGBX4us1;
3119   fRGBInverted      := tfBGRX4us1;
3120   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);
3121   fShift            := glBitmapRec4ub(12, 8, 4, 0);
3122   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3123   fglInternalFormat := GL_RGB4;
3124   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3125 end;
3126
3127 procedure TfdXRGB4us1.SetValues;
3128 begin
3129   inherited SetValues;
3130   fBitsPerPixel     := 16;
3131   fFormat           := tfXRGB4us1;
3132   fWithAlpha        := tfARGB4us1;
3133   fWithoutAlpha     := tfXRGB4us1;
3134   fOpenGLFormat     := tfXRGB4us1;
3135   fRGBInverted      := tfXBGR4us1;
3136   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);
3137   fShift            := glBitmapRec4ub(8, 4, 0, 0);
3138   fglFormat         := GL_BGRA;
3139   fglInternalFormat := GL_RGB4;
3140   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3141 end;
3142
3143 procedure TfdR5G6B5us1.SetValues;
3144 begin
3145   inherited SetValues;
3146   fBitsPerPixel     := 16;
3147   fFormat           := tfR5G6B5us1;
3148   fWithAlpha        := tfRGB5A1us1;
3149   fWithoutAlpha     := tfR5G6B5us1;
3150   fOpenGLFormat     := tfR5G6B5us1;
3151   fRGBInverted      := tfB5G6R5us1;
3152   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);
3153   fShift            := glBitmapRec4ub(11, 5, 0, 0);
3154   fglFormat         := GL_RGB;
3155   fglInternalFormat := GL_RGB565;
3156   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3157 end;
3158
3159 procedure TfdRGB5X1us1.SetValues;
3160 begin
3161   inherited SetValues;
3162   fBitsPerPixel     := 16;
3163   fFormat           := tfRGB5X1us1;
3164   fWithAlpha        := tfRGB5A1us1;
3165   fWithoutAlpha     := tfRGB5X1us1;
3166   fOpenGLFormat     := tfRGB5X1us1;
3167   fRGBInverted      := tfBGR5X1us1;
3168   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3169   fShift            := glBitmapRec4ub(11, 6, 1, 0);
3170   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3171   fglInternalFormat := GL_RGB5;
3172   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3173 end;
3174
3175 procedure TfdX1RGB5us1.SetValues;
3176 begin
3177   inherited SetValues;
3178   fBitsPerPixel     := 16;
3179   fFormat           := tfX1RGB5us1;
3180   fWithAlpha        := tfA1RGB5us1;
3181   fWithoutAlpha     := tfX1RGB5us1;
3182   fOpenGLFormat     := tfX1RGB5us1;
3183   fRGBInverted      := tfX1BGR5us1;
3184   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);
3185   fShift            := glBitmapRec4ub(10, 5, 0, 0);
3186   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3187   fglInternalFormat := GL_RGB5;
3188   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3189 end;
3190
3191 procedure TfdRGB8ub3.SetValues;
3192 begin
3193   inherited SetValues;
3194   fBitsPerPixel     := 24;
3195   fFormat           := tfRGB8ub3;
3196   fWithAlpha        := tfRGBA8ub4;
3197   fWithoutAlpha     := tfRGB8ub3;
3198   fOpenGLFormat     := tfRGB8ub3;
3199   fRGBInverted      := tfBGR8ub3;
3200   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);
3201   fShift            := glBitmapRec4ub(0, 8, 16, 0);
3202   fglFormat         := GL_RGB;
3203   fglInternalFormat := GL_RGB8;
3204   fglDataFormat     := GL_UNSIGNED_BYTE;
3205 end;
3206
3207 procedure TfdRGBX8ui1.SetValues;
3208 begin
3209   inherited SetValues;
3210   fBitsPerPixel     := 32;
3211   fFormat           := tfRGBX8ui1;
3212   fWithAlpha        := tfRGBA8ui1;
3213   fWithoutAlpha     := tfRGBX8ui1;
3214   fOpenGLFormat     := tfRGB8ub3;
3215   fRGBInverted      := tfBGRX8ui1;
3216   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3217   fShift            := glBitmapRec4ub(24, 16,  8, 0);
3218   fglFormat         := GL_RGBA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3219   fglInternalFormat := GL_RGB8;
3220   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3221 end;
3222
3223 procedure TfdXRGB8ui1.SetValues;
3224 begin
3225   inherited SetValues;
3226   fBitsPerPixel     := 32;
3227   fFormat           := tfXRGB8ui1;
3228   fWithAlpha        := tfXRGB8ui1;
3229   fWithoutAlpha     := tfXRGB8ui1;
3230   fOpenGLFormat     := tfRGB8ub3;
3231   fRGBInverted      := tfXBGR8ui1;
3232   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);
3233   fShift            := glBitmapRec4ub(16,  8,  0, 0);
3234   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3235   fglInternalFormat := GL_RGB8;
3236   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3237 end;
3238
3239 procedure TfdRGB10X2ui1.SetValues;
3240 begin
3241   inherited SetValues;
3242   fBitsPerPixel     := 32;
3243   fFormat           := tfRGB10X2ui1;
3244   fWithAlpha        := tfRGB10A2ui1;
3245   fWithoutAlpha     := tfRGB10X2ui1;
3246   fOpenGLFormat     := tfRGB10X2ui1;
3247   fRGBInverted      := tfBGR10X2ui1;
3248   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3249   fShift            := glBitmapRec4ub(22, 12,  2, 0);
3250   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3251   fglInternalFormat := GL_RGB10;
3252   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3253 end;
3254
3255 procedure TfdX2RGB10ui1.SetValues;
3256 begin
3257   inherited SetValues;
3258   fBitsPerPixel     := 32;
3259   fFormat           := tfX2RGB10ui1;
3260   fWithAlpha        := tfA2RGB10ui1;
3261   fWithoutAlpha     := tfX2RGB10ui1;
3262   fOpenGLFormat     := tfX2RGB10ui1;
3263   fRGBInverted      := tfX2BGR10ui1;
3264   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);
3265   fShift            := glBitmapRec4ub(20, 10,  0, 0);
3266   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3267   fglInternalFormat := GL_RGB10;
3268   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3269 end;
3270
3271 procedure TfdRGB16us3.SetValues;
3272 begin
3273   inherited SetValues;
3274   fBitsPerPixel     := 48;
3275   fFormat           := tfRGB16us3;
3276   fWithAlpha        := tfRGBA16us4;
3277   fWithoutAlpha     := tfRGB16us3;
3278   fOpenGLFormat     := tfRGB16us3;
3279   fRGBInverted      := tfBGR16us3;
3280   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);
3281   fShift            := glBitmapRec4ub( 0, 16, 32, 0);
3282   fglFormat         := GL_RGB;
3283   fglInternalFormat := GL_RGB16;
3284   fglDataFormat     := GL_UNSIGNED_SHORT;
3285 end;
3286
3287 procedure TfdRGBA4us1.SetValues;
3288 begin
3289   inherited SetValues;
3290   fBitsPerPixel     := 16;
3291   fFormat           := tfRGBA4us1;
3292   fWithAlpha        := tfRGBA4us1;
3293   fWithoutAlpha     := tfRGBX4us1;
3294   fOpenGLFormat     := tfRGBA4us1;
3295   fRGBInverted      := tfBGRA4us1;
3296   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3297   fShift            := glBitmapRec4ub(12,  8,  4,  0);
3298   fglFormat         := GL_RGBA;
3299   fglInternalFormat := GL_RGBA4;
3300   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3301 end;
3302
3303 procedure TfdARGB4us1.SetValues;
3304 begin
3305   inherited SetValues;
3306   fBitsPerPixel     := 16;
3307   fFormat           := tfARGB4us1;
3308   fWithAlpha        := tfARGB4us1;
3309   fWithoutAlpha     := tfXRGB4us1;
3310   fOpenGLFormat     := tfARGB4us1;
3311   fRGBInverted      := tfABGR4us1;
3312   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3313   fShift            := glBitmapRec4ub( 8,  4,  0, 12);
3314   fglFormat         := GL_BGRA;
3315   fglInternalFormat := GL_RGBA4;
3316   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3317 end;
3318
3319 procedure TfdRGB5A1us1.SetValues;
3320 begin
3321   inherited SetValues;
3322   fBitsPerPixel     := 16;
3323   fFormat           := tfRGB5A1us1;
3324   fWithAlpha        := tfRGB5A1us1;
3325   fWithoutAlpha     := tfRGB5X1us1;
3326   fOpenGLFormat     := tfRGB5A1us1;
3327   fRGBInverted      := tfBGR5A1us1;
3328   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3329   fShift            := glBitmapRec4ub(11,  6,  1,  0);
3330   fglFormat         := GL_RGBA;
3331   fglInternalFormat := GL_RGB5_A1;
3332   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3333 end;
3334
3335 procedure TfdA1RGB5us1.SetValues;
3336 begin
3337   inherited SetValues;
3338   fBitsPerPixel     := 16;
3339   fFormat           := tfA1RGB5us1;
3340   fWithAlpha        := tfA1RGB5us1;
3341   fWithoutAlpha     := tfX1RGB5us1;
3342   fOpenGLFormat     := tfA1RGB5us1;
3343   fRGBInverted      := tfA1BGR5us1;
3344   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3345   fShift            := glBitmapRec4ub(10,  5,  0, 15);
3346   fglFormat         := GL_BGRA;
3347   fglInternalFormat := GL_RGB5_A1;
3348   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3349 end;
3350
3351 procedure TfdRGBA8ui1.SetValues;
3352 begin
3353   inherited SetValues;
3354   fBitsPerPixel     := 32;
3355   fFormat           := tfRGBA8ui1;
3356   fWithAlpha        := tfRGBA8ui1;
3357   fWithoutAlpha     := tfRGBX8ui1;
3358   fOpenGLFormat     := tfRGBA8ui1;
3359   fRGBInverted      := tfBGRA8ui1;
3360   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3361   fShift            := glBitmapRec4ub(24, 16,  8,  0);
3362   fglFormat         := GL_RGBA;
3363   fglInternalFormat := GL_RGBA8;
3364   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3365 end;
3366
3367 procedure TfdARGB8ui1.SetValues;
3368 begin
3369   inherited SetValues;
3370   fBitsPerPixel     := 32;
3371   fFormat           := tfARGB8ui1;
3372   fWithAlpha        := tfARGB8ui1;
3373   fWithoutAlpha     := tfXRGB8ui1;
3374   fOpenGLFormat     := tfARGB8ui1;
3375   fRGBInverted      := tfABGR8ui1;
3376   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3377   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3378   fglFormat         := GL_BGRA;
3379   fglInternalFormat := GL_RGBA8;
3380   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3381 end;
3382
3383 procedure TfdRGBA8ub4.SetValues;
3384 begin
3385   inherited SetValues;
3386   fBitsPerPixel     := 32;
3387   fFormat           := tfRGBA8ub4;
3388   fWithAlpha        := tfRGBA8ub4;
3389   fWithoutAlpha     := tfRGB8ub3;
3390   fOpenGLFormat     := tfRGBA8ub4;
3391   fRGBInverted      := tfBGRA8ub4;
3392   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3393   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3394   fglFormat         := GL_RGBA;
3395   fglInternalFormat := GL_RGBA8;
3396   fglDataFormat     := GL_UNSIGNED_BYTE;
3397 end;
3398
3399 procedure TfdRGB10A2ui1.SetValues;
3400 begin
3401   inherited SetValues;
3402   fBitsPerPixel     := 32;
3403   fFormat           := tfRGB10A2ui1;
3404   fWithAlpha        := tfRGB10A2ui1;
3405   fWithoutAlpha     := tfRGB10X2ui1;
3406   fOpenGLFormat     := tfRGB10A2ui1;
3407   fRGBInverted      := tfBGR10A2ui1;
3408   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3409   fShift            := glBitmapRec4ub(22, 12,  2,  0);
3410   fglFormat         := GL_RGBA;
3411   fglInternalFormat := GL_RGB10_A2;
3412   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3413 end;
3414
3415 procedure TfdA2RGB10ui1.SetValues;
3416 begin
3417   inherited SetValues;
3418   fBitsPerPixel     := 32;
3419   fFormat           := tfA2RGB10ui1;
3420   fWithAlpha        := tfA2RGB10ui1;
3421   fWithoutAlpha     := tfX2RGB10ui1;
3422   fOpenGLFormat     := tfA2RGB10ui1;
3423   fRGBInverted      := tfA2BGR10ui1;
3424   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3425   fShift            := glBitmapRec4ub(20, 10,  0, 30);
3426   fglFormat         := GL_BGRA;
3427   fglInternalFormat := GL_RGB10_A2;
3428   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3429 end;
3430
3431 procedure TfdRGBA16us4.SetValues;
3432 begin
3433   inherited SetValues;
3434   fBitsPerPixel     := 64;
3435   fFormat           := tfRGBA16us4;
3436   fWithAlpha        := tfRGBA16us4;
3437   fWithoutAlpha     := tfRGB16us3;
3438   fOpenGLFormat     := tfRGBA16us4;
3439   fRGBInverted      := tfBGRA16us4;
3440   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3441   fShift            := glBitmapRec4ub( 0, 16, 32, 48);
3442   fglFormat         := GL_RGBA;
3443   fglInternalFormat := GL_RGBA16;
3444   fglDataFormat     := GL_UNSIGNED_SHORT;
3445 end;
3446
3447 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3449 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3450 procedure TfdBGRX4us1.SetValues;
3451 begin
3452   inherited SetValues;
3453   fBitsPerPixel     := 16;
3454   fFormat           := tfBGRX4us1;
3455   fWithAlpha        := tfBGRA4us1;
3456   fWithoutAlpha     := tfBGRX4us1;
3457   fOpenGLFormat     := tfBGRX4us1;
3458   fRGBInverted      := tfRGBX4us1;
3459   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3460   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3461   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3462   fglInternalFormat := GL_RGB4;
3463   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3464 end;
3465
3466 procedure TfdXBGR4us1.SetValues;
3467 begin
3468   inherited SetValues;
3469   fBitsPerPixel     := 16;
3470   fFormat           := tfXBGR4us1;
3471   fWithAlpha        := tfABGR4us1;
3472   fWithoutAlpha     := tfXBGR4us1;
3473   fOpenGLFormat     := tfXBGR4us1;
3474   fRGBInverted      := tfXRGB4us1;
3475   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);
3476   fShift            := glBitmapRec4ub( 0,  4,  8,  0);
3477   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3478   fglInternalFormat := GL_RGB4;
3479   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3480 end;
3481
3482 procedure TfdB5G6R5us1.SetValues;
3483 begin
3484   inherited SetValues;
3485   fBitsPerPixel     := 16;
3486   fFormat           := tfB5G6R5us1;
3487   fWithAlpha        := tfBGR5A1us1;
3488   fWithoutAlpha     := tfB5G6R5us1;
3489   fOpenGLFormat     := tfB5G6R5us1;
3490   fRGBInverted      := tfR5G6B5us1;
3491   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);
3492   fShift            := glBitmapRec4ub( 0,  5, 11,  0);
3493   fglFormat         := GL_RGB;
3494   fglInternalFormat := GL_RGB565;
3495   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3496 end;
3497
3498 procedure TfdBGR5X1us1.SetValues;
3499 begin
3500   inherited SetValues;
3501   fBitsPerPixel     := 16;
3502   fFormat           := tfBGR5X1us1;
3503   fWithAlpha        := tfBGR5A1us1;
3504   fWithoutAlpha     := tfBGR5X1us1;
3505   fOpenGLFormat     := tfBGR5X1us1;
3506   fRGBInverted      := tfRGB5X1us1;
3507   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3508   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3509   fglFormat         := GL_BGRA;
3510   fglInternalFormat := GL_RGB5;
3511   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3512 end;
3513
3514 procedure TfdX1BGR5us1.SetValues;
3515 begin
3516   inherited SetValues;
3517   fBitsPerPixel     := 16;
3518   fFormat           := tfX1BGR5us1;
3519   fWithAlpha        := tfA1BGR5us1;
3520   fWithoutAlpha     := tfX1BGR5us1;
3521   fOpenGLFormat     := tfX1BGR5us1;
3522   fRGBInverted      := tfX1RGB5us1;
3523   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);
3524   fShift            := glBitmapRec4ub( 0,  5, 10,  0);
3525   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3526   fglInternalFormat := GL_RGB5;
3527   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3528 end;
3529
3530 procedure TfdBGR8ub3.SetValues;
3531 begin
3532   inherited SetValues;
3533   fBitsPerPixel     := 24;
3534   fFormat           := tfBGR8ub3;
3535   fWithAlpha        := tfBGRA8ub4;
3536   fWithoutAlpha     := tfBGR8ub3;
3537   fOpenGLFormat     := tfBGR8ub3;
3538   fRGBInverted      := tfRGB8ub3;
3539   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3540   fShift            := glBitmapRec4ub(16,  8,  0,  0);
3541   fglFormat         := GL_BGR;
3542   fglInternalFormat := GL_RGB8;
3543   fglDataFormat     := GL_UNSIGNED_BYTE;
3544 end;
3545
3546 procedure TfdBGRX8ui1.SetValues;
3547 begin
3548   inherited SetValues;
3549   fBitsPerPixel     := 32;
3550   fFormat           := tfBGRX8ui1;
3551   fWithAlpha        := tfBGRA8ui1;
3552   fWithoutAlpha     := tfBGRX8ui1;
3553   fOpenGLFormat     := tfBGRX8ui1;
3554   fRGBInverted      := tfRGBX8ui1;
3555   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3556   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3557   fglFormat         := GL_BGRA;  //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3558   fglInternalFormat := GL_RGB8;
3559   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3560 end;
3561
3562 procedure TfdXBGR8ui1.SetValues;
3563 begin
3564   inherited SetValues;
3565   fBitsPerPixel     := 32;
3566   fFormat           := tfXBGR8ui1;
3567   fWithAlpha        := tfABGR8ui1;
3568   fWithoutAlpha     := tfXBGR8ui1;
3569   fOpenGLFormat     := tfXBGR8ui1;
3570   fRGBInverted      := tfXRGB8ui1;
3571   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);
3572   fShift            := glBitmapRec4ub( 0,  8, 16,  0);
3573   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3574   fglInternalFormat := GL_RGB8;
3575   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3576 end;
3577
3578 procedure TfdBGR10X2ui1.SetValues;
3579 begin
3580   inherited SetValues;
3581   fBitsPerPixel     := 32;
3582   fFormat           := tfBGR10X2ui1;
3583   fWithAlpha        := tfBGR10A2ui1;
3584   fWithoutAlpha     := tfBGR10X2ui1;
3585   fOpenGLFormat     := tfBGR10X2ui1;
3586   fRGBInverted      := tfRGB10X2ui1;
3587   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3588   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3589   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3590   fglInternalFormat := GL_RGB10;
3591   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3592 end;
3593
3594 procedure TfdX2BGR10ui1.SetValues;
3595 begin
3596   inherited SetValues;
3597   fBitsPerPixel     := 32;
3598   fFormat           := tfX2BGR10ui1;
3599   fWithAlpha        := tfA2BGR10ui1;
3600   fWithoutAlpha     := tfX2BGR10ui1;
3601   fOpenGLFormat     := tfX2BGR10ui1;
3602   fRGBInverted      := tfX2RGB10ui1;
3603   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);
3604   fShift            := glBitmapRec4ub( 0, 10, 20,  0);
3605   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3606   fglInternalFormat := GL_RGB10;
3607   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3608 end;
3609
3610 procedure TfdBGR16us3.SetValues;
3611 begin
3612   inherited SetValues;
3613   fBitsPerPixel     := 48;
3614   fFormat           := tfBGR16us3;
3615   fWithAlpha        := tfBGRA16us4;
3616   fWithoutAlpha     := tfBGR16us3;
3617   fOpenGLFormat     := tfBGR16us3;
3618   fRGBInverted      := tfRGB16us3;
3619   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);
3620   fShift            := glBitmapRec4ub(32, 16,  0,  0);
3621   fglFormat         := GL_BGR;
3622   fglInternalFormat := GL_RGB16;
3623   fglDataFormat     := GL_UNSIGNED_SHORT;
3624 end;
3625
3626 procedure TfdBGRA4us1.SetValues;
3627 begin
3628   inherited SetValues;
3629   fBitsPerPixel     := 16;
3630   fFormat           := tfBGRA4us1;
3631   fWithAlpha        := tfBGRA4us1;
3632   fWithoutAlpha     := tfBGRX4us1;
3633   fOpenGLFormat     := tfBGRA4us1;
3634   fRGBInverted      := tfRGBA4us1;
3635   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3636   fShift            := glBitmapRec4ub( 4,  8, 12,  0);
3637   fglFormat         := GL_BGRA;
3638   fglInternalFormat := GL_RGBA4;
3639   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;
3640 end;
3641
3642 procedure TfdABGR4us1.SetValues;
3643 begin
3644   inherited SetValues;
3645   fBitsPerPixel     := 16;
3646   fFormat           := tfABGR4us1;
3647   fWithAlpha        := tfABGR4us1;
3648   fWithoutAlpha     := tfXBGR4us1;
3649   fOpenGLFormat     := tfABGR4us1;
3650   fRGBInverted      := tfARGB4us1;
3651   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);
3652   fShift            := glBitmapRec4ub( 0,  4,  8, 12);
3653   fglFormat         := GL_RGBA;
3654   fglInternalFormat := GL_RGBA4;
3655   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3656 end;
3657
3658 procedure TfdBGR5A1us1.SetValues;
3659 begin
3660   inherited SetValues;
3661   fBitsPerPixel     := 16;
3662   fFormat           := tfBGR5A1us1;
3663   fWithAlpha        := tfBGR5A1us1;
3664   fWithoutAlpha     := tfBGR5X1us1;
3665   fOpenGLFormat     := tfBGR5A1us1;
3666   fRGBInverted      := tfRGB5A1us1;
3667   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3668   fShift            := glBitmapRec4ub( 1,  6, 11,  0);
3669   fglFormat         := GL_BGRA;
3670   fglInternalFormat := GL_RGB5_A1;
3671   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;
3672 end;
3673
3674 procedure TfdA1BGR5us1.SetValues;
3675 begin
3676   inherited SetValues;
3677   fBitsPerPixel     := 16;
3678   fFormat           := tfA1BGR5us1;
3679   fWithAlpha        := tfA1BGR5us1;
3680   fWithoutAlpha     := tfX1BGR5us1;
3681   fOpenGLFormat     := tfA1BGR5us1;
3682   fRGBInverted      := tfA1RGB5us1;
3683   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);
3684   fShift            := glBitmapRec4ub( 0,  5, 10, 15);
3685   fglFormat         := GL_RGBA;
3686   fglInternalFormat := GL_RGB5_A1;
3687   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3688 end;
3689
3690 procedure TfdBGRA8ui1.SetValues;
3691 begin
3692   inherited SetValues;
3693   fBitsPerPixel     := 32;
3694   fFormat           := tfBGRA8ui1;
3695   fWithAlpha        := tfBGRA8ui1;
3696   fWithoutAlpha     := tfBGRX8ui1;
3697   fOpenGLFormat     := tfBGRA8ui1;
3698   fRGBInverted      := tfRGBA8ui1;
3699   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3700   fShift            := glBitmapRec4ub( 8, 16, 24,  0);
3701   fglFormat         := GL_BGRA;
3702   fglInternalFormat := GL_RGBA8;
3703   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;
3704 end;
3705
3706 procedure TfdABGR8ui1.SetValues;
3707 begin
3708   inherited SetValues;
3709   fBitsPerPixel     := 32;
3710   fFormat           := tfABGR8ui1;
3711   fWithAlpha        := tfABGR8ui1;
3712   fWithoutAlpha     := tfXBGR8ui1;
3713   fOpenGLFormat     := tfABGR8ui1;
3714   fRGBInverted      := tfARGB8ui1;
3715   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3716   fShift            := glBitmapRec4ub( 0,  8, 16, 24);
3717   fglFormat         := GL_RGBA;
3718   fglInternalFormat := GL_RGBA8;
3719   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;
3720 end;
3721
3722 procedure TfdBGRA8ub4.SetValues;
3723 begin
3724   inherited SetValues;
3725   fBitsPerPixel     := 32;
3726   fFormat           := tfBGRA8ub4;
3727   fWithAlpha        := tfBGRA8ub4;
3728   fWithoutAlpha     := tfBGR8ub3;
3729   fOpenGLFormat     := tfBGRA8ub4;
3730   fRGBInverted      := tfRGBA8ub4;
3731   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);
3732   fShift            := glBitmapRec4ub(16,  8,  0, 24);
3733   fglFormat         := GL_BGRA;
3734   fglInternalFormat := GL_RGBA8;
3735   fglDataFormat     := GL_UNSIGNED_BYTE;
3736 end;
3737
3738 procedure TfdBGR10A2ui1.SetValues;
3739 begin
3740   inherited SetValues;
3741   fBitsPerPixel     := 32;
3742   fFormat           := tfBGR10A2ui1;
3743   fWithAlpha        := tfBGR10A2ui1;
3744   fWithoutAlpha     := tfBGR10X2ui1;
3745   fOpenGLFormat     := tfBGR10A2ui1;
3746   fRGBInverted      := tfRGB10A2ui1;
3747   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3748   fShift            := glBitmapRec4ub( 2, 12, 22,  0);
3749   fglFormat         := GL_BGRA;
3750   fglInternalFormat := GL_RGB10_A2;
3751   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;
3752 end;
3753
3754 procedure TfdA2BGR10ui1.SetValues;
3755 begin
3756   inherited SetValues;
3757   fBitsPerPixel     := 32;
3758   fFormat           := tfA2BGR10ui1;
3759   fWithAlpha        := tfA2BGR10ui1;
3760   fWithoutAlpha     := tfX2BGR10ui1;
3761   fOpenGLFormat     := tfA2BGR10ui1;
3762   fRGBInverted      := tfA2RGB10ui1;
3763   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);
3764   fShift            := glBitmapRec4ub( 0, 10, 20, 30);
3765   fglFormat         := GL_RGBA;
3766   fglInternalFormat := GL_RGB10_A2;
3767   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3768 end;
3769
3770 procedure TfdBGRA16us4.SetValues;
3771 begin
3772   inherited SetValues;
3773   fBitsPerPixel     := 64;
3774   fFormat           := tfBGRA16us4;
3775   fWithAlpha        := tfBGRA16us4;
3776   fWithoutAlpha     := tfBGR16us3;
3777   fOpenGLFormat     := tfBGRA16us4;
3778   fRGBInverted      := tfRGBA16us4;
3779   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3780   fShift            := glBitmapRec4ub(32, 16,  0, 48);
3781   fglFormat         := GL_BGRA;
3782   fglInternalFormat := GL_RGBA16;
3783   fglDataFormat     := GL_UNSIGNED_SHORT;
3784 end;
3785
3786 procedure TfdDepth16us1.SetValues;
3787 begin
3788   inherited SetValues;
3789   fBitsPerPixel     := 16;
3790   fFormat           := tfDepth16us1;
3791   fWithoutAlpha     := tfDepth16us1;
3792   fOpenGLFormat     := tfDepth16us1;
3793   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);
3794   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3795   fglFormat         := GL_DEPTH_COMPONENT;
3796   fglInternalFormat := GL_DEPTH_COMPONENT16;
3797   fglDataFormat     := GL_UNSIGNED_SHORT;
3798 end;
3799
3800 procedure TfdDepth24ui1.SetValues;
3801 begin
3802   inherited SetValues;
3803   fBitsPerPixel     := 32;
3804   fFormat           := tfDepth24ui1;
3805   fWithoutAlpha     := tfDepth24ui1;
3806   fOpenGLFormat     := tfDepth24ui1;
3807   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3808   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3809   fglFormat         := GL_DEPTH_COMPONENT;
3810   fglInternalFormat := GL_DEPTH_COMPONENT24;
3811   fglDataFormat     := GL_UNSIGNED_INT;
3812 end;
3813
3814 procedure TfdDepth32ui1.SetValues;
3815 begin
3816   inherited SetValues;
3817   fBitsPerPixel     := 32;
3818   fFormat           := tfDepth32ui1;
3819   fWithoutAlpha     := tfDepth32ui1;
3820   fOpenGLFormat     := tfDepth32ui1;
3821   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);
3822   fShift            := glBitmapRec4ub( 0,  0,  0,  0);
3823   fglFormat         := GL_DEPTH_COMPONENT;
3824   fglInternalFormat := GL_DEPTH_COMPONENT32;
3825   fglDataFormat     := GL_UNSIGNED_INT;
3826 end;
3827
3828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3829 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3830 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3831 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3832 begin
3833   raise EglBitmap.Create('mapping for compressed formats is not supported');
3834 end;
3835
3836 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3837 begin
3838   raise EglBitmap.Create('mapping for compressed formats is not supported');
3839 end;
3840
3841 procedure TfdS3tcDtx1RGBA.SetValues;
3842 begin
3843   inherited SetValues;
3844   fFormat           := tfS3tcDtx1RGBA;
3845   fWithAlpha        := tfS3tcDtx1RGBA;
3846   fOpenGLFormat     := tfS3tcDtx1RGBA;
3847   fUncompressed     := tfRGB5A1us1;
3848   fBitsPerPixel     := 4;
3849   fIsCompressed     := true;
3850   fglFormat         := GL_COMPRESSED_RGBA;
3851   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3852   fglDataFormat     := GL_UNSIGNED_BYTE;
3853 end;
3854
3855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3856 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3857 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3858 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3859 begin
3860   raise EglBitmap.Create('mapping for compressed formats is not supported');
3861 end;
3862
3863 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3864 begin
3865   raise EglBitmap.Create('mapping for compressed formats is not supported');
3866 end;
3867
3868 procedure TfdS3tcDtx3RGBA.SetValues;
3869 begin
3870   inherited SetValues;
3871   fFormat           := tfS3tcDtx3RGBA;
3872   fWithAlpha        := tfS3tcDtx3RGBA;
3873   fOpenGLFormat     := tfS3tcDtx3RGBA;
3874   fUncompressed     := tfRGBA8ub4;
3875   fBitsPerPixel     := 8;
3876   fIsCompressed     := true;
3877   fglFormat         := GL_COMPRESSED_RGBA;
3878   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3879   fglDataFormat     := GL_UNSIGNED_BYTE;
3880 end;
3881
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3885 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3886 begin
3887   raise EglBitmap.Create('mapping for compressed formats is not supported');
3888 end;
3889
3890 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3891 begin
3892   raise EglBitmap.Create('mapping for compressed formats is not supported');
3893 end;
3894
3895 procedure TfdS3tcDtx5RGBA.SetValues;
3896 begin
3897   inherited SetValues;
3898   fFormat           := tfS3tcDtx3RGBA;
3899   fWithAlpha        := tfS3tcDtx3RGBA;
3900   fOpenGLFormat     := tfS3tcDtx3RGBA;
3901   fUncompressed     := tfRGBA8ub4;
3902   fBitsPerPixel     := 8;
3903   fIsCompressed     := true;
3904   fglFormat         := GL_COMPRESSED_RGBA;
3905   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3906   fglDataFormat     := GL_UNSIGNED_BYTE;
3907 end;
3908
3909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3910 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3912 function TglBitmapFormatDescriptor.GetHasRed: Boolean;
3913 begin
3914   result := (fPrecision.r > 0);
3915 end;
3916
3917 function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
3918 begin
3919   result := (fPrecision.g > 0);
3920 end;
3921
3922 function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
3923 begin
3924   result := (fPrecision.b > 0);
3925 end;
3926
3927 function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
3928 begin
3929   result := (fPrecision.a > 0);
3930 end;
3931
3932 function TglBitmapFormatDescriptor.GetHasColor: Boolean;
3933 begin
3934   result := HasRed or HasGreen or HasBlue;
3935 end;
3936
3937 function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
3938 begin
3939   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
3940 end;
3941
3942 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3943 procedure TglBitmapFormatDescriptor.SetValues;
3944 begin
3945   fFormat       := tfEmpty;
3946   fWithAlpha    := tfEmpty;
3947   fWithoutAlpha := tfEmpty;
3948   fOpenGLFormat := tfEmpty;
3949   fRGBInverted  := tfEmpty;
3950   fUncompressed := tfEmpty;
3951
3952   fBitsPerPixel := 0;
3953   fIsCompressed := false;
3954
3955   fglFormat         := 0;
3956   fglInternalFormat := 0;
3957   fglDataFormat     := 0;
3958
3959   FillChar(fPrecision, 0, SizeOf(fPrecision));
3960   FillChar(fShift,     0, SizeOf(fShift));
3961 end;
3962
3963 procedure TglBitmapFormatDescriptor.CalcValues;
3964 var
3965   i: Integer;
3966 begin
3967   fBytesPerPixel := fBitsPerPixel / 8;
3968   fChannelCount  := 0;
3969   for i := 0 to 3 do begin
3970     if (fPrecision.arr[i] > 0) then
3971       inc(fChannelCount);
3972     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
3973     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];
3974   end;
3975 end;
3976
3977 constructor TglBitmapFormatDescriptor.Create;
3978 begin
3979   inherited Create;
3980   SetValues;
3981   CalcValues;
3982 end;
3983
3984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3985 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3986 var
3987   f: TglBitmapFormat;
3988 begin
3989   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3990     result := TFormatDescriptor.Get(f);
3991     if (result.glInternalFormat = aInternalFormat) then
3992       exit;
3993   end;
3994   result := TFormatDescriptor.Get(tfEmpty);
3995 end;
3996
3997 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3998 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4000 class procedure TFormatDescriptor.Init;
4001 begin
4002   if not Assigned(FormatDescriptorCS) then
4003     FormatDescriptorCS := TCriticalSection.Create;
4004 end;
4005
4006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4007 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
4008 begin
4009   FormatDescriptorCS.Enter;
4010   try
4011     result := FormatDescriptors[aFormat];
4012     if not Assigned(result) then begin
4013       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
4014       FormatDescriptors[aFormat] := result;
4015     end;
4016   finally
4017     FormatDescriptorCS.Leave;
4018   end;
4019 end;
4020
4021 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4022 class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
4023 begin
4024   result := Get(Get(aFormat).WithAlpha);
4025 end;
4026
4027 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4028 class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
4029 var
4030   ft: TglBitmapFormat;
4031 begin
4032   // find matching format with OpenGL support
4033   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4034     result := Get(ft);
4035     if (result.MaskMatch(aMask))      and
4036        (result.glFormat <> 0)         and
4037        (result.glInternalFormat <> 0) and
4038        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4039     then
4040       exit;
4041   end;
4042
4043   // find matching format without OpenGL Support
4044   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4045     result := Get(ft);
4046     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4047       exit;
4048   end;
4049
4050   result := TFormatDescriptor.Get(tfEmpty);
4051 end;
4052
4053 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4054 class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
4055 var
4056   ft: TglBitmapFormat;
4057 begin
4058   // find matching format with OpenGL support
4059   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4060     result := Get(ft);
4061     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4062        glBitmapRec4ubCompare(result.Precision, aPrec) and
4063        (result.glFormat <> 0)         and
4064        (result.glInternalFormat <> 0) and
4065        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
4066     then
4067       exit;
4068   end;
4069
4070   // find matching format without OpenGL Support
4071   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
4072     result := Get(ft);
4073     if glBitmapRec4ubCompare(result.Shift,     aShift) and
4074        glBitmapRec4ubCompare(result.Precision, aPrec)  and
4075        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
4076       exit;
4077   end;
4078
4079   result := TFormatDescriptor.Get(tfEmpty);
4080 end;
4081
4082 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4083 class procedure TFormatDescriptor.Clear;
4084 var
4085   f: TglBitmapFormat;
4086 begin
4087   FormatDescriptorCS.Enter;
4088   try
4089     for f := low(FormatDescriptors) to high(FormatDescriptors) do
4090       FreeAndNil(FormatDescriptors[f]);
4091   finally
4092     FormatDescriptorCS.Leave;
4093   end;
4094 end;
4095
4096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4097 class procedure TFormatDescriptor.Finalize;
4098 begin
4099   Clear;
4100   FreeAndNil(FormatDescriptorCS);
4101 end;
4102
4103 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4104 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4105 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4106 procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
4107 var
4108   i: Integer;
4109 begin
4110   for i := 0 to 3 do begin
4111     fShift.arr[i] := 0;
4112     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
4113       aMask.arr[i] := aMask.arr[i] shr 1;
4114       inc(fShift.arr[i]);
4115     end;
4116     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
4117   end;
4118   CalcValues;
4119 end;
4120
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4123 begin
4124   fBitsPerPixel := aBBP;
4125   fPrecision    := aPrec;
4126   fShift        := aShift;
4127   CalcValues;
4128 end;
4129
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4132 var
4133   data: QWord;
4134 begin
4135   data :=
4136     ((aPixel.Data.r and Range.r) shl Shift.r) or
4137     ((aPixel.Data.g and Range.g) shl Shift.g) or
4138     ((aPixel.Data.b and Range.b) shl Shift.b) or
4139     ((aPixel.Data.a and Range.a) shl Shift.a);
4140   case BitsPerPixel of
4141     8:           aData^  := data;
4142    16:     PWord(aData)^ := data;
4143    32: PCardinal(aData)^ := data;
4144    64:    PQWord(aData)^ := data;
4145   else
4146     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4147   end;
4148   inc(aData, Round(BytesPerPixel));
4149 end;
4150
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4153 var
4154   data: QWord;
4155   i: Integer;
4156 begin
4157   case BitsPerPixel of
4158      8: data :=           aData^;
4159     16: data :=     PWord(aData)^;
4160     32: data := PCardinal(aData)^;
4161     64: data :=    PQWord(aData)^;
4162   else
4163     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
4164   end;
4165   for i := 0 to 3 do
4166     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
4167   inc(aData, Round(BytesPerPixel));
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4173 procedure TbmpColorTableFormat.SetValues;
4174 begin
4175   inherited SetValues;
4176   fShift := glBitmapRec4ub(8, 8, 8, 0);
4177 end;
4178
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
4181 begin
4182   fFormat       := aFormat;
4183   fBitsPerPixel := aBPP;
4184   fPrecision    := aPrec;
4185   fShift        := aShift;
4186   CalcValues;
4187 end;
4188
4189 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4190 procedure TbmpColorTableFormat.CalcValues;
4191 begin
4192   inherited CalcValues;
4193 end;
4194
4195 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4196 procedure TbmpColorTableFormat.CreateColorTable;
4197 var
4198   i: Integer;
4199 begin
4200   SetLength(fColorTable, 256);
4201   if not HasColor then begin
4202     // alpha
4203     for i := 0 to High(fColorTable) do begin
4204       fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4205       fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4206       fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
4207       fColorTable[i].a := 0;
4208     end;
4209   end else begin
4210     // normal
4211     for i := 0 to High(fColorTable) do begin
4212       fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
4213       fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
4214       fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
4215       fColorTable[i].a := 0;
4216     end;
4217   end;
4218 end;
4219
4220 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4221 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
4222 begin
4223   if (BitsPerPixel <> 8) then
4224     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4225   if not HasColor then
4226     // alpha
4227     aData^ := aPixel.Data.a
4228   else
4229     // normal
4230     aData^ := Round(
4231       ((aPixel.Data.r and Range.r) shl Shift.r) or
4232       ((aPixel.Data.g and Range.g) shl Shift.g) or
4233       ((aPixel.Data.b and Range.b) shl Shift.b));
4234   inc(aData);
4235 end;
4236
4237 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4238 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
4239 begin
4240   if (BitsPerPixel <> 8) then
4241     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
4242   with fColorTable[aData^] do begin
4243     aPixel.Data.r := r;
4244     aPixel.Data.g := g;
4245     aPixel.Data.b := b;
4246     aPixel.Data.a := a;
4247   end;
4248   inc(aData, 1);
4249 end;
4250
4251 destructor TbmpColorTableFormat.Destroy;
4252 begin
4253   SetLength(fColorTable, 0);
4254   inherited Destroy;
4255 end;
4256
4257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4258 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4261 var
4262   i: Integer;
4263 begin
4264   for i := 0 to 3 do begin
4265     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4266       if (aSourceFD.Range.arr[i] > 0) then
4267         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4268       else
4269         aPixel.Data.arr[i] := 0;
4270     end;
4271   end;
4272 end;
4273
4274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4275 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4276 begin
4277   with aFuncRec do begin
4278     if (Source.Range.r   > 0) then
4279       Dest.Data.r := Source.Data.r;
4280     if (Source.Range.g > 0) then
4281       Dest.Data.g := Source.Data.g;
4282     if (Source.Range.b  > 0) then
4283       Dest.Data.b := Source.Data.b;
4284     if (Source.Range.a > 0) then
4285       Dest.Data.a := Source.Data.a;
4286   end;
4287 end;
4288
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4291 var
4292   i: Integer;
4293 begin
4294   with aFuncRec do begin
4295     for i := 0 to 3 do
4296       if (Source.Range.arr[i] > 0) then
4297         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4298   end;
4299 end;
4300
4301 type
4302   TShiftData = packed record
4303     case Integer of
4304       0: (r, g, b, a: SmallInt);
4305       1: (arr: array[0..3] of SmallInt);
4306   end;
4307   PShiftData = ^TShiftData;
4308
4309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4310 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4311 var
4312   i: Integer;
4313 begin
4314   with aFuncRec do
4315     for i := 0 to 3 do
4316       if (Source.Range.arr[i] > 0) then
4317         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4318 end;
4319
4320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4321 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4322 begin
4323   with aFuncRec do begin
4324     Dest.Data := Source.Data;
4325     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4326       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4327       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4328       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4329     end;
4330     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4331       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4332     end;
4333   end;
4334 end;
4335
4336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4337 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4338 var
4339   i: Integer;
4340 begin
4341   with aFuncRec do begin
4342     for i := 0 to 3 do
4343       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4344   end;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4349 var
4350   Temp: Single;
4351 begin
4352   with FuncRec do begin
4353     if (FuncRec.Args = nil) then begin //source has no alpha
4354       Temp :=
4355         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4356         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4357         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4358       Dest.Data.a := Round(Dest.Range.a * Temp);
4359     end else
4360       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4361   end;
4362 end;
4363
4364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4365 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4366 type
4367   PglBitmapPixelData = ^TglBitmapPixelData;
4368 begin
4369   with FuncRec do begin
4370     Dest.Data.r := Source.Data.r;
4371     Dest.Data.g := Source.Data.g;
4372     Dest.Data.b := Source.Data.b;
4373
4374     with PglBitmapPixelData(Args)^ do
4375       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4376           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4377           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4378         Dest.Data.a := 0
4379       else
4380         Dest.Data.a := Dest.Range.a;
4381   end;
4382 end;
4383
4384 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4385 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4386 begin
4387   with FuncRec do begin
4388     Dest.Data.r := Source.Data.r;
4389     Dest.Data.g := Source.Data.g;
4390     Dest.Data.b := Source.Data.b;
4391     Dest.Data.a := PCardinal(Args)^;
4392   end;
4393 end;
4394
4395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4396 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4397 type
4398   PRGBPix = ^TRGBPix;
4399   TRGBPix = array [0..2] of byte;
4400 var
4401   Temp: Byte;
4402 begin
4403   while aWidth > 0 do begin
4404     Temp := PRGBPix(aData)^[0];
4405     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4406     PRGBPix(aData)^[2] := Temp;
4407
4408     if aHasAlpha then
4409       Inc(aData, 4)
4410     else
4411       Inc(aData, 3);
4412     dec(aWidth);
4413   end;
4414 end;
4415
4416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4417 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4419 function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
4420 begin
4421   result := TFormatDescriptor.Get(Format);
4422 end;
4423
4424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4425 function TglBitmap.GetWidth: Integer;
4426 begin
4427   if (ffX in fDimension.Fields) then
4428     result := fDimension.X
4429   else
4430     result := -1;
4431 end;
4432
4433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4434 function TglBitmap.GetHeight: Integer;
4435 begin
4436   if (ffY in fDimension.Fields) then
4437     result := fDimension.Y
4438   else
4439     result := -1;
4440 end;
4441
4442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4443 function TglBitmap.GetFileWidth: Integer;
4444 begin
4445   result := Max(1, Width);
4446 end;
4447
4448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4449 function TglBitmap.GetFileHeight: Integer;
4450 begin
4451   result := Max(1, Height);
4452 end;
4453
4454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4455 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4456 begin
4457   if fCustomData = aValue then
4458     exit;
4459   fCustomData := aValue;
4460 end;
4461
4462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4463 procedure TglBitmap.SetCustomName(const aValue: String);
4464 begin
4465   if fCustomName = aValue then
4466     exit;
4467   fCustomName := aValue;
4468 end;
4469
4470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4471 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4472 begin
4473   if fCustomNameW = aValue then
4474     exit;
4475   fCustomNameW := aValue;
4476 end;
4477
4478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4479 procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
4480 begin
4481   if fFreeDataOnDestroy = aValue then
4482     exit;
4483   fFreeDataOnDestroy := aValue;
4484 end;
4485
4486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4487 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4488 begin
4489   if fDeleteTextureOnFree = aValue then
4490     exit;
4491   fDeleteTextureOnFree := aValue;
4492 end;
4493
4494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4495 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4496 begin
4497   if fFormat = aValue then
4498     exit;
4499   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
4500     raise EglBitmapUnsupportedFormat.Create(Format);
4501   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
4502 end;
4503
4504 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4505 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4506 begin
4507   if fFreeDataAfterGenTexture = aValue then
4508     exit;
4509   fFreeDataAfterGenTexture := aValue;
4510 end;
4511
4512 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4513 procedure TglBitmap.SetID(const aValue: Cardinal);
4514 begin
4515   if fID = aValue then
4516     exit;
4517   fID := aValue;
4518 end;
4519
4520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4521 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4522 begin
4523   if fMipMap = aValue then
4524     exit;
4525   fMipMap := aValue;
4526 end;
4527
4528 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4529 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4530 begin
4531   if fTarget = aValue then
4532     exit;
4533   fTarget := aValue;
4534 end;
4535
4536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4537 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4538 var
4539   MaxAnisotropic: Integer;
4540 begin
4541   fAnisotropic := aValue;
4542   if (ID > 0) then begin
4543     if GL_EXT_texture_filter_anisotropic then begin
4544       if fAnisotropic > 0 then begin
4545         Bind(false);
4546         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4547         if aValue > MaxAnisotropic then
4548           fAnisotropic := MaxAnisotropic;
4549         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4550       end;
4551     end else begin
4552       fAnisotropic := 0;
4553     end;
4554   end;
4555 end;
4556
4557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4558 procedure TglBitmap.CreateID;
4559 begin
4560   if (ID <> 0) then
4561     glDeleteTextures(1, @fID);
4562   glGenTextures(1, @fID);
4563   Bind(false);
4564 end;
4565
4566 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4567 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4568 begin
4569   // Set Up Parameters
4570   SetWrap(fWrapS, fWrapT, fWrapR);
4571   SetFilter(fFilterMin, fFilterMag);
4572   SetAnisotropic(fAnisotropic);
4573   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4574
4575   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
4576     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4577
4578   // Mip Maps Generation Mode
4579   aBuildWithGlu := false;
4580   if (MipMap = mmMipmap) then begin
4581     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4582       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4583     else
4584       aBuildWithGlu := true;
4585   end else if (MipMap = mmMipmapGlu) then
4586     aBuildWithGlu := true;
4587 end;
4588
4589 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4590 procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
4591   const aWidth: Integer; const aHeight: Integer);
4592 var
4593   s: Single;
4594 begin
4595   if (Data <> aData) then begin
4596     if (Assigned(Data)) then
4597       FreeMem(Data);
4598     fData := aData;
4599   end;
4600
4601   if not Assigned(fData) then begin
4602     fPixelSize := 0;
4603     fRowSize   := 0;
4604   end else begin
4605     FillChar(fDimension, SizeOf(fDimension), 0);
4606     if aWidth <> -1 then begin
4607       fDimension.Fields := fDimension.Fields + [ffX];
4608       fDimension.X := aWidth;
4609     end;
4610
4611     if aHeight <> -1 then begin
4612       fDimension.Fields := fDimension.Fields + [ffY];
4613       fDimension.Y := aHeight;
4614     end;
4615
4616     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
4617     fFormat    := aFormat;
4618     fPixelSize := Ceil(s);
4619     fRowSize   := Ceil(s * aWidth);
4620   end;
4621 end;
4622
4623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4624 function TglBitmap.FlipHorz: Boolean;
4625 begin
4626   result := false;
4627 end;
4628
4629 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4630 function TglBitmap.FlipVert: Boolean;
4631 begin
4632   result := false;
4633 end;
4634
4635 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4636 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4637 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4638 procedure TglBitmap.AfterConstruction;
4639 begin
4640   inherited AfterConstruction;
4641
4642   fID         := 0;
4643   fTarget     := 0;
4644   fIsResident := false;
4645
4646   fMipMap                  := glBitmapDefaultMipmap;
4647   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4648   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4649
4650   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4651   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4652   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
4653 end;
4654
4655 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4656 procedure TglBitmap.BeforeDestruction;
4657 var
4658   NewData: PByte;
4659 begin
4660   if fFreeDataOnDestroy then begin
4661     NewData := nil;
4662     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
4663   end;
4664   if (fID > 0) and fDeleteTextureOnFree then
4665     glDeleteTextures(1, @fID);
4666   inherited BeforeDestruction;
4667 end;
4668
4669 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4670 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4671 var
4672   TempPos: Integer;
4673 begin
4674   if not Assigned(aResType) then begin
4675     TempPos   := Pos('.', aResource);
4676     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4677     aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4678   end;
4679 end;
4680
4681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4682 procedure TglBitmap.LoadFromFile(const aFilename: String);
4683 var
4684   fs: TFileStream;
4685 begin
4686   if not FileExists(aFilename) then
4687     raise EglBitmap.Create('file does not exist: ' + aFilename);
4688   fFilename := aFilename;
4689   fs := TFileStream.Create(fFilename, fmOpenRead);
4690   try
4691     fs.Position := 0;
4692     LoadFromStream(fs);
4693   finally
4694     fs.Free;
4695   end;
4696 end;
4697
4698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4699 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4700 begin
4701   {$IFDEF GLB_SUPPORT_PNG_READ}
4702   if not LoadPNG(aStream) then
4703   {$ENDIF}
4704   {$IFDEF GLB_SUPPORT_JPEG_READ}
4705   if not LoadJPEG(aStream) then
4706   {$ENDIF}
4707   if not LoadDDS(aStream) then
4708   if not LoadTGA(aStream) then
4709   if not LoadBMP(aStream) then
4710   if not LoadRAW(aStream) then
4711     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4712 end;
4713
4714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4715 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4716   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4717 var
4718   tmpData: PByte;
4719   size: Integer;
4720 begin
4721   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4722   GetMem(tmpData, size);
4723   try