1be10f8e1e0f008dcdf3abfdbb34c375f9dbc2e9
[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   TglBitmapFormat = (
777     tfEmpty = 0, //must be smallest value!
778
779     tfAlpha4,
780     tfAlpha8,
781     tfAlpha12,
782     tfAlpha16,
783
784     tfLuminance4,
785     tfLuminance8,
786     tfLuminance12,
787     tfLuminance16,
788
789     tfLuminance4Alpha4,
790     tfLuminance6Alpha2,
791     tfLuminance8Alpha8,
792     tfLuminance12Alpha4,
793     tfLuminance12Alpha12,
794     tfLuminance16Alpha16,
795
796     tfR3G3B2,
797     tfRGB4,
798     tfR5G6B5,
799     tfRGB5,
800     tfRGB8,
801     tfRGB10,
802     tfRGB12,
803     tfRGB16,
804
805     tfRGBA2,
806     tfRGBA4,
807     tfRGB5A1,
808     tfRGBA8,
809     tfRGB10A2,
810     tfRGBA12,
811     tfRGBA16,
812
813     tfBGR4,
814     tfB5G6R5,
815     tfBGR5,
816     tfBGR8,
817     tfBGR10,
818     tfBGR12,
819     tfBGR16,
820
821     tfBGRA2,
822     tfBGRA4,
823     tfBGR5A1,
824     tfBGRA8,
825     tfBGR10A2,
826     tfBGRA12,
827     tfBGRA16,
828
829     tfDepth16,
830     tfDepth24,
831     tfDepth32,
832
833     tfS3tcDtx1RGBA,
834     tfS3tcDtx3RGBA,
835     tfS3tcDtx5RGBA
836   );
837
838   TglBitmapFileType = (
839      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
840      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
841      ftDDS,
842      ftTGA,
843      ftBMP);
844    TglBitmapFileTypes = set of TglBitmapFileType;
845
846    TglBitmapMipMap = (
847      mmNone,
848      mmMipmap,
849      mmMipmapGlu);
850
851    TglBitmapNormalMapFunc = (
852      nm4Samples,
853      nmSobel,
854      nm3x3,
855      nm5x5);
856
857  ////////////////////////////////////////////////////////////////////////////////////////////////////
858    EglBitmap                  = class(Exception);
859    EglBitmapNotSupported      = class(Exception);
860    EglBitmapSizeToLarge       = class(EglBitmap);
861    EglBitmapNonPowerOfTwo     = class(EglBitmap);
862    EglBitmapUnsupportedFormat = class(EglBitmap)
863    public
864      constructor Create(const aFormat: TglBitmapFormat); overload;
865      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
866    end;
867
868 ////////////////////////////////////////////////////////////////////////////////////////////////////
869   TglBitmapColorRec = packed record
870   case Integer of
871     0: (r, g, b, a: Cardinal);
872     1: (arr: array[0..3] of Cardinal);
873   end;
874
875   TglBitmapPixelData = packed record
876     Data, Range: TglBitmapColorRec;
877     Format: TglBitmapFormat;
878   end;
879   PglBitmapPixelData = ^TglBitmapPixelData;
880
881 ////////////////////////////////////////////////////////////////////////////////////////////////////
882   TglBitmapPixelPositionFields = set of (ffX, ffY);
883   TglBitmapPixelPosition = record
884     Fields : TglBitmapPixelPositionFields;
885     X : Word;
886     Y : Word;
887   end;
888
889   TglBitmapFormatDescriptor = class(TObject)
890   protected
891     function GetIsCompressed: Boolean; virtual; abstract;
892     function GetHasRed:       Boolean; virtual; abstract;
893     function GetHasGreen:     Boolean; virtual; abstract;
894     function GetHasBlue:      Boolean; virtual; abstract;
895     function GetHasAlpha:     Boolean; virtual; abstract;
896
897     function GetglDataFormat:     GLenum;  virtual; abstract;
898     function GetglFormat:         GLenum;  virtual; abstract;
899     function GetglInternalFormat: GLenum;  virtual; abstract;
900   public
901     property IsCompressed: Boolean read GetIsCompressed;
902     property HasRed:       Boolean read GetHasRed;
903     property HasGreen:     Boolean read GetHasGreen;
904     property HasBlue:      Boolean read GetHasBlue;
905     property HasAlpha:     Boolean read GetHasAlpha;
906
907     property glFormat:         GLenum  read GetglFormat;
908     property glInternalFormat: GLenum  read GetglInternalFormat;
909     property glDataFormat:     GLenum  read GetglDataFormat;
910   public
911     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
912   end;
913
914 ////////////////////////////////////////////////////////////////////////////////////////////////////
915   TglBitmap = class;
916   TglBitmapFunctionRec = record
917     Sender:   TglBitmap;
918     Size:     TglBitmapPixelPosition;
919     Position: TglBitmapPixelPosition;
920     Source:   TglBitmapPixelData;
921     Dest:     TglBitmapPixelData;
922     Args:     Pointer;
923   end;
924   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
925
926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
927   TglBitmap = class
928   private
929     function GetFormatDesc: TglBitmapFormatDescriptor;
930   protected
931     fID: GLuint;
932     fTarget: GLuint;
933     fAnisotropic: Integer;
934     fDeleteTextureOnFree: Boolean;
935     fFreeDataOnDestroy: Boolean;
936     fFreeDataAfterGenTexture: Boolean;
937     fData: PByte;
938     fIsResident: GLboolean;
939     fBorderColor: array[0..3] of Single;
940
941     fDimension: TglBitmapPixelPosition;
942     fMipMap: TglBitmapMipMap;
943     fFormat: TglBitmapFormat;
944
945     // Mapping
946     fPixelSize: Integer;
947     fRowSize: Integer;
948
949     // Filtering
950     fFilterMin: GLenum;
951     fFilterMag: GLenum;
952
953     // TexturWarp
954     fWrapS: GLenum;
955     fWrapT: GLenum;
956     fWrapR: GLenum;
957
958     //Swizzle
959     fSwizzle: array[0..3] of GLenum;
960
961     // CustomData
962     fFilename: String;
963     fCustomName: String;
964     fCustomNameW: WideString;
965     fCustomData: Pointer;
966
967     //Getter
968     function GetWidth:  Integer; virtual;
969     function GetHeight: Integer; virtual;
970
971     function GetFileWidth:  Integer; virtual;
972     function GetFileHeight: Integer; virtual;
973
974     //Setter
975     procedure SetCustomData(const aValue: Pointer);
976     procedure SetCustomName(const aValue: String);
977     procedure SetCustomNameW(const aValue: WideString);
978     procedure SetFreeDataOnDestroy(const aValue: Boolean);
979     procedure SetDeleteTextureOnFree(const aValue: Boolean);
980     procedure SetFormat(const aValue: TglBitmapFormat);
981     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
982     procedure SetID(const aValue: Cardinal);
983     procedure SetMipMap(const aValue: TglBitmapMipMap);
984     procedure SetTarget(const aValue: Cardinal);
985     procedure SetAnisotropic(const aValue: Integer);
986
987     procedure CreateID;
988     procedure SetupParameters(out aBuildWithGlu: Boolean);
989     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
990       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method
991     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
992
993     function FlipHorz: Boolean; virtual;
994     function FlipVert: Boolean; virtual;
995
996     property Width:  Integer read GetWidth;
997     property Height: Integer read GetHeight;
998
999     property FileWidth:  Integer read GetFileWidth;
1000     property FileHeight: Integer read GetFileHeight;
1001   public
1002     //Properties
1003     property ID:           Cardinal        read fID          write SetID;
1004     property Target:       Cardinal        read fTarget      write SetTarget;
1005     property Format:       TglBitmapFormat read fFormat      write SetFormat;
1006     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
1007     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
1008
1009     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;
1010
1011     property Filename:    String     read fFilename;
1012     property CustomName:  String     read fCustomName  write SetCustomName;
1013     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
1014     property CustomData:  Pointer    read fCustomData  write SetCustomData;
1015
1016     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
1017     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;
1018     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
1019
1020     property Dimension:  TglBitmapPixelPosition  read fDimension;
1021     property Data:       PByte                   read fData;
1022     property IsResident: GLboolean               read fIsResident;
1023
1024     procedure AfterConstruction; override;
1025     procedure BeforeDestruction; override;
1026
1027     procedure PrepareResType(var aResource: String; var aResType: PChar);
1028
1029     //Load
1030     procedure LoadFromFile(const aFilename: String);
1031     procedure LoadFromStream(const aStream: TStream); virtual;
1032     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
1033       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
1034     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
1035     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
1036
1037     //Save
1038     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
1039     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
1040
1041     //Convert
1042     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
1043     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
1044       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
1045   public
1046     //Alpha & Co
1047     {$IFDEF GLB_SDL}
1048     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
1049     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
1050     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
1051     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
1052       const aArgs: Pointer = nil): Boolean;
1053     {$ENDIF}
1054
1055     {$IFDEF GLB_DELPHI}
1056     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
1057     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
1058     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
1059     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
1060       const aArgs: Pointer = nil): Boolean;
1061     {$ENDIF}
1062
1063     {$IFDEF GLB_LAZARUS}
1064     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1065     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
1066     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
1067     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
1068       const aArgs: Pointer = nil): Boolean;
1069     {$ENDIF}
1070
1071     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
1072       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1073     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
1074       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1075
1076     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
1077     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1078     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1079     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
1080
1081     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
1082     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
1083     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
1084
1085     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
1086     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
1087     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
1088
1089     function RemoveAlpha: Boolean; virtual;
1090   public
1091     //Common
1092     function Clone: TglBitmap;
1093     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
1094     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
1095     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
1096     procedure FreeData;
1097
1098     //ColorFill
1099     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
1100     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
1101     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
1102
1103     //TexParameters
1104     procedure SetFilter(const aMin, aMag: GLenum);
1105     procedure SetWrap(
1106       const S: GLenum = GL_CLAMP_TO_EDGE;
1107       const T: GLenum = GL_CLAMP_TO_EDGE;
1108       const R: GLenum = GL_CLAMP_TO_EDGE);
1109     procedure SetSwizzle(const r, g, b, a: GLenum);
1110
1111     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
1112     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
1113
1114     //Constructors
1115     constructor Create; overload;
1116     constructor Create(const aFileName: String); overload;
1117     constructor Create(const aStream: TStream); overload;
1118     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
1119     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
1120     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
1121     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1122   private
1123     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1124     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1125
1126     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1127     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1128
1129     function LoadBMP(const aStream: TStream): Boolean; virtual;
1130     procedure SaveBMP(const aStream: TStream); virtual;
1131
1132     function LoadTGA(const aStream: TStream): Boolean; virtual;
1133     procedure SaveTGA(const aStream: TStream); virtual;
1134
1135     function LoadDDS(const aStream: TStream): Boolean; virtual;
1136     procedure SaveDDS(const aStream: TStream); virtual;
1137   end;
1138
1139 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1140   TglBitmap1D = class(TglBitmap)
1141   protected
1142     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1143       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1144     procedure UploadData(const aBuildWithGlu: Boolean);
1145   public
1146     property Width;
1147     procedure AfterConstruction; override;
1148     function FlipHorz: Boolean; override;
1149     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1150   end;
1151
1152 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1153   TglBitmap2D = class(TglBitmap)
1154   protected
1155     fLines: array of PByte;
1156     function GetScanline(const aIndex: Integer): Pointer;
1157     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
1158       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1159     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
1160   public
1161     property Width;
1162     property Height;
1163     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1164
1165     procedure AfterConstruction; override;
1166
1167     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1168     procedure GetDataFromTexture;
1169     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1170
1171     function FlipHorz: Boolean; override;
1172     function FlipVert: Boolean; override;
1173
1174     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1175       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1176   end;
1177
1178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1179   TglBitmapCubeMap = class(TglBitmap2D)
1180   protected
1181     fGenMode: Integer;
1182     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
1183   public
1184     procedure AfterConstruction; override;
1185     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
1186     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
1187     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
1188   end;
1189
1190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1191   TglBitmapNormalMap = class(TglBitmapCubeMap)
1192   public
1193     procedure AfterConstruction; override;
1194     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
1195   end;
1196
1197 const
1198   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1199
1200 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1201 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1202 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1203 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1204 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1205 procedure glBitmapSetDefaultWrap(
1206   const S: Cardinal = GL_CLAMP_TO_EDGE;
1207   const T: Cardinal = GL_CLAMP_TO_EDGE;
1208   const R: Cardinal = GL_CLAMP_TO_EDGE);
1209
1210 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1211 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1212 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1213 function glBitmapGetDefaultFormat: TglBitmapFormat;
1214 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1215 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1216
1217 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1218 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1219 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1220
1221 var
1222   glBitmapDefaultDeleteTextureOnFree: Boolean;
1223   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1224   glBitmapDefaultFormat: TglBitmapFormat;
1225   glBitmapDefaultMipmap: TglBitmapMipMap;
1226   glBitmapDefaultFilterMin: Cardinal;
1227   glBitmapDefaultFilterMag: Cardinal;
1228   glBitmapDefaultWrapS: Cardinal;
1229   glBitmapDefaultWrapT: Cardinal;
1230   glBitmapDefaultWrapR: Cardinal;
1231   glDefaultSwizzle: array[0..3] of GLenum;
1232
1233 {$IFDEF GLB_DELPHI}
1234 function CreateGrayPalette: HPALETTE;
1235 {$ENDIF}
1236
1237 implementation
1238
1239 uses
1240   Math, syncobjs, typinfo
1241   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
1242
1243 type
1244 {$IFNDEF fpc}
1245   QWord   = System.UInt64;
1246   PQWord  = ^QWord;
1247
1248   PtrInt  = Longint;
1249   PtrUInt = DWord;
1250 {$ENDIF}
1251
1252 ////////////////////////////////////////////////////////////////////////////////////////////////////
1253   TShiftRec = packed record
1254   case Integer of
1255     0: (r, g, b, a: Byte);
1256     1: (arr: array[0..3] of Byte);
1257   end;
1258
1259   TFormatDescriptor = class(TglBitmapFormatDescriptor)
1260   private
1261     function GetRedMask: QWord;
1262     function GetGreenMask: QWord;
1263     function GetBlueMask: QWord;
1264     function GetAlphaMask: QWord;
1265   protected
1266     fFormat: TglBitmapFormat;
1267     fWithAlpha: TglBitmapFormat;
1268     fWithoutAlpha: TglBitmapFormat;
1269     fRGBInverted: TglBitmapFormat;
1270     fUncompressed: TglBitmapFormat;
1271     fPixelSize: Single;
1272     fIsCompressed: Boolean;
1273
1274     fRange: TglBitmapColorRec;
1275     fShift: TShiftRec;
1276
1277     fglFormat:         GLenum;
1278     fglInternalFormat: GLenum;
1279     fglDataFormat:     GLenum;
1280
1281     function GetIsCompressed: Boolean; override;
1282     function GetHasRed: Boolean; override;
1283     function GetHasGreen: Boolean; override;
1284     function GetHasBlue: Boolean; override;
1285     function GetHasAlpha: Boolean; override;
1286
1287     function GetglFormat: GLenum; override;
1288     function GetglInternalFormat: GLenum; override;
1289     function GetglDataFormat: GLenum; override;
1290
1291     function GetComponents: Integer; virtual;
1292   public
1293     property Format:       TglBitmapFormat read fFormat;
1294     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1295     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1296     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1297     property Components:   Integer         read GetComponents;
1298     property PixelSize:    Single          read fPixelSize;
1299
1300     property Range: TglBitmapColorRec read fRange;
1301     property Shift: TShiftRec         read fShift;
1302
1303     property RedMask:   QWord read GetRedMask;
1304     property GreenMask: QWord read GetGreenMask;
1305     property BlueMask:  QWord read GetBlueMask;
1306     property AlphaMask: QWord read GetAlphaMask;
1307
1308     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1309     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1310
1311     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
1312     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
1313
1314     function CreateMappingData: Pointer; virtual;
1315     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1316
1317     function IsEmpty:  Boolean; virtual;
1318     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1319
1320     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1321
1322     constructor Create; virtual;
1323   public
1324     class procedure Init;
1325     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1326     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1327     class procedure Clear;
1328     class procedure Finalize;
1329   end;
1330   TFormatDescriptorClass = class of TFormatDescriptor;
1331
1332   TfdEmpty = class(TFormatDescriptor);
1333
1334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1335   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1336     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1337     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1338     constructor Create; override;
1339   end;
1340
1341   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1342     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1343     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1344     constructor Create; override;
1345   end;
1346
1347   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1348     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1349     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1350     constructor Create; override;
1351   end;
1352
1353   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1354     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1355     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1356     constructor Create; override;
1357   end;
1358
1359   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1360     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1361     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1362     constructor Create; override;
1363   end;
1364
1365   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1366     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1367     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1368     constructor Create; override;
1369   end;
1370
1371   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1372     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1373     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1374     constructor Create; override;
1375   end;
1376
1377   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
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     constructor Create; override;
1381   end;
1382
1383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1384   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1385     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1386     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1387     constructor Create; override;
1388   end;
1389
1390   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1391     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1392     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1393     constructor Create; override;
1394   end;
1395
1396   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1397     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1398     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1399     constructor Create; override;
1400   end;
1401
1402   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
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     constructor Create; override;
1406   end;
1407
1408   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* 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     constructor Create; override;
1412   end;
1413
1414   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1415     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1416     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1417     constructor Create; override;
1418   end;
1419
1420   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1421     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1422     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1423     constructor Create; override;
1424   end;
1425
1426   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1427     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1428     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1429     constructor Create; override;
1430   end;
1431
1432   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1433     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1434     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1435     constructor Create; override;
1436   end;
1437
1438 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1439   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1440     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1441     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1442     constructor Create; override;
1443   end;
1444
1445   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1446     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1447     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1448     constructor Create; override;
1449   end;
1450
1451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1452   TfdAlpha4 = class(TfdAlpha_UB1)
1453     constructor Create; override;
1454   end;
1455
1456   TfdAlpha8 = class(TfdAlpha_UB1)
1457     constructor Create; override;
1458   end;
1459
1460   TfdAlpha12 = class(TfdAlpha_US1)
1461     constructor Create; override;
1462   end;
1463
1464   TfdAlpha16 = class(TfdAlpha_US1)
1465     constructor Create; override;
1466   end;
1467
1468   TfdLuminance4 = class(TfdLuminance_UB1)
1469     constructor Create; override;
1470   end;
1471
1472   TfdLuminance8 = class(TfdLuminance_UB1)
1473     constructor Create; override;
1474   end;
1475
1476   TfdLuminance12 = class(TfdLuminance_US1)
1477     constructor Create; override;
1478   end;
1479
1480   TfdLuminance16 = class(TfdLuminance_US1)
1481     constructor Create; override;
1482   end;
1483
1484   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1485     constructor Create; override;
1486   end;
1487
1488   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1489     constructor Create; override;
1490   end;
1491
1492   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1493     constructor Create; override;
1494   end;
1495
1496   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1497     constructor Create; override;
1498   end;
1499
1500   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1501     constructor Create; override;
1502   end;
1503
1504   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1505     constructor Create; override;
1506   end;
1507
1508   TfdR3G3B2 = class(TfdUniversal_UB1)
1509     constructor Create; override;
1510   end;
1511
1512   TfdRGB4 = class(TfdUniversal_US1)
1513     constructor Create; override;
1514   end;
1515
1516   TfdR5G6B5 = class(TfdUniversal_US1)
1517     constructor Create; override;
1518   end;
1519
1520   TfdRGB5 = class(TfdUniversal_US1)
1521     constructor Create; override;
1522   end;
1523
1524   TfdRGB8 = class(TfdRGB_UB3)
1525     constructor Create; override;
1526   end;
1527
1528   TfdRGB10 = class(TfdUniversal_UI1)
1529     constructor Create; override;
1530   end;
1531
1532   TfdRGB12 = class(TfdRGB_US3)
1533     constructor Create; override;
1534   end;
1535
1536   TfdRGB16 = class(TfdRGB_US3)
1537     constructor Create; override;
1538   end;
1539
1540   TfdRGBA2 = class(TfdRGBA_UB4)
1541     constructor Create; override;
1542   end;
1543
1544   TfdRGBA4 = class(TfdUniversal_US1)
1545     constructor Create; override;
1546   end;
1547
1548   TfdRGB5A1 = class(TfdUniversal_US1)
1549     constructor Create; override;
1550   end;
1551
1552   TfdRGBA8 = class(TfdRGBA_UB4)
1553     constructor Create; override;
1554   end;
1555
1556   TfdRGB10A2 = class(TfdUniversal_UI1)
1557     constructor Create; override;
1558   end;
1559
1560   TfdRGBA12 = class(TfdRGBA_US4)
1561     constructor Create; override;
1562   end;
1563
1564   TfdRGBA16 = class(TfdRGBA_US4)
1565     constructor Create; override;
1566   end;
1567
1568   TfdBGR4 = class(TfdUniversal_US1)
1569     constructor Create; override;
1570   end;
1571
1572   TfdB5G6R5 = class(TfdUniversal_US1)
1573     constructor Create; override;
1574   end;
1575
1576   TfdBGR5 = class(TfdUniversal_US1)
1577     constructor Create; override;
1578   end;
1579
1580   TfdBGR8 = class(TfdBGR_UB3)
1581     constructor Create; override;
1582   end;
1583
1584   TfdBGR10 = class(TfdUniversal_UI1)
1585     constructor Create; override;
1586   end;
1587
1588   TfdBGR12 = class(TfdBGR_US3)
1589     constructor Create; override;
1590   end;
1591
1592   TfdBGR16 = class(TfdBGR_US3)
1593     constructor Create; override;
1594   end;
1595
1596   TfdBGRA2 = class(TfdBGRA_UB4)
1597     constructor Create; override;
1598   end;
1599
1600   TfdBGRA4 = class(TfdUniversal_US1)
1601     constructor Create; override;
1602   end;
1603
1604   TfdBGR5A1 = class(TfdUniversal_US1)
1605     constructor Create; override;
1606   end;
1607
1608   TfdBGRA8 = class(TfdBGRA_UB4)
1609     constructor Create; override;
1610   end;
1611
1612   TfdBGR10A2 = class(TfdUniversal_UI1)
1613     constructor Create; override;
1614   end;
1615
1616   TfdBGRA12 = class(TfdBGRA_US4)
1617     constructor Create; override;
1618   end;
1619
1620   TfdBGRA16 = class(TfdBGRA_US4)
1621     constructor Create; override;
1622   end;
1623
1624   TfdDepth16 = class(TfdDepth_US1)
1625     constructor Create; override;
1626   end;
1627
1628   TfdDepth24 = class(TfdDepth_UI1)
1629     constructor Create; override;
1630   end;
1631
1632   TfdDepth32 = class(TfdDepth_UI1)
1633     constructor Create; override;
1634   end;
1635
1636   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1637     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1638     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1639     constructor Create; override;
1640   end;
1641
1642   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1643     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1644     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1645     constructor Create; override;
1646   end;
1647
1648   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1649     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1650     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1651     constructor Create; override;
1652   end;
1653
1654 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655   TbmpBitfieldFormat = class(TFormatDescriptor)
1656   private
1657     procedure SetRedMask  (const aValue: QWord);
1658     procedure SetGreenMask(const aValue: QWord);
1659     procedure SetBlueMask (const aValue: QWord);
1660     procedure SetAlphaMask(const aValue: QWord);
1661
1662     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1663   public
1664     property RedMask:   QWord read GetRedMask   write SetRedMask;
1665     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1666     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1667     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1668
1669     property PixelSize: Single read fPixelSize write fPixelSize;
1670
1671     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1672     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1673   end;
1674
1675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1676   TbmpColorTableEnty = packed record
1677     b, g, r, a: Byte;
1678   end;
1679   TbmpColorTable = array of TbmpColorTableEnty;
1680   TbmpColorTableFormat = class(TFormatDescriptor)
1681   private
1682     fColorTable: TbmpColorTable;
1683   public
1684     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1685     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1686     property Range:      TglBitmapColorRec read fRange      write fRange;
1687     property Shift:      TShiftRec         read fShift      write fShift;
1688     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1689
1690     procedure CreateColorTable;
1691
1692     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1693     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1694     destructor Destroy; override;
1695   end;
1696
1697 const
1698   LUMINANCE_WEIGHT_R = 0.30;
1699   LUMINANCE_WEIGHT_G = 0.59;
1700   LUMINANCE_WEIGHT_B = 0.11;
1701
1702   ALPHA_WEIGHT_R = 0.30;
1703   ALPHA_WEIGHT_G = 0.59;
1704   ALPHA_WEIGHT_B = 0.11;
1705
1706   DEPTH_WEIGHT_R = 0.333333333;
1707   DEPTH_WEIGHT_G = 0.333333333;
1708   DEPTH_WEIGHT_B = 0.333333333;
1709
1710   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1711
1712   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1713     TfdEmpty,
1714
1715     TfdAlpha4,
1716     TfdAlpha8,
1717     TfdAlpha12,
1718     TfdAlpha16,
1719
1720     TfdLuminance4,
1721     TfdLuminance8,
1722     TfdLuminance12,
1723     TfdLuminance16,
1724
1725     TfdLuminance4Alpha4,
1726     TfdLuminance6Alpha2,
1727     TfdLuminance8Alpha8,
1728     TfdLuminance12Alpha4,
1729     TfdLuminance12Alpha12,
1730     TfdLuminance16Alpha16,
1731
1732     TfdR3G3B2,
1733     TfdRGB4,
1734     TfdR5G6B5,
1735     TfdRGB5,
1736     TfdRGB8,
1737     TfdRGB10,
1738     TfdRGB12,
1739     TfdRGB16,
1740
1741     TfdRGBA2,
1742     TfdRGBA4,
1743     TfdRGB5A1,
1744     TfdRGBA8,
1745     TfdRGB10A2,
1746     TfdRGBA12,
1747     TfdRGBA16,
1748
1749     TfdBGR4,
1750     TfdB5G6R5,
1751     TfdBGR5,
1752     TfdBGR8,
1753     TfdBGR10,
1754     TfdBGR12,
1755     TfdBGR16,
1756
1757     TfdBGRA2,
1758     TfdBGRA4,
1759     TfdBGR5A1,
1760     TfdBGRA8,
1761     TfdBGR10A2,
1762     TfdBGRA12,
1763     TfdBGRA16,
1764
1765     TfdDepth16,
1766     TfdDepth24,
1767     TfdDepth32,
1768
1769     TfdS3tcDtx1RGBA,
1770     TfdS3tcDtx3RGBA,
1771     TfdS3tcDtx5RGBA
1772   );
1773
1774 var
1775   FormatDescriptorCS: TCriticalSection;
1776   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1777
1778 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1779 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1780 begin
1781   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1782 end;
1783
1784 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1785 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1786 begin
1787   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1788 end;
1789
1790 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1791 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1792 begin
1793   result.Fields := [];
1794
1795   if X >= 0 then
1796     result.Fields := result.Fields + [ffX];
1797   if Y >= 0 then
1798     result.Fields := result.Fields + [ffY];
1799
1800   result.X := Max(0, X);
1801   result.Y := Max(0, Y);
1802 end;
1803
1804 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1805 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1806 begin
1807   result.r := r;
1808   result.g := g;
1809   result.b := b;
1810   result.a := a;
1811 end;
1812
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1815 var
1816   i: Integer;
1817 begin
1818   result := false;
1819   for i := 0 to high(r1.arr) do
1820     if (r1.arr[i] <> r2.arr[i]) then
1821       exit;
1822   result := true;
1823 end;
1824
1825 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1826 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1827 begin
1828   result.r := r;
1829   result.g := g;
1830   result.b := b;
1831   result.a := a;
1832 end;
1833
1834 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1835 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1836 begin
1837   result := [];
1838
1839   if (aFormat in [
1840         //4 bbp
1841         tfLuminance4,
1842
1843         //8bpp
1844         tfR3G3B2, tfLuminance8,
1845
1846         //16bpp
1847         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1848         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1849
1850         //24bpp
1851         tfBGR8, tfRGB8,
1852
1853         //32bpp
1854         tfRGB10, tfRGB10A2, tfRGBA8,
1855         tfBGR10, tfBGR10A2, tfBGRA8]) then
1856     result := result + [ftBMP];
1857
1858   if (aFormat in [
1859         //8 bpp
1860         tfLuminance8, tfAlpha8,
1861
1862         //16 bpp
1863         tfLuminance16, tfLuminance8Alpha8,
1864         tfRGB5, tfRGB5A1, tfRGBA4,
1865         tfBGR5, tfBGR5A1, tfBGRA4,
1866
1867         //24 bpp
1868         tfRGB8, tfBGR8,
1869
1870         //32 bpp
1871         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1872     result := result + [ftTGA];
1873
1874   if (aFormat in [
1875         //8 bpp
1876         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1877         tfR3G3B2, tfRGBA2, tfBGRA2,
1878
1879         //16 bpp
1880         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1881         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1882         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1883
1884         //24 bpp
1885         tfRGB8, tfBGR8,
1886
1887         //32 bbp
1888         tfLuminance16Alpha16,
1889         tfRGBA8, tfRGB10A2,
1890         tfBGRA8, tfBGR10A2,
1891
1892         //compressed
1893         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1894     result := result + [ftDDS];
1895
1896   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1897   if aFormat in [
1898       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1899       tfRGB8, tfRGBA8,
1900       tfBGR8, tfBGRA8] then
1901     result := result + [ftPNG];
1902   {$ENDIF}
1903
1904   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1905   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1906     result := result + [ftJPEG];
1907   {$ENDIF}
1908 end;
1909
1910 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1911 function IsPowerOfTwo(aNumber: Integer): Boolean;
1912 begin
1913   while (aNumber and 1) = 0 do
1914     aNumber := aNumber shr 1;
1915   result := aNumber = 1;
1916 end;
1917
1918 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1919 function GetTopMostBit(aBitSet: QWord): Integer;
1920 begin
1921   result := 0;
1922   while aBitSet > 0 do begin
1923     inc(result);
1924     aBitSet := aBitSet shr 1;
1925   end;
1926 end;
1927
1928 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1929 function CountSetBits(aBitSet: QWord): Integer;
1930 begin
1931   result := 0;
1932   while aBitSet > 0 do begin
1933     if (aBitSet and 1) = 1 then
1934       inc(result);
1935     aBitSet := aBitSet shr 1;
1936   end;
1937 end;
1938
1939 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1940 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1941 begin
1942   result := Trunc(
1943     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1944     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1945     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1946 end;
1947
1948 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1949 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1950 begin
1951   result := Trunc(
1952     DEPTH_WEIGHT_R * aPixel.Data.r +
1953     DEPTH_WEIGHT_G * aPixel.Data.g +
1954     DEPTH_WEIGHT_B * aPixel.Data.b);
1955 end;
1956
1957 {$IFDEF GLB_NATIVE_OGL}
1958 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1959 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1960 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1961 var
1962   GL_LibHandle: Pointer = nil;
1963
1964 function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
1965 begin
1966   if not Assigned(aLibHandle) then
1967     aLibHandle := GL_LibHandle;
1968
1969 {$IF DEFINED(GLB_WIN)}
1970   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1971   if Assigned(result) then
1972     exit;
1973
1974   if Assigned(wglGetProcAddress) then
1975     result := wglGetProcAddress(aProcName);
1976 {$ELSEIF DEFINED(GLB_LINUX)}
1977   if Assigned(glXGetProcAddress) then begin
1978     result := glXGetProcAddress(aProcName);
1979     if Assigned(result) then
1980       exit;
1981   end;
1982
1983   if Assigned(glXGetProcAddressARB) then begin
1984     result := glXGetProcAddressARB(aProcName);
1985     if Assigned(result) then
1986       exit;
1987   end;
1988
1989   result := dlsym(aLibHandle, aProcName);
1990 {$IFEND}
1991   if not Assigned(result) and aRaiseOnErr then
1992     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
1993 end;
1994
1995 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1996 var
1997   GLU_LibHandle: Pointer = nil;
1998   OpenGLInitialized: Boolean;
1999   InitOpenGLCS: TCriticalSection;
2000
2001 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2002 procedure glbInitOpenGL;
2003
2004   ////////////////////////////////////////////////////////////////////////////////
2005   function glbLoadLibrary(const aName: PChar): Pointer;
2006   begin
2007     {$IF DEFINED(GLB_WIN)}
2008     result := {%H-}Pointer(LoadLibrary(aName));
2009     {$ELSEIF DEFINED(GLB_LINUX)}
2010     result := dlopen(Name, RTLD_LAZY);
2011     {$ELSE}
2012     result := nil;
2013     {$IFEND}
2014   end;
2015
2016   ////////////////////////////////////////////////////////////////////////////////
2017   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
2018   begin
2019     result := false;
2020     if not Assigned(aLibHandle) then
2021       exit;
2022
2023     {$IF DEFINED(GLB_WIN)}
2024     Result := FreeLibrary({%H-}HINST(aLibHandle));
2025     {$ELSEIF DEFINED(GLB_LINUX)}
2026     Result := dlclose(aLibHandle) = 0;
2027     {$IFEND}
2028   end;
2029
2030 begin
2031   if Assigned(GL_LibHandle) then
2032     glbFreeLibrary(GL_LibHandle);
2033
2034   if Assigned(GLU_LibHandle) then
2035     glbFreeLibrary(GLU_LibHandle);
2036
2037   GL_LibHandle := glbLoadLibrary(libopengl);
2038   if not Assigned(GL_LibHandle) then
2039     raise EglBitmap.Create('unable to load library: ' + libopengl);
2040
2041   GLU_LibHandle := glbLoadLibrary(libglu);
2042   if not Assigned(GLU_LibHandle) then
2043     raise EglBitmap.Create('unable to load library: ' + libglu);
2044
2045 {$IF DEFINED(GLB_WIN)}
2046   wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
2047 {$ELSEIF DEFINED(GLB_LINUX)}
2048   glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
2049   glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
2050 {$IFEND}
2051
2052   glEnable := glbGetProcAddress('glEnable');
2053   glDisable := glbGetProcAddress('glDisable');
2054   glGetString := glbGetProcAddress('glGetString');
2055   glGetIntegerv := glbGetProcAddress('glGetIntegerv');
2056   glTexParameteri := glbGetProcAddress('glTexParameteri');
2057   glTexParameteriv := glbGetProcAddress('glTexParameteriv');
2058   glTexParameterfv := glbGetProcAddress('glTexParameterfv');
2059   glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
2060   glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
2061   glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
2062   glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
2063   glTexGeni := glbGetProcAddress('glTexGeni');
2064   glGenTextures := glbGetProcAddress('glGenTextures');
2065   glBindTexture := glbGetProcAddress('glBindTexture');
2066   glDeleteTextures := glbGetProcAddress('glDeleteTextures');
2067   glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
2068   glReadPixels := glbGetProcAddress('glReadPixels');
2069   glPixelStorei := glbGetProcAddress('glPixelStorei');
2070   glTexImage1D := glbGetProcAddress('glTexImage1D');
2071   glTexImage2D := glbGetProcAddress('glTexImage2D');
2072   glGetTexImage := glbGetProcAddress('glGetTexImage');
2073
2074   gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
2075   gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
2076 end;
2077 {$ENDIF}
2078
2079 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2080 procedure glbReadOpenGLExtensions;
2081 var
2082   Buffer: AnsiString;
2083   MajorVersion, MinorVersion: Integer;
2084
2085   ///////////////////////////////////////////////////////////////////////////////////////////
2086   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
2087   var
2088     Separator: Integer;
2089   begin
2090     aMinor := 0;
2091     aMajor := 0;
2092
2093     Separator := Pos(AnsiString('.'), aBuffer);
2094     if (Separator > 1) and (Separator < Length(aBuffer)) and
2095        (aBuffer[Separator - 1] in ['0'..'9']) and
2096        (aBuffer[Separator + 1] in ['0'..'9']) then begin
2097
2098       Dec(Separator);
2099       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
2100         Dec(Separator);
2101
2102       Delete(aBuffer, 1, Separator);
2103       Separator := Pos(AnsiString('.'), aBuffer) + 1;
2104
2105       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2106         Inc(Separator);
2107
2108       Delete(aBuffer, Separator, 255);
2109       Separator := Pos(AnsiString('.'), aBuffer);
2110
2111       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2112       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2113     end;
2114   end;
2115
2116   ///////////////////////////////////////////////////////////////////////////////////////////
2117   function CheckExtension(const Extension: AnsiString): Boolean;
2118   var
2119     ExtPos: Integer;
2120   begin
2121     ExtPos := Pos(Extension, Buffer);
2122     result := ExtPos > 0;
2123     if result then
2124       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2125   end;
2126
2127   ///////////////////////////////////////////////////////////////////////////////////////////
2128   function CheckVersion(const aMajor, aMinor: Integer): Boolean;
2129   begin
2130     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
2131   end;
2132
2133 begin
2134 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2135   InitOpenGLCS.Enter;
2136   try
2137     if not OpenGLInitialized then begin
2138       glbInitOpenGL;
2139       OpenGLInitialized := true;
2140     end;
2141   finally
2142     InitOpenGLCS.Leave;
2143   end;
2144 {$ENDIF}
2145
2146   // Version
2147   Buffer := glGetString(GL_VERSION);
2148   TrimVersionString(Buffer, MajorVersion, MinorVersion);
2149
2150   GL_VERSION_1_2 := CheckVersion(1, 2);
2151   GL_VERSION_1_3 := CheckVersion(1, 3);
2152   GL_VERSION_1_4 := CheckVersion(1, 4);
2153   GL_VERSION_2_0 := CheckVersion(2, 0);
2154   GL_VERSION_3_3 := CheckVersion(3, 3);
2155
2156   // Extensions
2157   Buffer := glGetString(GL_EXTENSIONS);
2158   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2159   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2160   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');
2161   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');
2162   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2163   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2164   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2165   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2166   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2167   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');
2168   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');
2169   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2170   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2171   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2172
2173   if GL_VERSION_1_3 then begin
2174     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2175     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2176     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2177   end else begin
2178     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);
2179     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);
2180     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
2181   end;
2182 end;
2183 {$ENDIF}
2184
2185 {$IFDEF GLB_SDL_IMAGE}
2186 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2187 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2188 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2189 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2190 begin
2191   result := TStream(context^.unknown.data1).Seek(offset, whence);
2192 end;
2193
2194 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2195 begin
2196   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2197 end;
2198
2199 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2200 begin
2201   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2202 end;
2203
2204 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2205 begin
2206   result := 0;
2207 end;
2208
2209 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2210 begin
2211   result := SDL_AllocRW;
2212
2213   if result = nil then
2214     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2215
2216   result^.seek := glBitmapRWseek;
2217   result^.read := glBitmapRWread;
2218   result^.write := glBitmapRWwrite;
2219   result^.close := glBitmapRWclose;
2220   result^.unknown.data1 := Stream;
2221 end;
2222 {$ENDIF}
2223
2224 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2225 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2226 begin
2227   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2228 end;
2229
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2232 begin
2233   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2234 end;
2235
2236 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2237 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2238 begin
2239   glBitmapDefaultMipmap := aValue;
2240 end;
2241
2242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2243 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2244 begin
2245   glBitmapDefaultFormat := aFormat;
2246 end;
2247
2248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2249 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2250 begin
2251   glBitmapDefaultFilterMin := aMin;
2252   glBitmapDefaultFilterMag := aMag;
2253 end;
2254
2255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2256 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2257 begin
2258   glBitmapDefaultWrapS := S;
2259   glBitmapDefaultWrapT := T;
2260   glBitmapDefaultWrapR := R;
2261 end;
2262
2263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2264 procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
2265 begin
2266   glDefaultSwizzle[0] := r;
2267   glDefaultSwizzle[1] := g;
2268   glDefaultSwizzle[2] := b;
2269   glDefaultSwizzle[3] := a;
2270 end;
2271
2272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2273 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2274 begin
2275   result := glBitmapDefaultDeleteTextureOnFree;
2276 end;
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2280 begin
2281   result := glBitmapDefaultFreeDataAfterGenTextures;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2286 begin
2287   result := glBitmapDefaultMipmap;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 function glBitmapGetDefaultFormat: TglBitmapFormat;
2292 begin
2293   result := glBitmapDefaultFormat;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
2298 begin
2299   aMin := glBitmapDefaultFilterMin;
2300   aMag := glBitmapDefaultFilterMag;
2301 end;
2302
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
2305 begin
2306   S := glBitmapDefaultWrapS;
2307   T := glBitmapDefaultWrapT;
2308   R := glBitmapDefaultWrapR;
2309 end;
2310
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
2313 begin
2314   r := glDefaultSwizzle[0];
2315   g := glDefaultSwizzle[1];
2316   b := glDefaultSwizzle[2];
2317   a := glDefaultSwizzle[3];
2318 end;
2319
2320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2321 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2322 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2323 function TFormatDescriptor.GetRedMask: QWord;
2324 begin
2325   result := fRange.r shl fShift.r;
2326 end;
2327
2328 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2329 function TFormatDescriptor.GetGreenMask: QWord;
2330 begin
2331   result := fRange.g shl fShift.g;
2332 end;
2333
2334 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2335 function TFormatDescriptor.GetBlueMask: QWord;
2336 begin
2337   result := fRange.b shl fShift.b;
2338 end;
2339
2340 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2341 function TFormatDescriptor.GetAlphaMask: QWord;
2342 begin
2343   result := fRange.a shl fShift.a;
2344 end;
2345
2346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2347 function TFormatDescriptor.GetIsCompressed: Boolean;
2348 begin
2349   result := fIsCompressed;
2350 end;
2351
2352 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2353 function TFormatDescriptor.GetHasRed: Boolean;
2354 begin
2355   result := (fRange.r > 0);
2356 end;
2357
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetHasGreen: Boolean;
2360 begin
2361   result := (fRange.g > 0);
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetHasBlue: Boolean;
2366 begin
2367   result := (fRange.b > 0);
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetHasAlpha: Boolean;
2372 begin
2373   result := (fRange.a > 0);
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetglFormat: GLenum;
2378 begin
2379   result := fglFormat;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetglInternalFormat: GLenum;
2384 begin
2385   result := fglInternalFormat;
2386 end;
2387
2388 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2389 function TFormatDescriptor.GetglDataFormat: GLenum;
2390 begin
2391   result := fglDataFormat;
2392 end;
2393
2394 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2395 function TFormatDescriptor.GetComponents: Integer;
2396 var
2397   i: Integer;
2398 begin
2399   result := 0;
2400   for i := 0 to 3 do
2401     if (fRange.arr[i] > 0) then
2402       inc(result);
2403 end;
2404
2405 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2406 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2407 var
2408   w, h: Integer;
2409 begin
2410   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2411     w := Max(1, aSize.X);
2412     h := Max(1, aSize.Y);
2413     result := GetSize(w, h);
2414   end else
2415     result := 0;
2416 end;
2417
2418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2419 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2420 begin
2421   result := 0;
2422   if (aWidth <= 0) or (aHeight <= 0) then
2423     exit;
2424   result := Ceil(aWidth * aHeight * fPixelSize);
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 function TFormatDescriptor.CreateMappingData: Pointer;
2429 begin
2430   result := nil;
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2435 begin
2436   //DUMMY
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 function TFormatDescriptor.IsEmpty: Boolean;
2441 begin
2442   result := (fFormat = tfEmpty);
2443 end;
2444
2445 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2446 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2447 begin
2448   result := false;
2449   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2450     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
2451   if (aRedMask   <> RedMask) then
2452     exit;
2453   if (aGreenMask <> GreenMask) then
2454     exit;
2455   if (aBlueMask  <> BlueMask) then
2456     exit;
2457   if (aAlphaMask <> AlphaMask) then
2458     exit;
2459   result := true;
2460 end;
2461
2462 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2463 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2464 begin
2465   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2466   aPixel.Data   := fRange;
2467   aPixel.Range  := fRange;
2468   aPixel.Format := fFormat;
2469 end;
2470
2471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2472 constructor TFormatDescriptor.Create;
2473 begin
2474   inherited Create;
2475
2476   fFormat       := tfEmpty;
2477   fWithAlpha    := tfEmpty;
2478   fWithoutAlpha := tfEmpty;
2479   fRGBInverted  := tfEmpty;
2480   fUncompressed := tfEmpty;
2481   fPixelSize    := 0.0;
2482   fIsCompressed := false;
2483
2484   fglFormat         := 0;
2485   fglInternalFormat := 0;
2486   fglDataFormat     := 0;
2487
2488   FillChar(fRange, 0, SizeOf(fRange));
2489   FillChar(fShift, 0, SizeOf(fShift));
2490 end;
2491
2492 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2493 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2494 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2495 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2496 begin
2497   aData^ := aPixel.Data.a;
2498   inc(aData);
2499 end;
2500
2501 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2502 begin
2503   aPixel.Data.r := 0;
2504   aPixel.Data.g := 0;
2505   aPixel.Data.b := 0;
2506   aPixel.Data.a := aData^;
2507   inc(aData);
2508 end;
2509
2510 constructor TfdAlpha_UB1.Create;
2511 begin
2512   inherited Create;
2513   fPixelSize        := 1.0;
2514   fRange.a          := $FF;
2515   fglFormat         := GL_ALPHA;
2516   fglDataFormat     := GL_UNSIGNED_BYTE;
2517 end;
2518
2519 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2522 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 begin
2524   aData^ := LuminanceWeight(aPixel);
2525   inc(aData);
2526 end;
2527
2528 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2529 begin
2530   aPixel.Data.r := aData^;
2531   aPixel.Data.g := aData^;
2532   aPixel.Data.b := aData^;
2533   aPixel.Data.a := 0;
2534   inc(aData);
2535 end;
2536
2537 constructor TfdLuminance_UB1.Create;
2538 begin
2539   inherited Create;
2540   fPixelSize        := 1.0;
2541   fRange.r          := $FF;
2542   fRange.g          := $FF;
2543   fRange.b          := $FF;
2544   fglFormat         := GL_LUMINANCE;
2545   fglDataFormat     := GL_UNSIGNED_BYTE;
2546 end;
2547
2548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2549 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2551 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2552 var
2553   i: Integer;
2554 begin
2555   aData^ := 0;
2556   for i := 0 to 3 do
2557     if (fRange.arr[i] > 0) then
2558       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2559   inc(aData);
2560 end;
2561
2562 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2563 var
2564   i: Integer;
2565 begin
2566   for i := 0 to 3 do
2567     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2568   inc(aData);
2569 end;
2570
2571 constructor TfdUniversal_UB1.Create;
2572 begin
2573   inherited Create;
2574   fPixelSize := 1.0;
2575 end;
2576
2577 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2578 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2579 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2580 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2581 begin
2582   inherited Map(aPixel, aData, aMapData);
2583   aData^ := aPixel.Data.a;
2584   inc(aData);
2585 end;
2586
2587 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2588 begin
2589   inherited Unmap(aData, aPixel, aMapData);
2590   aPixel.Data.a := aData^;
2591   inc(aData);
2592 end;
2593
2594 constructor TfdLuminanceAlpha_UB2.Create;
2595 begin
2596   inherited Create;
2597   fPixelSize        := 2.0;
2598   fRange.a          := $FF;
2599   fShift.a          :=   8;
2600   fglFormat         := GL_LUMINANCE_ALPHA;
2601   fglDataFormat     := GL_UNSIGNED_BYTE;
2602 end;
2603
2604 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2605 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2606 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2607 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2608 begin
2609   aData^ := aPixel.Data.r;
2610   inc(aData);
2611   aData^ := aPixel.Data.g;
2612   inc(aData);
2613   aData^ := aPixel.Data.b;
2614   inc(aData);
2615 end;
2616
2617 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2618 begin
2619   aPixel.Data.r := aData^;
2620   inc(aData);
2621   aPixel.Data.g := aData^;
2622   inc(aData);
2623   aPixel.Data.b := aData^;
2624   inc(aData);
2625   aPixel.Data.a := 0;
2626 end;
2627
2628 constructor TfdRGB_UB3.Create;
2629 begin
2630   inherited Create;
2631   fPixelSize        := 3.0;
2632   fRange.r          := $FF;
2633   fRange.g          := $FF;
2634   fRange.b          := $FF;
2635   fShift.r          :=   0;
2636   fShift.g          :=   8;
2637   fShift.b          :=  16;
2638   fglFormat         := GL_RGB;
2639   fglDataFormat     := GL_UNSIGNED_BYTE;
2640 end;
2641
2642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2643 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2645 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2646 begin
2647   aData^ := aPixel.Data.b;
2648   inc(aData);
2649   aData^ := aPixel.Data.g;
2650   inc(aData);
2651   aData^ := aPixel.Data.r;
2652   inc(aData);
2653 end;
2654
2655 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2656 begin
2657   aPixel.Data.b := aData^;
2658   inc(aData);
2659   aPixel.Data.g := aData^;
2660   inc(aData);
2661   aPixel.Data.r := aData^;
2662   inc(aData);
2663   aPixel.Data.a := 0;
2664 end;
2665
2666 constructor TfdBGR_UB3.Create;
2667 begin
2668   fPixelSize        := 3.0;
2669   fRange.r          := $FF;
2670   fRange.g          := $FF;
2671   fRange.b          := $FF;
2672   fShift.r          :=  16;
2673   fShift.g          :=   8;
2674   fShift.b          :=   0;
2675   fglFormat         := GL_BGR;
2676   fglDataFormat     := GL_UNSIGNED_BYTE;
2677 end;
2678
2679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2680 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2681 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2682 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2683 begin
2684   inherited Map(aPixel, aData, aMapData);
2685   aData^ := aPixel.Data.a;
2686   inc(aData);
2687 end;
2688
2689 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2690 begin
2691   inherited Unmap(aData, aPixel, aMapData);
2692   aPixel.Data.a := aData^;
2693   inc(aData);
2694 end;
2695
2696 constructor TfdRGBA_UB4.Create;
2697 begin
2698   inherited Create;
2699   fPixelSize        := 4.0;
2700   fRange.a          := $FF;
2701   fShift.a          :=  24;
2702   fglFormat         := GL_RGBA;
2703   fglDataFormat     := GL_UNSIGNED_BYTE;
2704 end;
2705
2706 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2707 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2708 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2709 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2710 begin
2711   inherited Map(aPixel, aData, aMapData);
2712   aData^ := aPixel.Data.a;
2713   inc(aData);
2714 end;
2715
2716 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2717 begin
2718   inherited Unmap(aData, aPixel, aMapData);
2719   aPixel.Data.a := aData^;
2720   inc(aData);
2721 end;
2722
2723 constructor TfdBGRA_UB4.Create;
2724 begin
2725   inherited Create;
2726   fPixelSize        := 4.0;
2727   fRange.a          := $FF;
2728   fShift.a          :=  24;
2729   fglFormat         := GL_BGRA;
2730   fglDataFormat     := GL_UNSIGNED_BYTE;
2731 end;
2732
2733 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2734 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2735 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2736 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2737 begin
2738   PWord(aData)^ := aPixel.Data.a;
2739   inc(aData, 2);
2740 end;
2741
2742 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2743 begin
2744   aPixel.Data.r := 0;
2745   aPixel.Data.g := 0;
2746   aPixel.Data.b := 0;
2747   aPixel.Data.a := PWord(aData)^;
2748   inc(aData, 2);
2749 end;
2750
2751 constructor TfdAlpha_US1.Create;
2752 begin
2753   inherited Create;
2754   fPixelSize        := 2.0;
2755   fRange.a          := $FFFF;
2756   fglFormat         := GL_ALPHA;
2757   fglDataFormat     := GL_UNSIGNED_SHORT;
2758 end;
2759
2760 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2761 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2762 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2763 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2764 begin
2765   PWord(aData)^ := LuminanceWeight(aPixel);
2766   inc(aData, 2);
2767 end;
2768
2769 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2770 begin
2771   aPixel.Data.r := PWord(aData)^;
2772   aPixel.Data.g := PWord(aData)^;
2773   aPixel.Data.b := PWord(aData)^;
2774   aPixel.Data.a := 0;
2775   inc(aData, 2);
2776 end;
2777
2778 constructor TfdLuminance_US1.Create;
2779 begin
2780   inherited Create;
2781   fPixelSize        := 2.0;
2782   fRange.r          := $FFFF;
2783   fRange.g          := $FFFF;
2784   fRange.b          := $FFFF;
2785   fglFormat         := GL_LUMINANCE;
2786   fglDataFormat     := GL_UNSIGNED_SHORT;
2787 end;
2788
2789 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2792 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2793 var
2794   i: Integer;
2795 begin
2796   PWord(aData)^ := 0;
2797   for i := 0 to 3 do
2798     if (fRange.arr[i] > 0) then
2799       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2800   inc(aData, 2);
2801 end;
2802
2803 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2804 var
2805   i: Integer;
2806 begin
2807   for i := 0 to 3 do
2808     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2809   inc(aData, 2);
2810 end;
2811
2812 constructor TfdUniversal_US1.Create;
2813 begin
2814   inherited Create;
2815   fPixelSize := 2.0;
2816 end;
2817
2818 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2819 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2820 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2821 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2822 begin
2823   PWord(aData)^ := DepthWeight(aPixel);
2824   inc(aData, 2);
2825 end;
2826
2827 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2828 begin
2829   aPixel.Data.r := PWord(aData)^;
2830   aPixel.Data.g := PWord(aData)^;
2831   aPixel.Data.b := PWord(aData)^;
2832   aPixel.Data.a := 0;
2833   inc(aData, 2);
2834 end;
2835
2836 constructor TfdDepth_US1.Create;
2837 begin
2838   inherited Create;
2839   fPixelSize        := 2.0;
2840   fRange.r          := $FFFF;
2841   fRange.g          := $FFFF;
2842   fRange.b          := $FFFF;
2843   fglFormat         := GL_DEPTH_COMPONENT;
2844   fglDataFormat     := GL_UNSIGNED_SHORT;
2845 end;
2846
2847 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2848 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2850 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2851 begin
2852   inherited Map(aPixel, aData, aMapData);
2853   PWord(aData)^ := aPixel.Data.a;
2854   inc(aData, 2);
2855 end;
2856
2857 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2858 begin
2859   inherited Unmap(aData, aPixel, aMapData);
2860   aPixel.Data.a := PWord(aData)^;
2861   inc(aData, 2);
2862 end;
2863
2864 constructor TfdLuminanceAlpha_US2.Create;
2865 begin
2866   inherited Create;
2867   fPixelSize        :=   4.0;
2868   fRange.a          := $FFFF;
2869   fShift.a          :=    16;
2870   fglFormat         := GL_LUMINANCE_ALPHA;
2871   fglDataFormat     := GL_UNSIGNED_SHORT;
2872 end;
2873
2874 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2875 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2877 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2878 begin
2879   PWord(aData)^ := aPixel.Data.r;
2880   inc(aData, 2);
2881   PWord(aData)^ := aPixel.Data.g;
2882   inc(aData, 2);
2883   PWord(aData)^ := aPixel.Data.b;
2884   inc(aData, 2);
2885 end;
2886
2887 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2888 begin
2889   aPixel.Data.r := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.g := PWord(aData)^;
2892   inc(aData, 2);
2893   aPixel.Data.b := PWord(aData)^;
2894   inc(aData, 2);
2895   aPixel.Data.a := 0;
2896 end;
2897
2898 constructor TfdRGB_US3.Create;
2899 begin
2900   inherited Create;
2901   fPixelSize        :=   6.0;
2902   fRange.r          := $FFFF;
2903   fRange.g          := $FFFF;
2904   fRange.b          := $FFFF;
2905   fShift.r          :=     0;
2906   fShift.g          :=    16;
2907   fShift.b          :=    32;
2908   fglFormat         := GL_RGB;
2909   fglDataFormat     := GL_UNSIGNED_SHORT;
2910 end;
2911
2912 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2913 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2914 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2915 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2916 begin
2917   PWord(aData)^ := aPixel.Data.b;
2918   inc(aData, 2);
2919   PWord(aData)^ := aPixel.Data.g;
2920   inc(aData, 2);
2921   PWord(aData)^ := aPixel.Data.r;
2922   inc(aData, 2);
2923 end;
2924
2925 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2926 begin
2927   aPixel.Data.b := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.g := PWord(aData)^;
2930   inc(aData, 2);
2931   aPixel.Data.r := PWord(aData)^;
2932   inc(aData, 2);
2933   aPixel.Data.a := 0;
2934 end;
2935
2936 constructor TfdBGR_US3.Create;
2937 begin
2938   inherited Create;
2939   fPixelSize        :=   6.0;
2940   fRange.r          := $FFFF;
2941   fRange.g          := $FFFF;
2942   fRange.b          := $FFFF;
2943   fShift.r          :=    32;
2944   fShift.g          :=    16;
2945   fShift.b          :=     0;
2946   fglFormat         := GL_BGR;
2947   fglDataFormat     := GL_UNSIGNED_SHORT;
2948 end;
2949
2950 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2951 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2953 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2954 begin
2955   inherited Map(aPixel, aData, aMapData);
2956   PWord(aData)^ := aPixel.Data.a;
2957   inc(aData, 2);
2958 end;
2959
2960 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2961 begin
2962   inherited Unmap(aData, aPixel, aMapData);
2963   aPixel.Data.a := PWord(aData)^;
2964   inc(aData, 2);
2965 end;
2966
2967 constructor TfdRGBA_US4.Create;
2968 begin
2969   inherited Create;
2970   fPixelSize        :=   8.0;
2971   fRange.a          := $FFFF;
2972   fShift.a          :=    48;
2973   fglFormat         := GL_RGBA;
2974   fglDataFormat     := GL_UNSIGNED_SHORT;
2975 end;
2976
2977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2978 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2979 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2980 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2981 begin
2982   inherited Map(aPixel, aData, aMapData);
2983   PWord(aData)^ := aPixel.Data.a;
2984   inc(aData, 2);
2985 end;
2986
2987 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2988 begin
2989   inherited Unmap(aData, aPixel, aMapData);
2990   aPixel.Data.a := PWord(aData)^;
2991   inc(aData, 2);
2992 end;
2993
2994 constructor TfdBGRA_US4.Create;
2995 begin
2996   inherited Create;
2997   fPixelSize        :=   8.0;
2998   fRange.a          := $FFFF;
2999   fShift.a          :=    48;
3000   fglFormat         := GL_BGRA;
3001   fglDataFormat     := GL_UNSIGNED_SHORT;
3002 end;
3003
3004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3005 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3006 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3007 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3008 var
3009   i: Integer;
3010 begin
3011   PCardinal(aData)^ := 0;
3012   for i := 0 to 3 do
3013     if (fRange.arr[i] > 0) then
3014       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3015   inc(aData, 4);
3016 end;
3017
3018 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3019 var
3020   i: Integer;
3021 begin
3022   for i := 0 to 3 do
3023     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3024   inc(aData, 2);
3025 end;
3026
3027 constructor TfdUniversal_UI1.Create;
3028 begin
3029   inherited Create;
3030   fPixelSize := 4.0;
3031 end;
3032
3033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3034 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3036 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3037 begin
3038   PCardinal(aData)^ := DepthWeight(aPixel);
3039   inc(aData, 4);
3040 end;
3041
3042 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3043 begin
3044   aPixel.Data.r := PCardinal(aData)^;
3045   aPixel.Data.g := PCardinal(aData)^;
3046   aPixel.Data.b := PCardinal(aData)^;
3047   aPixel.Data.a := 0;
3048   inc(aData, 4);
3049 end;
3050
3051 constructor TfdDepth_UI1.Create;
3052 begin
3053   inherited Create;
3054   fPixelSize        := 4.0;
3055   fRange.r          := $FFFFFFFF;
3056   fRange.g          := $FFFFFFFF;
3057   fRange.b          := $FFFFFFFF;
3058   fglFormat         := GL_DEPTH_COMPONENT;
3059   fglDataFormat     := GL_UNSIGNED_INT;
3060 end;
3061
3062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3063 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3065 constructor TfdAlpha4.Create;
3066 begin
3067   inherited Create;
3068   fFormat           := tfAlpha4;
3069   fWithAlpha        := tfAlpha4;
3070   fglInternalFormat := GL_ALPHA4;
3071 end;
3072
3073 constructor TfdAlpha8.Create;
3074 begin
3075   inherited Create;
3076   fFormat           := tfAlpha8;
3077   fWithAlpha        := tfAlpha8;
3078   fglInternalFormat := GL_ALPHA8;
3079 end;
3080
3081 constructor TfdAlpha12.Create;
3082 begin
3083   inherited Create;
3084   fFormat           := tfAlpha12;
3085   fWithAlpha        := tfAlpha12;
3086   fglInternalFormat := GL_ALPHA12;
3087 end;
3088
3089 constructor TfdAlpha16.Create;
3090 begin
3091   inherited Create;
3092   fFormat           := tfAlpha16;
3093   fWithAlpha        := tfAlpha16;
3094   fglInternalFormat := GL_ALPHA16;
3095 end;
3096
3097 constructor TfdLuminance4.Create;
3098 begin
3099   inherited Create;
3100   fFormat           := tfLuminance4;
3101   fWithAlpha        := tfLuminance4Alpha4;
3102   fWithoutAlpha     := tfLuminance4;
3103   fglInternalFormat := GL_LUMINANCE4;
3104 end;
3105
3106 constructor TfdLuminance8.Create;
3107 begin
3108   inherited Create;
3109   fFormat           := tfLuminance8;
3110   fWithAlpha        := tfLuminance8Alpha8;
3111   fWithoutAlpha     := tfLuminance8;
3112   fglInternalFormat := GL_LUMINANCE8;
3113 end;
3114
3115 constructor TfdLuminance12.Create;
3116 begin
3117   inherited Create;
3118   fFormat           := tfLuminance12;
3119   fWithAlpha        := tfLuminance12Alpha12;
3120   fWithoutAlpha     := tfLuminance12;
3121   fglInternalFormat := GL_LUMINANCE12;
3122 end;
3123
3124 constructor TfdLuminance16.Create;
3125 begin
3126   inherited Create;
3127   fFormat           := tfLuminance16;
3128   fWithAlpha        := tfLuminance16Alpha16;
3129   fWithoutAlpha     := tfLuminance16;
3130   fglInternalFormat := GL_LUMINANCE16;
3131 end;
3132
3133 constructor TfdLuminance4Alpha4.Create;
3134 begin
3135   inherited Create;
3136   fFormat           := tfLuminance4Alpha4;
3137   fWithAlpha        := tfLuminance4Alpha4;
3138   fWithoutAlpha     := tfLuminance4;
3139   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3140 end;
3141
3142 constructor TfdLuminance6Alpha2.Create;
3143 begin
3144   inherited Create;
3145   fFormat           := tfLuminance6Alpha2;
3146   fWithAlpha        := tfLuminance6Alpha2;
3147   fWithoutAlpha     := tfLuminance8;
3148   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3149 end;
3150
3151 constructor TfdLuminance8Alpha8.Create;
3152 begin
3153   inherited Create;
3154   fFormat           := tfLuminance8Alpha8;
3155   fWithAlpha        := tfLuminance8Alpha8;
3156   fWithoutAlpha     := tfLuminance8;
3157   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3158 end;
3159
3160 constructor TfdLuminance12Alpha4.Create;
3161 begin
3162   inherited Create;
3163   fFormat           := tfLuminance12Alpha4;
3164   fWithAlpha        := tfLuminance12Alpha4;
3165   fWithoutAlpha     := tfLuminance12;
3166   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3167 end;
3168
3169 constructor TfdLuminance12Alpha12.Create;
3170 begin
3171   inherited Create;
3172   fFormat           := tfLuminance12Alpha12;
3173   fWithAlpha        := tfLuminance12Alpha12;
3174   fWithoutAlpha     := tfLuminance12;
3175   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3176 end;
3177
3178 constructor TfdLuminance16Alpha16.Create;
3179 begin
3180   inherited Create;
3181   fFormat           := tfLuminance16Alpha16;
3182   fWithAlpha        := tfLuminance16Alpha16;
3183   fWithoutAlpha     := tfLuminance16;
3184   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3185 end;
3186
3187 constructor TfdR3G3B2.Create;
3188 begin
3189   inherited Create;
3190   fFormat           := tfR3G3B2;
3191   fWithAlpha        := tfRGBA2;
3192   fWithoutAlpha     := tfR3G3B2;
3193   fRange.r          := $7;
3194   fRange.g          := $7;
3195   fRange.b          := $3;
3196   fShift.r          :=  0;
3197   fShift.g          :=  3;
3198   fShift.b          :=  6;
3199   fglFormat         := GL_RGB;
3200   fglInternalFormat := GL_R3_G3_B2;
3201   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3202 end;
3203
3204 constructor TfdRGB4.Create;
3205 begin
3206   inherited Create;
3207   fFormat           := tfRGB4;
3208   fWithAlpha        := tfRGBA4;
3209   fWithoutAlpha     := tfRGB4;
3210   fRGBInverted      := tfBGR4;
3211   fRange.r          := $F;
3212   fRange.g          := $F;
3213   fRange.b          := $F;
3214   fShift.r          :=  0;
3215   fShift.g          :=  4;
3216   fShift.b          :=  8;
3217   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3218   fglInternalFormat := GL_RGB4;
3219   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3220 end;
3221
3222 constructor TfdR5G6B5.Create;
3223 begin
3224   inherited Create;
3225   fFormat           := tfR5G6B5;
3226   fWithAlpha        := tfRGBA4;
3227   fWithoutAlpha     := tfR5G6B5;
3228   fRGBInverted      := tfB5G6R5;
3229   fRange.r          := $1F;
3230   fRange.g          := $3F;
3231   fRange.b          := $1F;
3232   fShift.r          :=   0;
3233   fShift.g          :=   5;
3234   fShift.b          :=  11;
3235   fglFormat         := GL_RGB;
3236   fglInternalFormat := GL_RGB565;
3237   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3238 end;
3239
3240 constructor TfdRGB5.Create;
3241 begin
3242   inherited Create;
3243   fFormat           := tfRGB5;
3244   fWithAlpha        := tfRGB5A1;
3245   fWithoutAlpha     := tfRGB5;
3246   fRGBInverted      := tfBGR5;
3247   fRange.r          := $1F;
3248   fRange.g          := $1F;
3249   fRange.b          := $1F;
3250   fShift.r          :=   0;
3251   fShift.g          :=   5;
3252   fShift.b          :=  10;
3253   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3254   fglInternalFormat := GL_RGB5;
3255   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3256 end;
3257
3258 constructor TfdRGB8.Create;
3259 begin
3260   inherited Create;
3261   fFormat           := tfRGB8;
3262   fWithAlpha        := tfRGBA8;
3263   fWithoutAlpha     := tfRGB8;
3264   fRGBInverted      := tfBGR8;
3265   fglInternalFormat := GL_RGB8;
3266 end;
3267
3268 constructor TfdRGB10.Create;
3269 begin
3270   inherited Create;
3271   fFormat           := tfRGB10;
3272   fWithAlpha        := tfRGB10A2;
3273   fWithoutAlpha     := tfRGB10;
3274   fRGBInverted      := tfBGR10;
3275   fRange.r          := $3FF;
3276   fRange.g          := $3FF;
3277   fRange.b          := $3FF;
3278   fShift.r          :=    0;
3279   fShift.g          :=   10;
3280   fShift.b          :=   20;
3281   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3282   fglInternalFormat := GL_RGB10;
3283   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3284 end;
3285
3286 constructor TfdRGB12.Create;
3287 begin
3288   inherited Create;
3289   fFormat           := tfRGB12;
3290   fWithAlpha        := tfRGBA12;
3291   fWithoutAlpha     := tfRGB12;
3292   fRGBInverted      := tfBGR12;
3293   fglInternalFormat := GL_RGB12;
3294 end;
3295
3296 constructor TfdRGB16.Create;
3297 begin
3298   inherited Create;
3299   fFormat           := tfRGB16;
3300   fWithAlpha        := tfRGBA16;
3301   fWithoutAlpha     := tfRGB16;
3302   fRGBInverted      := tfBGR16;
3303   fglInternalFormat := GL_RGB16;
3304 end;
3305
3306 constructor TfdRGBA2.Create;
3307 begin
3308   inherited Create;
3309   fFormat           := tfRGBA2;
3310   fWithAlpha        := tfRGBA2;
3311   fWithoutAlpha     := tfR3G3B2;
3312   fRGBInverted      := tfBGRA2;
3313   fglInternalFormat := GL_RGBA2;
3314 end;
3315
3316 constructor TfdRGBA4.Create;
3317 begin
3318   inherited Create;
3319   fFormat           := tfRGBA4;
3320   fWithAlpha        := tfRGBA4;
3321   fWithoutAlpha     := tfRGB4;
3322   fRGBInverted      := tfBGRA4;
3323   fRange.r          := $F;
3324   fRange.g          := $F;
3325   fRange.b          := $F;
3326   fRange.a          := $F;
3327   fShift.r          :=  0;
3328   fShift.g          :=  4;
3329   fShift.b          :=  8;
3330   fShift.a          := 12;
3331   fglFormat         := GL_RGBA;
3332   fglInternalFormat := GL_RGBA4;
3333   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3334 end;
3335
3336 constructor TfdRGB5A1.Create;
3337 begin
3338   inherited Create;
3339   fFormat           := tfRGB5A1;
3340   fWithAlpha        := tfRGB5A1;
3341   fWithoutAlpha     := tfRGB5;
3342   fRGBInverted      := tfBGR5A1;
3343   fRange.r          := $1F;
3344   fRange.g          := $1F;
3345   fRange.b          := $1F;
3346   fRange.a          := $01;
3347   fShift.r          :=   0;
3348   fShift.g          :=   5;
3349   fShift.b          :=  10;
3350   fShift.a          :=  15;
3351   fglFormat         := GL_RGBA;
3352   fglInternalFormat := GL_RGB5_A1;
3353   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3354 end;
3355
3356 constructor TfdRGBA8.Create;
3357 begin
3358   inherited Create;
3359   fFormat           := tfRGBA8;
3360   fWithAlpha        := tfRGBA8;
3361   fWithoutAlpha     := tfRGB8;
3362   fRGBInverted      := tfBGRA8;
3363   fglInternalFormat := GL_RGBA8;
3364 end;
3365
3366 constructor TfdRGB10A2.Create;
3367 begin
3368   inherited Create;
3369   fFormat           := tfRGB10A2;
3370   fWithAlpha        := tfRGB10A2;
3371   fWithoutAlpha     := tfRGB10;
3372   fRGBInverted      := tfBGR10A2;
3373   fRange.r          := $3FF;
3374   fRange.g          := $3FF;
3375   fRange.b          := $3FF;
3376   fRange.a          := $003;
3377   fShift.r          :=    0;
3378   fShift.g          :=   10;
3379   fShift.b          :=   20;
3380   fShift.a          :=   30;
3381   fglFormat         := GL_RGBA;
3382   fglInternalFormat := GL_RGB10_A2;
3383   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3384 end;
3385
3386 constructor TfdRGBA12.Create;
3387 begin
3388   inherited Create;
3389   fFormat           := tfRGBA12;
3390   fWithAlpha        := tfRGBA12;
3391   fWithoutAlpha     := tfRGB12;
3392   fRGBInverted      := tfBGRA12;
3393   fglInternalFormat := GL_RGBA12;
3394 end;
3395
3396 constructor TfdRGBA16.Create;
3397 begin
3398   inherited Create;
3399   fFormat           := tfRGBA16;
3400   fWithAlpha        := tfRGBA16;
3401   fWithoutAlpha     := tfRGB16;
3402   fRGBInverted      := tfBGRA16;
3403   fglInternalFormat := GL_RGBA16;
3404 end;
3405
3406 constructor TfdBGR4.Create;
3407 begin
3408   inherited Create;
3409   fPixelSize        := 2.0;
3410   fFormat           := tfBGR4;
3411   fWithAlpha        := tfBGRA4;
3412   fWithoutAlpha     := tfBGR4;
3413   fRGBInverted      := tfRGB4;
3414   fRange.r          := $F;
3415   fRange.g          := $F;
3416   fRange.b          := $F;
3417   fRange.a          := $0;
3418   fShift.r          :=  8;
3419   fShift.g          :=  4;
3420   fShift.b          :=  0;
3421   fShift.a          :=  0;
3422   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3423   fglInternalFormat := GL_RGB4;
3424   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3425 end;
3426
3427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3429 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3430 constructor TfdB5G6R5.Create;
3431 begin
3432   inherited Create;
3433   fFormat           := tfB5G6R5;
3434   fWithAlpha        := tfBGRA4;
3435   fWithoutAlpha     := tfB5G6R5;
3436   fRGBInverted      := tfR5G6B5;
3437   fRange.r          := $1F;
3438   fRange.g          := $3F;
3439   fRange.b          := $1F;
3440   fShift.r          :=  11;
3441   fShift.g          :=   5;
3442   fShift.b          :=   0;
3443   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3444   fglInternalFormat := GL_RGB8;
3445   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3446 end;
3447
3448 constructor TfdBGR5.Create;
3449 begin
3450   inherited Create;
3451   fPixelSize        := 2.0;
3452   fFormat           := tfBGR5;
3453   fWithAlpha        := tfBGR5A1;
3454   fWithoutAlpha     := tfBGR5;
3455   fRGBInverted      := tfRGB5;
3456   fRange.r          := $1F;
3457   fRange.g          := $1F;
3458   fRange.b          := $1F;
3459   fRange.a          := $00;
3460   fShift.r          :=  10;
3461   fShift.g          :=   5;
3462   fShift.b          :=   0;
3463   fShift.a          :=   0;
3464   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3465   fglInternalFormat := GL_RGB5;
3466   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3467 end;
3468
3469 constructor TfdBGR8.Create;
3470 begin
3471   inherited Create;
3472   fFormat           := tfBGR8;
3473   fWithAlpha        := tfBGRA8;
3474   fWithoutAlpha     := tfBGR8;
3475   fRGBInverted      := tfRGB8;
3476   fglInternalFormat := GL_RGB8;
3477 end;
3478
3479 constructor TfdBGR10.Create;
3480 begin
3481   inherited Create;
3482   fFormat           := tfBGR10;
3483   fWithAlpha        := tfBGR10A2;
3484   fWithoutAlpha     := tfBGR10;
3485   fRGBInverted      := tfRGB10;
3486   fRange.r          := $3FF;
3487   fRange.g          := $3FF;
3488   fRange.b          := $3FF;
3489   fRange.a          := $000;
3490   fShift.r          :=   20;
3491   fShift.g          :=   10;
3492   fShift.b          :=    0;
3493   fShift.a          :=    0;
3494   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3495   fglInternalFormat := GL_RGB10;
3496   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3497 end;
3498
3499 constructor TfdBGR12.Create;
3500 begin
3501   inherited Create;
3502   fFormat           := tfBGR12;
3503   fWithAlpha        := tfBGRA12;
3504   fWithoutAlpha     := tfBGR12;
3505   fRGBInverted      := tfRGB12;
3506   fglInternalFormat := GL_RGB12;
3507 end;
3508
3509 constructor TfdBGR16.Create;
3510 begin
3511   inherited Create;
3512   fFormat           := tfBGR16;
3513   fWithAlpha        := tfBGRA16;
3514   fWithoutAlpha     := tfBGR16;
3515   fRGBInverted      := tfRGB16;
3516   fglInternalFormat := GL_RGB16;
3517 end;
3518
3519 constructor TfdBGRA2.Create;
3520 begin
3521   inherited Create;
3522   fFormat           := tfBGRA2;
3523   fWithAlpha        := tfBGRA4;
3524   fWithoutAlpha     := tfBGR4;
3525   fRGBInverted      := tfRGBA2;
3526   fglInternalFormat := GL_RGBA2;
3527 end;
3528
3529 constructor TfdBGRA4.Create;
3530 begin
3531   inherited Create;
3532   fFormat           := tfBGRA4;
3533   fWithAlpha        := tfBGRA4;
3534   fWithoutAlpha     := tfBGR4;
3535   fRGBInverted      := tfRGBA4;
3536   fRange.r          := $F;
3537   fRange.g          := $F;
3538   fRange.b          := $F;
3539   fRange.a          := $F;
3540   fShift.r          :=  8;
3541   fShift.g          :=  4;
3542   fShift.b          :=  0;
3543   fShift.a          := 12;
3544   fglFormat         := GL_BGRA;
3545   fglInternalFormat := GL_RGBA4;
3546   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3547 end;
3548
3549 constructor TfdBGR5A1.Create;
3550 begin
3551   inherited Create;
3552   fFormat           := tfBGR5A1;
3553   fWithAlpha        := tfBGR5A1;
3554   fWithoutAlpha     := tfBGR5;
3555   fRGBInverted      := tfRGB5A1;
3556   fRange.r          := $1F;
3557   fRange.g          := $1F;
3558   fRange.b          := $1F;
3559   fRange.a          := $01;
3560   fShift.r          :=  10;
3561   fShift.g          :=   5;
3562   fShift.b          :=   0;
3563   fShift.a          :=  15;
3564   fglFormat         := GL_BGRA;
3565   fglInternalFormat := GL_RGB5_A1;
3566   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3567 end;
3568
3569 constructor TfdBGRA8.Create;
3570 begin
3571   inherited Create;
3572   fFormat           := tfBGRA8;
3573   fWithAlpha        := tfBGRA8;
3574   fWithoutAlpha     := tfBGR8;
3575   fRGBInverted      := tfRGBA8;
3576   fglInternalFormat := GL_RGBA8;
3577 end;
3578
3579 constructor TfdBGR10A2.Create;
3580 begin
3581   inherited Create;
3582   fFormat           := tfBGR10A2;
3583   fWithAlpha        := tfBGR10A2;
3584   fWithoutAlpha     := tfBGR10;
3585   fRGBInverted      := tfRGB10A2;
3586   fRange.r          := $3FF;
3587   fRange.g          := $3FF;
3588   fRange.b          := $3FF;
3589   fRange.a          := $003;
3590   fShift.r          :=   20;
3591   fShift.g          :=   10;
3592   fShift.b          :=    0;
3593   fShift.a          :=   30;
3594   fglFormat         := GL_BGRA;
3595   fglInternalFormat := GL_RGB10_A2;
3596   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3597 end;
3598
3599 constructor TfdBGRA12.Create;
3600 begin
3601   inherited Create;
3602   fFormat           := tfBGRA12;
3603   fWithAlpha        := tfBGRA12;
3604   fWithoutAlpha     := tfBGR12;
3605   fRGBInverted      := tfRGBA12;
3606   fglInternalFormat := GL_RGBA12;
3607 end;
3608
3609 constructor TfdBGRA16.Create;
3610 begin
3611   inherited Create;
3612   fFormat           := tfBGRA16;
3613   fWithAlpha        := tfBGRA16;
3614   fWithoutAlpha     := tfBGR16;
3615   fRGBInverted      := tfRGBA16;
3616   fglInternalFormat := GL_RGBA16;
3617 end;
3618
3619 constructor TfdDepth16.Create;
3620 begin
3621   inherited Create;
3622   fFormat           := tfDepth16;
3623   fWithAlpha        := tfEmpty;
3624   fWithoutAlpha     := tfDepth16;
3625   fglInternalFormat := GL_DEPTH_COMPONENT16;
3626 end;
3627
3628 constructor TfdDepth24.Create;
3629 begin
3630   inherited Create;
3631   fFormat           := tfDepth24;
3632   fWithAlpha        := tfEmpty;
3633   fWithoutAlpha     := tfDepth24;
3634   fglInternalFormat := GL_DEPTH_COMPONENT24;
3635 end;
3636
3637 constructor TfdDepth32.Create;
3638 begin
3639   inherited Create;
3640   fFormat           := tfDepth32;
3641   fWithAlpha        := tfEmpty;
3642   fWithoutAlpha     := tfDepth32;
3643   fglInternalFormat := GL_DEPTH_COMPONENT32;
3644 end;
3645
3646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3647 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3648 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3649 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3650 begin
3651   raise EglBitmap.Create('mapping for compressed formats is not supported');
3652 end;
3653
3654 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3655 begin
3656   raise EglBitmap.Create('mapping for compressed formats is not supported');
3657 end;
3658
3659 constructor TfdS3tcDtx1RGBA.Create;
3660 begin
3661   inherited Create;
3662   fFormat           := tfS3tcDtx1RGBA;
3663   fWithAlpha        := tfS3tcDtx1RGBA;
3664   fUncompressed     := tfRGB5A1;
3665   fPixelSize        := 0.5;
3666   fIsCompressed     := true;
3667   fglFormat         := GL_COMPRESSED_RGBA;
3668   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3669   fglDataFormat     := GL_UNSIGNED_BYTE;
3670 end;
3671
3672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3673 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3674 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3675 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3676 begin
3677   raise EglBitmap.Create('mapping for compressed formats is not supported');
3678 end;
3679
3680 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3681 begin
3682   raise EglBitmap.Create('mapping for compressed formats is not supported');
3683 end;
3684
3685 constructor TfdS3tcDtx3RGBA.Create;
3686 begin
3687   inherited Create;
3688   fFormat           := tfS3tcDtx3RGBA;
3689   fWithAlpha        := tfS3tcDtx3RGBA;
3690   fUncompressed     := tfRGBA8;
3691   fPixelSize        := 1.0;
3692   fIsCompressed     := true;
3693   fglFormat         := GL_COMPRESSED_RGBA;
3694   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3695   fglDataFormat     := GL_UNSIGNED_BYTE;
3696 end;
3697
3698 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3699 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3700 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3701 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3702 begin
3703   raise EglBitmap.Create('mapping for compressed formats is not supported');
3704 end;
3705
3706 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3707 begin
3708   raise EglBitmap.Create('mapping for compressed formats is not supported');
3709 end;
3710
3711 constructor TfdS3tcDtx5RGBA.Create;
3712 begin
3713   inherited Create;
3714   fFormat           := tfS3tcDtx3RGBA;
3715   fWithAlpha        := tfS3tcDtx3RGBA;
3716   fUncompressed     := tfRGBA8;
3717   fPixelSize        := 1.0;
3718   fIsCompressed     := true;
3719   fglFormat         := GL_COMPRESSED_RGBA;
3720   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3721   fglDataFormat     := GL_UNSIGNED_BYTE;
3722 end;
3723
3724 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3725 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3726 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3727 class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
3728 var
3729   f: TglBitmapFormat;
3730 begin
3731   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
3732     result := TFormatDescriptor.Get(f);
3733     if (result.glInternalFormat = aInternalFormat) then
3734       exit;
3735   end;
3736   result := TFormatDescriptor.Get(tfEmpty);
3737 end;
3738
3739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3740 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3741 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3742 class procedure TFormatDescriptor.Init;
3743 begin
3744   if not Assigned(FormatDescriptorCS) then
3745     FormatDescriptorCS := TCriticalSection.Create;
3746 end;
3747
3748 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3749 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3750 begin
3751   FormatDescriptorCS.Enter;
3752   try
3753     result := FormatDescriptors[aFormat];
3754     if not Assigned(result) then begin
3755       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3756       FormatDescriptors[aFormat] := result;
3757     end;
3758   finally
3759     FormatDescriptorCS.Leave;
3760   end;
3761 end;
3762
3763 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3764 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3765 begin
3766   result := Get(Get(aFormat).WithAlpha);
3767 end;
3768
3769 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3770 class procedure TFormatDescriptor.Clear;
3771 var
3772   f: TglBitmapFormat;
3773 begin
3774   FormatDescriptorCS.Enter;
3775   try
3776     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3777       FreeAndNil(FormatDescriptors[f]);
3778   finally
3779     FormatDescriptorCS.Leave;
3780   end;
3781 end;
3782
3783 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3784 class procedure TFormatDescriptor.Finalize;
3785 begin
3786   Clear;
3787   FreeAndNil(FormatDescriptorCS);
3788 end;
3789
3790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3791 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3793 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3794 begin
3795   Update(aValue, fRange.r, fShift.r);
3796 end;
3797
3798 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3799 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3800 begin
3801   Update(aValue, fRange.g, fShift.g);
3802 end;
3803
3804 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3805 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3806 begin
3807   Update(aValue, fRange.b, fShift.b);
3808 end;
3809
3810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3811 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3812 begin
3813   Update(aValue, fRange.a, fShift.a);
3814 end;
3815
3816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3817 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3818   aShift: Byte);
3819 begin
3820   aShift := 0;
3821   aRange := 0;
3822   if (aMask = 0) then
3823     exit;
3824   while (aMask > 0) and ((aMask and 1) = 0) do begin
3825     inc(aShift);
3826     aMask := aMask shr 1;
3827   end;
3828   aRange := 1;
3829   while (aMask > 0) do begin
3830     aRange := aRange shl 1;
3831     aMask  := aMask  shr 1;
3832   end;
3833   dec(aRange);
3834
3835   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3836 end;
3837
3838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3839 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3840 var
3841   data: QWord;
3842   s: Integer;
3843 begin
3844   data :=
3845     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3846     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3847     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3848     ((aPixel.Data.a and fRange.a) shl fShift.a);
3849   s := Round(fPixelSize);
3850   case s of
3851     1:           aData^  := data;
3852     2:     PWord(aData)^ := data;
3853     4: PCardinal(aData)^ := data;
3854     8:    PQWord(aData)^ := data;
3855   else
3856     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3857   end;
3858   inc(aData, s);
3859 end;
3860
3861 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3862 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3863 var
3864   data: QWord;
3865   s, i: Integer;
3866 begin
3867   s := Round(fPixelSize);
3868   case s of
3869     1: data :=           aData^;
3870     2: data :=     PWord(aData)^;
3871     4: data := PCardinal(aData)^;
3872     8: data :=    PQWord(aData)^;
3873   else
3874     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3875   end;
3876   for i := 0 to 3 do
3877     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3878   inc(aData, s);
3879 end;
3880
3881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3882 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3884 procedure TbmpColorTableFormat.CreateColorTable;
3885 var
3886   i: Integer;
3887 begin
3888   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3889     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3890
3891   if (Format = tfLuminance4) then
3892     SetLength(fColorTable, 16)
3893   else
3894     SetLength(fColorTable, 256);
3895
3896   case Format of
3897     tfLuminance4: begin
3898       for i := 0 to High(fColorTable) do begin
3899         fColorTable[i].r := 16 * i;
3900         fColorTable[i].g := 16 * i;
3901         fColorTable[i].b := 16 * i;
3902         fColorTable[i].a := 0;
3903       end;
3904     end;
3905
3906     tfLuminance8: begin
3907       for i := 0 to High(fColorTable) do begin
3908         fColorTable[i].r := i;
3909         fColorTable[i].g := i;
3910         fColorTable[i].b := i;
3911         fColorTable[i].a := 0;
3912       end;
3913     end;
3914
3915     tfR3G3B2: begin
3916       for i := 0 to High(fColorTable) do begin
3917         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3918         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3919         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3920         fColorTable[i].a := 0;
3921       end;
3922     end;
3923   end;
3924 end;
3925
3926 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3927 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3928 var
3929   d: Byte;
3930 begin
3931   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3932     raise EglBitmap.Create(UNSUPPORTED_FORMAT);
3933
3934   case Format of
3935     tfLuminance4: begin
3936       if (aMapData = nil) then
3937         aData^ := 0;
3938       d := LuminanceWeight(aPixel) and Range.r;
3939       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3940       inc(PByte(aMapData), 4);
3941       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3942         inc(aData);
3943         aMapData := nil;
3944       end;
3945     end;
3946
3947     tfLuminance8: begin
3948       aData^ := LuminanceWeight(aPixel) and Range.r;
3949       inc(aData);
3950     end;
3951
3952     tfR3G3B2: begin
3953       aData^ := Round(
3954         ((aPixel.Data.r and Range.r) shl Shift.r) or
3955         ((aPixel.Data.g and Range.g) shl Shift.g) or
3956         ((aPixel.Data.b and Range.b) shl Shift.b));
3957       inc(aData);
3958     end;
3959   end;
3960 end;
3961
3962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3963 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3964 var
3965   idx: QWord;
3966   s: Integer;
3967   bits: Byte;
3968   f: Single;
3969 begin
3970   s    := Trunc(fPixelSize);
3971   f    := fPixelSize - s;
3972   bits := Round(8 * f);
3973   case s of
3974     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3975     1: idx :=           aData^;
3976     2: idx :=     PWord(aData)^;
3977     4: idx := PCardinal(aData)^;
3978     8: idx :=    PQWord(aData)^;
3979   else
3980     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3981   end;
3982   if (idx >= Length(fColorTable)) then
3983     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
3984   with fColorTable[idx] do begin
3985     aPixel.Data.r := r;
3986     aPixel.Data.g := g;
3987     aPixel.Data.b := b;
3988     aPixel.Data.a := a;
3989   end;
3990   inc(PByte(aMapData), bits);
3991   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3992     inc(aData, 1);
3993     dec(PByte(aMapData), 8);
3994   end;
3995   inc(aData, s);
3996 end;
3997
3998 destructor TbmpColorTableFormat.Destroy;
3999 begin
4000   SetLength(fColorTable, 0);
4001   inherited Destroy;
4002 end;
4003
4004 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////