32ee5753735bbb6723e5a5505220ec9e9d5d49ec
[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/)
6
7
8 ------------------------------------------------------------
9 The contents of this file are used with permission, subject to
10 the Mozilla Public License Version 1.1 (the "License"); you may
11 not use this file except in compliance with the License. You may
12 obtain a copy of the License at
13 http://www.mozilla.org/MPL/MPL-1.1.html
14 ------------------------------------------------------------
15 Version 2.0.3
16 ------------------------------------------------------------
17 History
18 21-03-2010
19 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
20   then it's your problem if that isn't true. This prevents the unit for incompatibility
21   with newer versions of Delphi.
22 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
23 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
24 10-08-2008
25 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
26 - Additional Datapointer for functioninterface now has the name CustomData  
27 24-07-2008
28 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
29 - If you load an texture from an file the property Filename will be set to the name of the file
30 - Three new properties to attach custom data to the Texture objects
31   - CustomName  (free for use string)
32   - CustomNameW (free for use widestring)
33   - CustomDataPointer (free for use pointer to attach other objects or complex structures)
34 27-05-2008
35 - RLE TGAs loaded much faster
36 26-05-2008
37 - fixed some problem with reading RLE TGAs.
38 21-05-2008
39 - function clone now only copys data if it's assigned and now it also copies the ID
40 - it seems that lazarus dont like comments in comments.
41 01-05-2008
42 - It's possible to set the id of the texture
43 - define GLB_NO_NATIVE_GL deactivated by default
44 27-04-2008
45 - Now supports the following libraries
46   - SDL and SDL_image
47   - libPNG
48   - libJPEG
49 - Linux compatibillity via free pascal compatibility (delphi sources optional)
50 - BMPs now loaded manuel
51 - Large restructuring
52 - Property DataPtr now has the name Data
53 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
54 - Unused Depth removed
55 - Function FreeData to freeing image data added 
56 24-10-2007
57 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
58 15-11-2006
59 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
60 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
61 - Function ReadOpenGLExtension is now only intern
62 29-06-2006
63 - pngimage now disabled by default like all other versions.
64 26-06-2006
65 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
66 22-06-2006
67 - Fixed some Problem with Delphi 5
68 - Now uses the newest version of pngimage. Makes saving pngs much easier.
69 22-03-2006
70 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
71 09-03-2006
72 - Internal Format ifDepth8 added
73 - function GrabScreen now supports all uncompressed formats
74 31-01-2006
75 - AddAlphaFromglBitmap implemented
76 29-12-2005
77 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
78 28-12-2005
79 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
80   property Width, Height, Depth are still existing and new property Dimension are avail
81 11-12-2005
82 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
83 19-10-2005
84 - Added function GrabScreen to class TglBitmap2D
85 18-10-2005
86 - Added support to Save images
87 - Added function Clone to Clone Instance
88 11-10-2005
89 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
90   Usefull for Future
91 - Several speed optimizations
92 09-10-2005
93 - Internal structure change. Loading of TGA, PNG and DDS improved.
94   Data, format and size will now set directly with SetDataPtr.
95 - AddFunc now works with all Types of Images and Formats
96 - Some Funtions moved to Baseclass TglBitmap
97 06-10-2005
98 - Added Support to decompress DXT3 and DXT5 compressed Images.
99 - Added Mapping to convert data from one format into an other.
100 05-10-2005
101 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
102   supported Input format (supported by GetPixel) into any uncompresed Format
103 - Added Support to decompress DXT1 compressed Images.
104 - SwapColors replaced by ConvertTo
105 04-10-2005
106 - Added Support for compressed DDSs
107 - Added new internal formats (DXT1, DXT3, DXT5)
108 29-09-2005
109 - Parameter Components renamed to InternalFormat
110 23-09-2005
111 - Some AllocMem replaced with GetMem (little speed change)
112 - better exception handling. Better protection from memory leaks.
113 22-09-2005
114 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
115 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
116 07-09-2005
117 - Added support for Grayscale textures
118 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
119 10-07-2005
120 - Added support for GL_VERSION_2_0
121 - Added support for GL_EXT_texture_filter_anisotropic
122 04-07-2005
123 - Function FillWithColor fills the Image with one Color
124 - Function LoadNormalMap added
125 30-06-2005
126 - ToNormalMap allows to Create an NormalMap from the Alphachannel
127 - ToNormalMap now supports Sobel (nmSobel) function.
128 29-06-2005
129 - support for RLE Compressed RGB TGAs added
130 28-06-2005
131 - Class TglBitmapNormalMap added to support Normalmap generation
132 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
133   3 Filters are supported. (4 Samples, 3x3 and 5x5)
134 16-06-2005
135 - Method LoadCubeMapClass removed
136 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
137 - virtual abstract method GenTexture in class TglBitmap now is protected
138 12-06-2005
139 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
140 10-06-2005
141 - little enhancement for IsPowerOfTwo
142 - TglBitmap1D.GenTexture now tests NPOT Textures
143 06-06-2005
144 - some little name changes. All properties or function with Texture in name are
145   now without texture in name. We have allways texture so we dosn't name it.
146 03-06-2005
147 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
148   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
149 02-06-2005
150 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
151 25-04-2005
152 - Function Unbind added
153 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
154 21-04-2005
155 - class TglBitmapCubeMap added (allows to Create Cubemaps)
156 29-03-2005
157 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
158   To Enable png's use the define pngimage
159 22-03-2005
160 - New Functioninterface added
161 - Function GetPixel added
162 27-11-2004
163 - Property BuildMipMaps renamed to MipMap
164 21-11-2004
165 - property Name removed.
166 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
167 22-05-2004
168 - property name added. Only used in glForms!
169 26-11-2003
170 - property FreeDataAfterGenTexture is now available as default (default = true)
171 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
172 - function MoveMemory replaced with function Move (little speed change)
173 - several calculations stored in variables (little speed change)
174 29-09-2003
175 - property BuildMipsMaps added (default = true)
176   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
177 - property FreeDataAfterGenTexture added (default = true)
178   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
179 - parameter DisableOtherTextureUnits of Bind removed
180 - parameter FreeDataAfterGeneration of GenTextures removed
181 12-09-2003
182 - TglBitmap dosn't delete data if class was destroyed (fixed)
183 09-09-2003
184 - Bind now enables TextureUnits (by params)
185 - GenTextures can leave data (by param)
186 - LoadTextures now optimal
187 03-09-2003
188 - Performance optimization in AddFunc
189 - procedure Bind moved to subclasses
190 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
191 19-08-2003
192 - Texturefilter and texturewrap now also as defaults
193   Minfilter = GL_LINEAR_MIPMAP_LINEAR
194   Magfilter = GL_LINEAR
195   Wrap(str) = GL_CLAMP_TO_EDGE
196 - Added new format tfCompressed to create a compressed texture.
197 - propertys IsCompressed, TextureSize and IsResident added
198   IsCompressed and TextureSize only contains data from level 0
199 18-08-2003
200 - Added function AddFunc to add PerPixelEffects to Image
201 - LoadFromFunc now based on AddFunc
202 - Invert now based on AddFunc
203 - SwapColors now based on AddFunc
204 16-08-2003
205 - Added function FlipHorz
206 15-08-2003
207 - Added function LaodFromFunc to create images with function
208 - Added function FlipVert
209 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
210 29-07-2003
211 - Added Alphafunctions to calculate alpha per function
212 - Added Alpha from ColorKey using alphafunctions
213 28-07-2003
214 - First full functionally Version of glBitmap
215 - Support for 24Bit and 32Bit TGA Pictures added
216 25-07-2003
217 - begin of programming
218 ***********************************************************}
219 unit glBitmap;
220
221 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
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
225 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
226 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
228 // activate to enable build-in OpenGL support with statically linked methods
229 // use dglOpenGL.pas if not enabled
230 {.$DEFINE GLB_NATIVE_OGL_STATIC}
231
232 // activate to enable build-in OpenGL support with dynamically linked methods
233 // use dglOpenGL.pas if not enabled
234 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
235
236 // activate to enable the support for SDL_surfaces
237 {.$DEFINE GLB_SDL}
238
239 // activate  to enable the support for TBitmap from Delphi (not lazarus)
240 {.$DEFINE GLB_DELPHI}
241
242
243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
244 // activate to enable the support of SDL_image to load files. (READ ONLY)
245 // If you enable SDL_image all other libraries will be ignored!
246 {.$DEFINE GLB_SDL_IMAGE}
247
248 // PNG /////////////////////////////////////////////////////////////////////////////////////////////
249 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
250 // if you enable pngimage the libPNG will be ignored
251 {.$DEFINE GLB_PNGIMAGE}
252
253 // activate to use the libPNG -> http://www.libpng.org/
254 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
255 {.$DEFINE GLB_LIB_PNG}
256
257 // JPEG ////////////////////////////////////////////////////////////////////////////////////////////
258 // if you enable delphi jpegs the libJPEG will be ignored
259 {.$DEFINE GLB_DELPHI_JPEG}
260
261 // activate to use the libJPEG -> http://www.ijg.org/
262 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
263 {$DEFINE GLB_LIB_JPEG}
264
265
266 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
267 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
269 // Delphi Versions
270 {$IFDEF fpc}
271   {$MODE Delphi}
272
273   {$IFDEF CPUI386}
274     {$DEFINE CPU386}
275     {$ASMMODE INTEL}
276   {$ENDIF}
277
278   {$IFNDEF WINDOWS}
279     {$linklib c}
280   {$ENDIF}
281 {$ENDIF}
282
283 // Operation System
284 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
285   {$DEFINE GLB_WIN}
286 {$ELSEIF DEFINED(LINUX)}
287   {$DEFINE GLB_LINUX}
288 {$IFEND}
289
290 // native OpenGL Support
291 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
292   {$DEFINE GLB_NATIVE_OGL}
293 {$IFEND}
294
295 // checking define combinations
296 //SDL Image
297 {$IFDEF GLB_SDL_IMAGE}
298   {$IFNDEF GLB_SDL}
299     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
300     {$DEFINE GLB_SDL}
301   {$ENDIF}
302   {$IFDEF GLB_PNGIMAGE}
303     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
304     {$undef GLB_PNGIMAGE}
305   {$ENDIF}
306   {$IFDEF GLB_DELPHI_JPEG}
307     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
308     {$undef GLB_DELPHI_JPEG}
309   {$ENDIF}
310   {$IFDEF GLB_LIB_PNG}
311     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
312     {$undef GLB_LIB_PNG}
313   {$ENDIF}
314   {$IFDEF GLB_LIB_JPEG}
315     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
316     {$undef GLB_LIB_JPEG}
317   {$ENDIF}
318
319   {$DEFINE GLB_SUPPORT_PNG_READ}
320   {$DEFINE GLB_SUPPORT_JPEG_READ}
321 {$ENDIF}
322
323 // PNG Image
324 {$IFDEF GLB_PNGIMAGE}
325   {$IFDEF GLB_LIB_PNG}
326     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
327     {$undef GLB_LIB_PNG}
328   {$ENDIF}
329
330   {$DEFINE GLB_SUPPORT_PNG_READ}
331   {$DEFINE GLB_SUPPORT_PNG_WRITE}
332 {$ENDIF}
333
334 // libPNG
335 {$IFDEF GLB_LIB_PNG}
336   {$DEFINE GLB_SUPPORT_PNG_READ}
337   {$DEFINE GLB_SUPPORT_PNG_WRITE}
338 {$ENDIF}
339
340 // JPEG Image
341 {$IFDEF GLB_DELPHI_JPEG}
342   {$IFDEF GLB_LIB_JPEG}
343     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
344     {$undef GLB_LIB_JPEG}
345   {$ENDIF}
346
347   {$DEFINE GLB_SUPPORT_JPEG_READ}
348   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
349 {$ENDIF}
350
351 // libJPEG
352 {$IFDEF GLB_LIB_JPEG}
353   {$DEFINE GLB_SUPPORT_JPEG_READ}
354   {$DEFINE GLB_SUPPORT_JPEG_WRITE}
355 {$ENDIF}
356
357 // native OpenGL
358 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
359   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
360 {$ENDIF}
361
362 // general options
363 {$EXTENDEDSYNTAX ON}
364 {$LONGSTRINGS ON}
365 {$ALIGN ON}
366 {$IFNDEF FPC}
367   {$OPTIMIZATION ON}
368 {$ENDIF}
369
370 interface
371
372 uses
373   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                   {$ENDIF}
374   {$IF DEFINED(GLB_WIN) AND
375        DEFINED(GLB_NATIVE_OGL)} windows,                 {$IFEND}
376
377   {$IFDEF GLB_SDL}              SDL,                         {$ENDIF}
378   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,           {$ENDIF}
379
380   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                   {$ENDIF}
381
382   {$IFDEF GLB_PNGIMAGE}         pngimage,                    {$ENDIF}
383   {$IFDEF GLB_LIB_PNG}          libPNG,                      {$ENDIF}
384
385   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                        {$ENDIF}
386   {$IFDEF GLB_LIB_JPEG}         libJPEG,                     {$ENDIF}
387
388   Classes, SysUtils;
389
390 {$IFNDEF GLB_DELPHI}
391 type
392   HGLRC = Cardinal;
393   DWORD = Cardinal;
394   PDWORD = ^DWORD;
395
396   TRGBQuad = packed record
397     rgbBlue: Byte;
398     rgbGreen: Byte;
399     rgbRed: Byte;
400     rgbReserved: Byte;
401   end;
402 {$ENDIF}
403
404 {$IFDEF GLB_NATIVE_OGL}
405 const
406   GL_TRUE   = 1;
407   GL_FALSE  = 0;
408
409   GL_VERSION    = $1F02;
410   GL_EXTENSIONS = $1F03;
411
412   GL_TEXTURE_1D         = $0DE0;
413   GL_TEXTURE_2D         = $0DE1;
414   GL_TEXTURE_RECTANGLE  = $84F5;
415
416   GL_TEXTURE_WIDTH            = $1000;
417   GL_TEXTURE_HEIGHT           = $1001;
418   GL_TEXTURE_INTERNAL_FORMAT  = $1003;
419
420   GL_ALPHA    = $1906;
421   GL_ALPHA4   = $803B;
422   GL_ALPHA8   = $803C;
423   GL_ALPHA12  = $803D;
424   GL_ALPHA16  = $803E;
425
426   GL_LUMINANCE    = $1909;
427   GL_LUMINANCE4   = $803F;
428   GL_LUMINANCE8   = $8040;
429   GL_LUMINANCE12  = $8041;
430   GL_LUMINANCE16  = $8042;
431
432   GL_LUMINANCE_ALPHA      = $190A;
433   GL_LUMINANCE4_ALPHA4    = $8043;
434   GL_LUMINANCE6_ALPHA2    = $8044;
435   GL_LUMINANCE8_ALPHA8    = $8045;
436   GL_LUMINANCE12_ALPHA4   = $8046;
437   GL_LUMINANCE12_ALPHA12  = $8047;
438   GL_LUMINANCE16_ALPHA16  = $8048;
439
440   GL_RGB      = $1907;
441   GL_BGR      = $80E0;
442   GL_R3_G3_B2 = $2A10;
443   GL_RGB4     = $804F;
444   GL_RGB5     = $8050;
445   GL_RGB565   = $8D62;
446   GL_RGB8     = $8051;
447   GL_RGB10    = $8052;
448   GL_RGB12    = $8053;
449   GL_RGB16    = $8054;
450
451   GL_RGBA     = $1908;
452   GL_BGRA     = $80E1;
453   GL_RGBA2    = $8055;
454   GL_RGBA4    = $8056;
455   GL_RGB5_A1  = $8057;
456   GL_RGBA8    = $8058;
457   GL_RGB10_A2 = $8059;
458   GL_RGBA12   = $805A;
459   GL_RGBA16   = $805B;
460
461   GL_DEPTH_COMPONENT    = $1902;
462   GL_DEPTH_COMPONENT16  = $81A5;
463   GL_DEPTH_COMPONENT24  = $81A6;
464   GL_DEPTH_COMPONENT32  = $81A7;
465
466   GL_COMPRESSED_RGB                 = $84ED;
467   GL_COMPRESSED_RGBA                = $84EE;
468   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;
469   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;
470   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;
471   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;
472
473   GL_UNSIGNED_BYTE            = $1401;
474   GL_UNSIGNED_BYTE_3_3_2      = $8032;
475   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;
476
477   GL_UNSIGNED_SHORT             = $1403;
478   GL_UNSIGNED_SHORT_5_6_5       = $8363;
479   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;
480   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;
481   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;
482   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
483   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
484
485   GL_UNSIGNED_INT                 = $1405;
486   GL_UNSIGNED_INT_8_8_8_8         = $8035;
487   GL_UNSIGNED_INT_10_10_10_2      = $8036;
488   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;
489   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;
490
491   { Texture Filter }
492   GL_TEXTURE_MAG_FILTER     = $2800;
493   GL_TEXTURE_MIN_FILTER     = $2801;
494   GL_NEAREST                = $2600;
495   GL_NEAREST_MIPMAP_NEAREST = $2700;
496   GL_NEAREST_MIPMAP_LINEAR  = $2702;
497   GL_LINEAR                 = $2601;
498   GL_LINEAR_MIPMAP_NEAREST  = $2701;
499   GL_LINEAR_MIPMAP_LINEAR   = $2703;
500
501   { Texture Wrap }
502   GL_TEXTURE_WRAP_S   = $2802;
503   GL_TEXTURE_WRAP_T   = $2803;
504   GL_TEXTURE_WRAP_R   = $8072;
505   GL_CLAMP            = $2900;
506   GL_REPEAT           = $2901;
507   GL_CLAMP_TO_EDGE    = $812F;
508   GL_CLAMP_TO_BORDER  = $812D;
509   GL_MIRRORED_REPEAT  = $8370;
510
511   { Other }
512   GL_GENERATE_MIPMAP      = $8191;
513   GL_TEXTURE_BORDER_COLOR = $1004;
514   GL_MAX_TEXTURE_SIZE     = $0D33;
515   GL_PACK_ALIGNMENT       = $0D05;
516   GL_UNPACK_ALIGNMENT     = $0CF5;
517
518   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;
519   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
520
521 {$ifdef LINUX}
522   libglu    = 'libGLU.so.1';
523   libopengl = 'libGL.so.1';
524 {$else}
525   libglu    = 'glu32.dll';
526   libopengl = 'opengl32.dll';
527 {$endif}
528
529 type
530   GLboolean = BYTEBOOL;
531   GLint     = Integer;
532   GLsizei   = Integer;
533   GLuint    = Cardinal;
534   GLfloat   = Single;
535   GLenum    = Cardinal;
536
537   PGLvoid    = Pointer;
538   PGLboolean = ^GLboolean;
539   PGLint     = ^GLint;
540   PGLuint    = ^GLuint;
541   PGLfloat   = ^GLfloat;
542
543   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
544   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}
545   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
546
547 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
548   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
549   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
550
551   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
552   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
553
554   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
555   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
556   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
557   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
558   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
559   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
560
561   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
562   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
563   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
564
565   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
566   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
567   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
568
569   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}
570   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}
571   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
572
573   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
574   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
575
576   {$IFDEF GLB_LINUX}
577   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
578   {$ELSE}
579   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
580   {$ENDIF}
581
582 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
583   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
584   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
585
586   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
587   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
588
589   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
590   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
591   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
592   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
593   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
594   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
595
596   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
597   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
598   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
599
600   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
601   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;
602   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
603
604   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;
605   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;
606   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
607
608   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
609   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
610 {$ENDIF}
611
612 var
613   GL_VERSION_1_2,
614   GL_VERSION_1_3,
615   GL_VERSION_1_4,
616   GL_VERSION_2_0,
617
618   GL_SGIS_generate_mipmap,
619
620   GL_ARB_texture_border_clamp,
621   GL_ARB_texture_mirrored_repeat,
622   GL_ARB_texture_rectangle,
623   GL_ARB_texture_non_power_of_two,
624
625   GL_IBM_texture_mirrored_repeat,
626
627   GL_NV_texture_rectangle,
628
629   GL_EXT_texture_edge_clamp,
630   GL_EXT_texture_rectangle,
631   GL_EXT_texture_filter_anisotropic: Boolean;
632
633   glCompressedTexImage1D: TglCompressedTexImage1D;
634   glCompressedTexImage2D: TglCompressedTexImage2D;
635   glGetCompressedTexImage: TglGetCompressedTexImage;
636
637 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
638   glEnable: TglEnable;
639   glDisable: TglDisable;
640
641   glGetString: TglGetString;
642   glGetIntegerv: TglGetIntegerv;
643
644   glTexParameteri: TglTexParameteri;
645   glTexParameterfv: TglTexParameterfv;
646   glGetTexParameteriv: TglGetTexParameteriv;
647   glGetTexParameterfv: TglGetTexParameterfv;
648   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
649   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
650
651   glGenTextures: TglGenTextures;
652   glBindTexture: TglBindTexture;
653   glDeleteTextures: TglDeleteTextures;
654
655   glAreTexturesResident: TglAreTexturesResident;
656   glReadPixels: TglReadPixels;
657   glPixelStorei: TglPixelStorei;
658
659   glTexImage1D: TglTexImage1D;
660   glTexImage2D: TglTexImage2D;
661   glGetTexImage: TglGetTexImage;
662
663   gluBuild1DMipmaps: TgluBuild1DMipmaps;
664   gluBuild2DMipmaps: TgluBuild2DMipmaps;
665
666   {$IF DEFINED(GLB_WIN)}
667   wglGetProcAddress: TwglGetProcAddress;
668   {$ELSEIF DEFINED(GLB_LINUX)}
669   glXGetProcAddress: TglXGetProcAddress;
670   glXGetProcAddressARB: TglXGetProcAddressARB;
671   {$ENDIF}
672 {$ENDIF}
673
674 (*
675 {$IFDEF GLB_DELPHI}
676 var
677   gLastContext: HGLRC;
678 {$ENDIF}
679 *)
680
681 {$ENDIF}
682
683 type
684 ////////////////////////////////////////////////////////////////////////////////////////////////////
685   TglBitmapFormat = (
686     tfEmpty = 0, //must be smallest value!
687
688     tfAlpha4,
689     tfAlpha8,
690     tfAlpha12,
691     tfAlpha16,
692
693     tfLuminance4,
694     tfLuminance8,
695     tfLuminance12,
696     tfLuminance16,
697
698     tfLuminance4Alpha4,
699     tfLuminance6Alpha2,
700     tfLuminance8Alpha8,
701     tfLuminance12Alpha4,
702     tfLuminance12Alpha12,
703     tfLuminance16Alpha16,
704
705     tfR3G3B2,
706     tfRGB4,
707     tfR5G6B5,
708     tfRGB5,
709     tfRGB8,
710     tfRGB10,
711     tfRGB12,
712     tfRGB16,
713
714     tfRGBA2,
715     tfRGBA4,
716     tfRGB5A1,
717     tfRGBA8,
718     tfRGB10A2,
719     tfRGBA12,
720     tfRGBA16,
721
722     tfBGR4,
723     tfB5G6R5,
724     tfBGR5,
725     tfBGR8,
726     tfBGR10,
727     tfBGR12,
728     tfBGR16,
729
730     tfBGRA2,
731     tfBGRA4,
732     tfBGR5A1,
733     tfBGRA8,
734     tfBGR10A2,
735     tfBGRA12,
736     tfBGRA16,
737
738     tfDepth16,
739     tfDepth24,
740     tfDepth32,
741
742     tfS3tcDtx1RGBA,
743     tfS3tcDtx3RGBA,
744     tfS3tcDtx5RGBA
745   );
746
747   TglBitmapFileType = (
748      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}
749      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
750      ftDDS,
751      ftTGA,
752      ftBMP);
753    TglBitmapFileTypes = set of TglBitmapFileType;
754
755    TglBitmapMipMap = (
756      mmNone,
757      mmMipmap,
758      mmMipmapGlu);
759
760    TglBitmapNormalMapFunc = (
761      nm4Samples,
762      nmSobel,
763      nm3x3,
764      nm5x5);
765
766  ////////////////////////////////////////////////////////////////////////////////////////////////////
767    EglBitmapException               = class(Exception);
768    EglBitmapSizeToLargeException    = class(EglBitmapException);
769    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);
770    EglBitmapUnsupportedFormat       = class(EglBitmapException)
771      constructor Create(const aFormat: TglBitmapFormat);
772    end;
773
774 ////////////////////////////////////////////////////////////////////////////////////////////////////
775   TglBitmapColorRec = packed record
776   case Integer of
777     0: (r, g, b, a: Cardinal);
778     1: (arr: array[0..3] of Cardinal);
779   end;
780
781   TglBitmapPixelData = packed record
782     Data, Range: TglBitmapColorRec;
783     Format: TglBitmapFormat;
784   end;
785   PglBitmapPixelData = ^TglBitmapPixelData;
786
787 ////////////////////////////////////////////////////////////////////////////////////////////////////
788   TglBitmapPixelPositionFields = set of (ffX, ffY);
789   TglBitmapPixelPosition = record
790     Fields : TglBitmapPixelPositionFields;
791     X : Word;
792     Y : Word;
793   end;
794
795 ////////////////////////////////////////////////////////////////////////////////////////////////////
796   TglBitmap = class;
797   TglBitmapFunctionRec = record
798     Sender:   TglBitmap;
799     Size:     TglBitmapPixelPosition;
800     Position: TglBitmapPixelPosition;
801     Source:   TglBitmapPixelData;
802     Dest:     TglBitmapPixelData;
803     Args:     Pointer;
804   end;
805   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
806
807 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
808   TglBitmap = class
809   protected
810     fID: GLuint;
811     fTarget: GLuint;
812     fAnisotropic: Integer;
813     fDeleteTextureOnFree: Boolean;
814     fFreeDataAfterGenTexture: Boolean;
815     fData: PByte;
816     fIsResident: Boolean;
817     fBorderColor: array[0..3] of Single;
818
819     fDimension: TglBitmapPixelPosition;
820     fMipMap: TglBitmapMipMap;
821     fFormat: TglBitmapFormat;
822
823     // Mapping
824     fPixelSize: Integer;
825     fRowSize: Integer;
826
827     // Filtering
828     fFilterMin: Cardinal;
829     fFilterMag: Cardinal;
830
831     // TexturWarp
832     fWrapS: Cardinal;
833     fWrapT: Cardinal;
834     fWrapR: Cardinal;
835
836     // CustomData
837     fFilename: String;
838     fCustomName: String;
839     fCustomNameW: WideString;
840     fCustomData: Pointer;
841
842     //Getter
843     function GetWidth:  Integer; virtual;
844     function GetHeight: Integer; virtual;
845
846     function GetFileWidth:  Integer; virtual;
847     function GetFileHeight: Integer; virtual;
848
849     //Setter
850     procedure SetCustomData(const aValue: Pointer);
851     procedure SetCustomName(const aValue: String);
852     procedure SetCustomNameW(const aValue: WideString);
853     procedure SetDeleteTextureOnFree(const aValue: Boolean);
854     procedure SetFormat(const aValue: TglBitmapFormat);
855     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
856     procedure SetID(const aValue: Cardinal);
857     procedure SetMipMap(const aValue: TglBitmapMipMap);
858     procedure SetTarget(const aValue: Cardinal);
859     procedure SetAnisotropic(const aValue: Integer);
860
861     procedure CreateID;
862     procedure SetupParameters(out aBuildWithGlu: Boolean);
863     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
864       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
865     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
866
867     function FlipHorz: Boolean; virtual;
868     function FlipVert: Boolean; virtual;
869
870     property Width:  Integer read GetWidth;
871     property Height: Integer read GetHeight;
872
873     property FileWidth:  Integer read GetFileWidth;
874     property FileHeight: Integer read GetFileHeight;
875   public
876     //Properties
877     property ID:           Cardinal        read fID          write SetID;
878     property Target:       Cardinal        read fTarget      write SetTarget;
879     property Format:       TglBitmapFormat read fFormat      write SetFormat;
880     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;
881     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;
882
883     property Filename:    String     read fFilename;
884     property CustomName:  String     read fCustomName  write SetCustomName;
885     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
886     property CustomData:  Pointer    read fCustomData  write SetCustomData;
887
888     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;
889     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
890
891     property Dimension:  TglBitmapPixelPosition  read fDimension;
892     property Data:       PByte                   read fData;
893     property IsResident: Boolean                 read fIsResident;
894
895     procedure AfterConstruction; override;
896     procedure BeforeDestruction; override;
897
898     //Load
899     procedure LoadFromFile(const aFilename: String);
900     procedure LoadFromStream(const aStream: TStream); virtual;
901     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
902       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
903     {$IFDEF GLB_DELPHI}
904     procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
905     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
906     {$ENDIF}
907
908     //Save
909     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
910     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
911
912     //Convert
913     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
914     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
915       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
916   public
917     //Alpha & Co
918     {$IFDEF GLB_SDL}
919     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
920     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
921     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
922     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
923       const aArgs: Pointer = nil): Boolean;
924     {$ENDIF}
925
926     {$IFDEF GLB_DELPHI}
927     function AssignToBitmap(const aBitmap: TBitmap): Boolean;
928     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
929     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
930     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
931       const aArgs: Pointer = nil): Boolean;
932     function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
933       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
934     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
935       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
936     {$ENDIF}
937
938     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
939     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
940     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
941     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
942
943     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
944     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
945     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
946
947     function AddAlphaFromValue(const aAlpha: Byte): Boolean;
948     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
949     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
950
951     function RemoveAlpha: Boolean; virtual;
952   public
953     //Common
954     function Clone: TglBitmap;
955     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
956     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
957     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
958     procedure FreeData;
959
960     //ColorFill
961     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
962     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
963     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
964
965     //TexParameters
966     procedure SetFilter(const aMin, aMag: Cardinal);
967     procedure SetWrap(
968       const S: Cardinal = GL_CLAMP_TO_EDGE;
969       const T: Cardinal = GL_CLAMP_TO_EDGE;
970       const R: Cardinal = GL_CLAMP_TO_EDGE);
971
972     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
973     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
974
975     //Constructors
976     constructor Create; overload;
977     constructor Create(const aFileName: String); overload;
978     constructor Create(const aStream: TStream); overload;
979     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
980     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
981     {$IFDEF GLB_DELPHI}
982     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
983     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
984     {$ENDIF}
985   private
986     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
987     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
988
989     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
990     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
991
992     function LoadBMP(const aStream: TStream): Boolean; virtual;
993     procedure SaveBMP(const aStream: TStream); virtual;
994
995     function LoadTGA(const aStream: TStream): Boolean; virtual;
996     procedure SaveTGA(const aStream: TStream); virtual;
997
998     function LoadDDS(const aStream: TStream): Boolean; virtual;
999     procedure SaveDDS(const aStream: TStream); virtual;
1000   end;
1001
1002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1003   TglBitmap2D = class(TglBitmap)
1004   protected
1005     // Bildeinstellungen
1006     fLines: array of PByte;
1007
1008     (* TODO
1009     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1010     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1011     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1012     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1013     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1014     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1015     *)
1016
1017     function GetScanline(const aIndex: Integer): Pointer;
1018     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1019       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1020     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1021   public
1022     property Width;
1023     property Height;
1024     property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1025
1026     procedure AfterConstruction; override;
1027
1028     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1029     procedure GetDataFromTexture;
1030     procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1031
1032     function FlipHorz: Boolean; override;
1033     function FlipVert: Boolean; override;
1034
1035     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1036       const aScale: Single = 2; const aUseAlpha: Boolean = false);
1037   end;
1038
1039 (* TODO
1040   TglBitmapCubeMap = class(TglBitmap2D)
1041   protected
1042     fGenMode: Integer;
1043
1044     // Hide GenTexture
1045     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1046   public
1047     procedure AfterConstruction; override;
1048
1049     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1050
1051     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1052     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1053   end;
1054
1055
1056   TglBitmapNormalMap = class(TglBitmapCubeMap)
1057   public
1058     procedure AfterConstruction; override;
1059
1060     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1061   end;
1062
1063
1064   TglBitmap1D = class(TglBitmap)
1065   protected
1066     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1067
1068     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1069     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1070   public
1071     // propertys
1072     property Width;
1073
1074     procedure AfterConstruction; override;
1075
1076     // Other
1077     function FlipHorz: Boolean; override;
1078
1079     // Generation
1080     procedure GenTexture(TestTextureSize: Boolean = true); override;
1081   end;
1082 *)
1083
1084 const
1085   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1086
1087 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1088 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1089 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1090 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1091 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1092 procedure glBitmapSetDefaultWrap(
1093   const S: Cardinal = GL_CLAMP_TO_EDGE;
1094   const T: Cardinal = GL_CLAMP_TO_EDGE;
1095   const R: Cardinal = GL_CLAMP_TO_EDGE);
1096
1097 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1098 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1099 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1100 function glBitmapGetDefaultFormat: TglBitmapFormat;
1101 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1102 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1103
1104 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1105 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1106 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1107
1108 var
1109   glBitmapDefaultDeleteTextureOnFree: Boolean;
1110   glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1111   glBitmapDefaultFormat: TglBitmapFormat;
1112   glBitmapDefaultMipmap: TglBitmapMipMap;
1113   glBitmapDefaultFilterMin: Cardinal;
1114   glBitmapDefaultFilterMag: Cardinal;
1115   glBitmapDefaultWrapS: Cardinal;
1116   glBitmapDefaultWrapT: Cardinal;
1117   glBitmapDefaultWrapR: Cardinal;
1118
1119 {$IFDEF GLB_DELPHI}
1120 function CreateGrayPalette: HPALETTE;
1121 {$ENDIF}
1122
1123 implementation
1124
1125
1126     (* TODO
1127     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1128     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1129     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1130     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1131     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1132     *)
1133
1134 uses
1135   Math, syncobjs, typinfo;
1136
1137 type
1138 ////////////////////////////////////////////////////////////////////////////////////////////////////
1139   TShiftRec = packed record
1140   case Integer of
1141     0: (r, g, b, a: Byte);
1142     1: (arr: array[0..3] of Byte);
1143   end;
1144
1145   TFormatDescriptor = class(TObject)
1146   private
1147     function GetRedMask: QWord;
1148     function GetGreenMask: QWord;
1149     function GetBlueMask: QWord;
1150     function GetAlphaMask: QWord;
1151   protected
1152     fFormat: TglBitmapFormat;
1153     fWithAlpha: TglBitmapFormat;
1154     fWithoutAlpha: TglBitmapFormat;
1155     fRGBInverted: TglBitmapFormat;
1156     fUncompressed: TglBitmapFormat;
1157     fPixelSize: Single;
1158     fIsCompressed: Boolean;
1159
1160     fRange: TglBitmapColorRec;
1161     fShift: TShiftRec;
1162
1163     fglFormat:         Cardinal;
1164     fglInternalFormat: Cardinal;
1165     fglDataFormat:     Cardinal;
1166
1167     function GetComponents: Integer; virtual;
1168   public
1169     property Format:       TglBitmapFormat read fFormat;
1170     property WithAlpha:    TglBitmapFormat read fWithAlpha;
1171     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1172     property RGBInverted:  TglBitmapFormat read fRGBInverted;
1173     property Components:   Integer         read GetComponents;
1174     property PixelSize:    Single          read fPixelSize;
1175     property IsCompressed: Boolean         read fIsCompressed;
1176
1177     property glFormat:         Cardinal read fglFormat;
1178     property glInternalFormat: Cardinal read fglInternalFormat;
1179     property glDataFormat:     Cardinal read fglDataFormat;
1180
1181     property Range: TglBitmapColorRec read fRange;
1182     property Shift: TShiftRec         read fShift;
1183
1184     property RedMask:   QWord read GetRedMask;
1185     property GreenMask: QWord read GetGreenMask;
1186     property BlueMask:  QWord read GetBlueMask;
1187     property AlphaMask: QWord read GetAlphaMask;
1188
1189     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1190     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1191
1192     function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1193     function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1194
1195     function CreateMappingData: Pointer; virtual;
1196     procedure FreeMappingData(var aMappingData: Pointer); virtual;
1197
1198     function IsEmpty:  Boolean; virtual;
1199     function HasAlpha: Boolean; virtual;
1200     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1201
1202     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1203
1204     constructor Create; virtual;
1205   public
1206     class procedure Init;
1207     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1208     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1209     class procedure Clear;
1210     class procedure Finalize;
1211   end;
1212   TFormatDescriptorClass = class of TFormatDescriptor;
1213
1214   TfdEmpty = class(TFormatDescriptor);
1215
1216 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1217   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1218     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1219     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1220     constructor Create; override;
1221   end;
1222
1223   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1224     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1225     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1226     constructor Create; override;
1227   end;
1228
1229   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1230     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1231     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1232     constructor Create; override;
1233   end;
1234
1235   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1236     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1237     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1238     constructor Create; override;
1239   end;
1240
1241   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1242     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1243     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1244     constructor Create; override;
1245   end;
1246
1247   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1248     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1249     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1250     constructor Create; override;
1251   end;
1252
1253   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1254     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1255     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1256     constructor Create; override;
1257   end;
1258
1259   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)
1260     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1261     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1262     constructor Create; override;
1263   end;
1264
1265 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1266   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1267     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269     constructor Create; override;
1270   end;
1271
1272   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1273     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275     constructor Create; override;
1276   end;
1277
1278   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1279     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1280     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1281     constructor Create; override;
1282   end;
1283
1284   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1285     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1286     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1287     constructor Create; override;
1288   end;
1289
1290   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1291     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1292     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1293     constructor Create; override;
1294   end;
1295
1296   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1297     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299     constructor Create; override;
1300   end;
1301
1302   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1303     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1304     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1305     constructor Create; override;
1306   end;
1307
1308   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1309     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311     constructor Create; override;
1312   end;
1313
1314   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1315     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1316     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1317     constructor Create; override;
1318   end;
1319
1320 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1321   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1322     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324     constructor Create; override;
1325   end;
1326
1327   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1328     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1329     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1330     constructor Create; override;
1331   end;
1332
1333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1334   TfdAlpha4 = class(TfdAlpha_UB1)
1335     constructor Create; override;
1336   end;
1337
1338   TfdAlpha8 = class(TfdAlpha_UB1)
1339     constructor Create; override;
1340   end;
1341
1342   TfdAlpha12 = class(TfdAlpha_US1)
1343     constructor Create; override;
1344   end;
1345
1346   TfdAlpha16 = class(TfdAlpha_US1)
1347     constructor Create; override;
1348   end;
1349
1350   TfdLuminance4 = class(TfdLuminance_UB1)
1351     constructor Create; override;
1352   end;
1353
1354   TfdLuminance8 = class(TfdLuminance_UB1)
1355     constructor Create; override;
1356   end;
1357
1358   TfdLuminance12 = class(TfdLuminance_US1)
1359     constructor Create; override;
1360   end;
1361
1362   TfdLuminance16 = class(TfdLuminance_US1)
1363     constructor Create; override;
1364   end;
1365
1366   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1367     constructor Create; override;
1368   end;
1369
1370   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1371     constructor Create; override;
1372   end;
1373
1374   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1375     constructor Create; override;
1376   end;
1377
1378   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1379     constructor Create; override;
1380   end;
1381
1382   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1383     constructor Create; override;
1384   end;
1385
1386   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1387     constructor Create; override;
1388   end;
1389
1390   TfdR3G3B2 = class(TfdUniversal_UB1)
1391     constructor Create; override;
1392   end;
1393
1394   TfdRGB4 = class(TfdUniversal_US1)
1395     constructor Create; override;
1396   end;
1397
1398   TfdR5G6B5 = class(TfdUniversal_US1)
1399     constructor Create; override;
1400   end;
1401
1402   TfdRGB5 = class(TfdUniversal_US1)
1403     constructor Create; override;
1404   end;
1405
1406   TfdRGB8 = class(TfdRGB_UB3)
1407     constructor Create; override;
1408   end;
1409
1410   TfdRGB10 = class(TfdUniversal_UI1)
1411     constructor Create; override;
1412   end;
1413
1414   TfdRGB12 = class(TfdRGB_US3)
1415     constructor Create; override;
1416   end;
1417
1418   TfdRGB16 = class(TfdRGB_US3)
1419     constructor Create; override;
1420   end;
1421
1422   TfdRGBA2 = class(TfdRGBA_UB4)
1423     constructor Create; override;
1424   end;
1425
1426   TfdRGBA4 = class(TfdUniversal_US1)
1427     constructor Create; override;
1428   end;
1429
1430   TfdRGB5A1 = class(TfdUniversal_US1)
1431     constructor Create; override;
1432   end;
1433
1434   TfdRGBA8 = class(TfdRGBA_UB4)
1435     constructor Create; override;
1436   end;
1437
1438   TfdRGB10A2 = class(TfdUniversal_UI1)
1439     constructor Create; override;
1440   end;
1441
1442   TfdRGBA12 = class(TfdRGBA_US4)
1443     constructor Create; override;
1444   end;
1445
1446   TfdRGBA16 = class(TfdRGBA_US4)
1447     constructor Create; override;
1448   end;
1449
1450   TfdBGR4 = class(TfdUniversal_US1)
1451     constructor Create; override;
1452   end;
1453
1454   TfdB5G6R5 = class(TfdUniversal_US1)
1455     constructor Create; override;
1456   end;
1457
1458   TfdBGR5 = class(TfdUniversal_US1)
1459     constructor Create; override;
1460   end;
1461
1462   TfdBGR8 = class(TfdBGR_UB3)
1463     constructor Create; override;
1464   end;
1465
1466   TfdBGR10 = class(TfdUniversal_UI1)
1467     constructor Create; override;
1468   end;
1469
1470   TfdBGR12 = class(TfdBGR_US3)
1471     constructor Create; override;
1472   end;
1473
1474   TfdBGR16 = class(TfdBGR_US3)
1475     constructor Create; override;
1476   end;
1477
1478   TfdBGRA2 = class(TfdBGRA_UB4)
1479     constructor Create; override;
1480   end;
1481
1482   TfdBGRA4 = class(TfdUniversal_US1)
1483     constructor Create; override;
1484   end;
1485
1486   TfdBGR5A1 = class(TfdUniversal_US1)
1487     constructor Create; override;
1488   end;
1489
1490   TfdBGRA8 = class(TfdBGRA_UB4)
1491     constructor Create; override;
1492   end;
1493
1494   TfdBGR10A2 = class(TfdUniversal_UI1)
1495     constructor Create; override;
1496   end;
1497
1498   TfdBGRA12 = class(TfdBGRA_US4)
1499     constructor Create; override;
1500   end;
1501
1502   TfdBGRA16 = class(TfdBGRA_US4)
1503     constructor Create; override;
1504   end;
1505
1506   TfdDepth16 = class(TfdDepth_US1)
1507     constructor Create; override;
1508   end;
1509
1510   TfdDepth24 = class(TfdDepth_UI1)
1511     constructor Create; override;
1512   end;
1513
1514   TfdDepth32 = class(TfdDepth_UI1)
1515     constructor Create; override;
1516   end;
1517
1518   TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1519     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1520     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1521     constructor Create; override;
1522   end;
1523
1524   TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1525     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1526     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1527     constructor Create; override;
1528   end;
1529
1530   TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1531     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1532     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1533     constructor Create; override;
1534   end;
1535
1536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1537   TbmpBitfieldFormat = class(TFormatDescriptor)
1538   private
1539     procedure SetRedMask  (const aValue: QWord);
1540     procedure SetGreenMask(const aValue: QWord);
1541     procedure SetBlueMask (const aValue: QWord);
1542     procedure SetAlphaMask(const aValue: QWord);
1543
1544     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1545   public
1546     property RedMask:   QWord read GetRedMask   write SetRedMask;
1547     property GreenMask: QWord read GetGreenMask write SetGreenMask;
1548     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;
1549     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1550
1551     property PixelSize: Single read fPixelSize write fPixelSize;
1552
1553     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1554     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1555   end;
1556
1557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1558   TbmpColorTableEnty = packed record
1559     b, g, r, a: Byte;
1560   end;
1561   TbmpColorTable = array of TbmpColorTableEnty;
1562   TbmpColorTableFormat = class(TFormatDescriptor)
1563   private
1564     fColorTable: TbmpColorTable;
1565   public
1566     property PixelSize:  Single            read fPixelSize  write fPixelSize;
1567     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;
1568     property Range:      TglBitmapColorRec read fRange      write fRange;
1569     property Shift:      TShiftRec         read fShift      write fShift;
1570     property Format:     TglBitmapFormat   read fFormat     write fFormat;
1571
1572     procedure CreateColorTable;
1573
1574     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1575     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1576     destructor Destroy; override;
1577   end;
1578
1579 const
1580   LUMINANCE_WEIGHT_R = 0.30;
1581   LUMINANCE_WEIGHT_G = 0.59;
1582   LUMINANCE_WEIGHT_B = 0.11;
1583
1584   ALPHA_WEIGHT_R = 0.30;
1585   ALPHA_WEIGHT_G = 0.59;
1586   ALPHA_WEIGHT_B = 0.11;
1587
1588   DEPTH_WEIGHT_R = 0.333333333;
1589   DEPTH_WEIGHT_G = 0.333333333;
1590   DEPTH_WEIGHT_B = 0.333333333;
1591
1592   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1593
1594   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1595     TfdEmpty,
1596
1597     TfdAlpha4,
1598     TfdAlpha8,
1599     TfdAlpha12,
1600     TfdAlpha16,
1601
1602     TfdLuminance4,
1603     TfdLuminance8,
1604     TfdLuminance12,
1605     TfdLuminance16,
1606
1607     TfdLuminance4Alpha4,
1608     TfdLuminance6Alpha2,
1609     TfdLuminance8Alpha8,
1610     TfdLuminance12Alpha4,
1611     TfdLuminance12Alpha12,
1612     TfdLuminance16Alpha16,
1613
1614     TfdR3G3B2,
1615     TfdRGB4,
1616     TfdR5G6B5,
1617     TfdRGB5,
1618     TfdRGB8,
1619     TfdRGB10,
1620     TfdRGB12,
1621     TfdRGB16,
1622
1623     TfdRGBA2,
1624     TfdRGBA4,
1625     TfdRGB5A1,
1626     TfdRGBA8,
1627     TfdRGB10A2,
1628     TfdRGBA12,
1629     TfdRGBA16,
1630
1631     TfdBGR4,
1632     TfdB5G6R5,
1633     TfdBGR5,
1634     TfdBGR8,
1635     TfdBGR10,
1636     TfdBGR12,
1637     TfdBGR16,
1638
1639     TfdBGRA2,
1640     TfdBGRA4,
1641     TfdBGR5A1,
1642     TfdBGRA8,
1643     TfdBGR10A2,
1644     TfdBGRA12,
1645     TfdBGRA16,
1646
1647     TfdDepth16,
1648     TfdDepth24,
1649     TfdDepth32,
1650
1651     TfdS3tcDtx1RGBA,
1652     TfdS3tcDtx3RGBA,
1653     TfdS3tcDtx5RGBA
1654   );
1655
1656 var
1657   FormatDescriptorCS: TCriticalSection;
1658   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1659
1660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1661 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1662 begin
1663   inherited Create(GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1664 end;
1665
1666 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1667 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1668 begin
1669   result.Fields := [];
1670
1671   if X >= 0 then
1672     result.Fields := result.Fields + [ffX];
1673   if Y >= 0 then
1674     result.Fields := result.Fields + [ffY];
1675
1676   result.X := Max(0, X);
1677   result.Y := Max(0, Y);
1678 end;
1679
1680 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1681 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1682 begin
1683   result.r := r;
1684   result.g := g;
1685   result.b := b;
1686   result.a := a;
1687 end;
1688
1689 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1690 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1691 var
1692   i: Integer;
1693 begin
1694   result := false;
1695   for i := 0 to high(r1.arr) do
1696     if (r1.arr[i] <> r2.arr[i]) then
1697       exit;
1698   result := true;
1699 end;
1700
1701 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1702 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1703 begin
1704   result.r := r;
1705   result.g := g;
1706   result.b := b;
1707   result.a := a;
1708 end;
1709
1710 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1711 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1712 begin
1713   result := [];
1714
1715   if (aFormat in [
1716         //4 bbp
1717         tfLuminance4,
1718
1719         //8bpp
1720         tfR3G3B2, tfLuminance8,
1721
1722         //16bpp
1723         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1724         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1725
1726         //24bpp
1727         tfBGR8, tfRGB8,
1728
1729         //32bpp
1730         tfRGB10, tfRGB10A2, tfRGBA8,
1731         tfBGR10, tfBGR10A2, tfBGRA8]) then
1732     result := result + [ftBMP];
1733
1734   if (aFormat in [
1735         //8 bpp
1736         tfLuminance8, tfAlpha8,
1737
1738         //16 bpp
1739         tfLuminance16, tfLuminance8Alpha8,
1740         tfRGB5, tfRGB5A1, tfRGBA4,
1741         tfBGR5, tfBGR5A1, tfBGRA4,
1742
1743         //24 bpp
1744         tfRGB8, tfBGR8,
1745
1746         //32 bpp
1747         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1748     result := result + [ftTGA];
1749
1750   if (aFormat in [
1751         //8 bpp
1752         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1753         tfR3G3B2, tfRGBA2, tfBGRA2,
1754
1755         //16 bpp
1756         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1757         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1758         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1759
1760         //24 bpp
1761         tfRGB8, tfBGR8,
1762
1763         //32 bbp
1764         tfLuminance16Alpha16,
1765         tfRGBA8, tfRGB10A2,
1766         tfBGRA8, tfBGR10A2,
1767
1768         //compressed
1769         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1770     result := result + [ftDDS];
1771
1772   {$IFDEF GLB_SUPPORT_PNG_WRITE}
1773   if aFormat in [
1774       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1775       tfRGB8, tfRGBA8,
1776       tfBGR8, tfBGRA8] then
1777     result := result + [ftPNG];
1778   {$ENDIF}
1779
1780   {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1781   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1782     result := result + [ftJPEG];
1783   {$ENDIF}
1784 end;
1785
1786 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1787 function IsPowerOfTwo(aNumber: Integer): Boolean;
1788 begin
1789   while (aNumber and 1) = 0 do
1790     aNumber := aNumber shr 1;
1791   result := aNumber = 1;
1792 end;
1793
1794 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1795 function GetTopMostBit(aBitSet: QWord): Integer;
1796 begin
1797   result := 0;
1798   while aBitSet > 0 do begin
1799     inc(result);
1800     aBitSet := aBitSet shr 1;
1801   end;
1802 end;
1803
1804 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1805 function CountSetBits(aBitSet: QWord): Integer;
1806 begin
1807   result := 0;
1808   while aBitSet > 0 do begin
1809     if (aBitSet and 1) = 1 then
1810       inc(result);
1811     aBitSet := aBitSet shr 1;
1812   end;
1813 end;
1814
1815 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1816 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1817 begin
1818   result := Trunc(
1819     LUMINANCE_WEIGHT_R * aPixel.Data.r +
1820     LUMINANCE_WEIGHT_G * aPixel.Data.g +
1821     LUMINANCE_WEIGHT_B * aPixel.Data.b);
1822 end;
1823
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1826 begin
1827   result := Trunc(
1828     DEPTH_WEIGHT_R * aPixel.Data.r +
1829     DEPTH_WEIGHT_G * aPixel.Data.g +
1830     DEPTH_WEIGHT_B * aPixel.Data.b);
1831 end;
1832
1833 {$IFDEF GLB_NATIVE_OGL}
1834 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1835 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1836 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1837 var
1838   GL_LibHandle: Pointer = nil;
1839
1840 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1841 begin
1842   result :=  nil;
1843
1844   if not Assigned(aLibHandle) then
1845     aLibHandle := GL_LibHandle;
1846
1847 {$IF DEFINED(GLB_WIN)}
1848   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1849   if Assigned(result) then
1850     exit;
1851
1852   if Assigned(wglGetProcAddress) then
1853     result := wglGetProcAddress(aProcName);
1854 {$ELSEIF DEFINED(GLB_LINUX)}
1855   if Assigned(glXGetProcAddress) then begin
1856     result := glXGetProcAddress(aProcName);
1857     if Assigned(result) then
1858       exit;
1859   end;
1860
1861   if Assigned(glXGetProcAddressARB) then begin
1862     result := glXGetProcAddressARB(aProcName);
1863     if Assigned(result) then
1864       exit;
1865   end;
1866
1867   result := dlsym(aLibHandle, aProcName);
1868 {$ENDIF}
1869   if not Assigned(result) then
1870     raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1871 end;
1872
1873 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1874 var
1875   GLU_LibHandle: Pointer = nil;
1876   OpenGLInitialized: Boolean;
1877   InitOpenGLCS: TCriticalSection;
1878
1879 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1880 procedure glbInitOpenGL;
1881
1882   ////////////////////////////////////////////////////////////////////////////////
1883   function glbLoadLibrary(const aName: PChar): Pointer;
1884   begin
1885     {$IF DEFINED(GLB_WIN)}
1886     result := {%H-}Pointer(LoadLibrary(aName));
1887     {$ELSEIF DEFINED(GLB_LINUX)}
1888     result := dlopen(Name, RTLD_LAZY);
1889     {$ELSE}
1890     result := nil;
1891     {$ENDIF}
1892   end;
1893
1894   ////////////////////////////////////////////////////////////////////////////////
1895   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1896   begin
1897     result := false;
1898     if not Assigned(aLibHandle) then
1899       exit;
1900
1901     {$IF DEFINED(GLB_WIN)}
1902     Result := FreeLibrary({%H-}HINST(aLibHandle));
1903     {$ELSEIF DEFINED(GLB_LINUX)}
1904     Result := dlclose(aLibHandle) = 0;
1905     {$ENDIF}
1906   end;
1907
1908 begin
1909   if Assigned(GL_LibHandle) then
1910     glbFreeLibrary(GL_LibHandle);
1911
1912   if Assigned(GLU_LibHandle) then
1913     glbFreeLibrary(GLU_LibHandle);
1914
1915   GL_LibHandle := glbLoadLibrary(libopengl);
1916   if not Assigned(GL_LibHandle) then
1917     raise EglBitmapException.Create('unable to load library: ' + libopengl);
1918
1919   GLU_LibHandle := glbLoadLibrary(libglu);
1920   if not Assigned(GLU_LibHandle) then
1921     raise EglBitmapException.Create('unable to load library: ' + libglu);
1922
1923   try
1924   {$IF DEFINED(GLB_WIN)}
1925     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');
1926   {$ELSEIF DEFINED(GLB_LINUX)}
1927     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');
1928     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1929   {$ENDIF}
1930
1931     glEnable := glbGetProcAddress('glEnable');
1932     glDisable := glbGetProcAddress('glDisable');
1933     glGetString := glbGetProcAddress('glGetString');
1934     glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1935     glTexParameteri := glbGetProcAddress('glTexParameteri');
1936     glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1937     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1938     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1939     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1940     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1941     glGenTextures := glbGetProcAddress('glGenTextures');
1942     glBindTexture := glbGetProcAddress('glBindTexture');
1943     glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1944     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1945     glReadPixels := glbGetProcAddress('glReadPixels');
1946     glPixelStorei := glbGetProcAddress('glPixelStorei');
1947     glTexImage1D := glbGetProcAddress('glTexImage1D');
1948     glTexImage2D := glbGetProcAddress('glTexImage2D');
1949     glGetTexImage := glbGetProcAddress('glGetTexImage');
1950
1951     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1952     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1953   finally
1954     glbFreeLibrary(GL_LibHandle);
1955     glbFreeLibrary(GLU_LibHandle);
1956   end;
1957 end;
1958 {$ENDIF}
1959
1960 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1961 procedure glbReadOpenGLExtensions;
1962 var
1963   {$IFDEF GLB_DELPHI}
1964   Context: HGLRC;
1965   {$ENDIF}
1966   Buffer: AnsiString;
1967   MajorVersion, MinorVersion: Integer;
1968
1969   ///////////////////////////////////////////////////////////////////////////////////////////
1970   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1971   var
1972     Separator: Integer;
1973   begin
1974     aMinor := 0;
1975     aMajor := 0;
1976
1977     Separator := Pos(AnsiString('.'), aBuffer);
1978     if (Separator > 1) and (Separator < Length(aBuffer)) and
1979        (aBuffer[Separator - 1] in ['0'..'9']) and
1980        (aBuffer[Separator + 1] in ['0'..'9']) then begin
1981
1982       Dec(Separator);
1983       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1984         Dec(Separator);
1985
1986       Delete(aBuffer, 1, Separator);
1987       Separator := Pos(AnsiString('.'), aBuffer) + 1;
1988
1989       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1990         Inc(Separator);
1991
1992       Delete(aBuffer, Separator, 255);
1993       Separator := Pos(AnsiString('.'), aBuffer);
1994
1995       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1996       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
1997     end;
1998   end;
1999
2000   ///////////////////////////////////////////////////////////////////////////////////////////
2001   function CheckExtension(const Extension: AnsiString): Boolean;
2002   var
2003     ExtPos: Integer;
2004   begin
2005     ExtPos := Pos(Extension, Buffer);
2006     result := ExtPos > 0;
2007     if result then
2008       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2009   end;
2010
2011 begin
2012 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2013   InitOpenGLCS.Enter;
2014   try
2015     if not OpenGLInitialized then begin
2016       glbInitOpenGL;
2017       OpenGLInitialized := true;
2018     end;
2019   finally
2020     InitOpenGLCS.Leave;
2021   end;
2022 {$ENDIF}
2023
2024 {$IFDEF GLB_DELPHI}
2025   Context := wglGetCurrentContext;
2026   if (Context <> gLastContext) then begin
2027     gLastContext := Context;
2028 {$ENDIF}
2029
2030     // Version
2031     Buffer := glGetString(GL_VERSION);
2032     TrimVersionString(Buffer, MajorVersion, MinorVersion);
2033
2034     GL_VERSION_1_2 := false;
2035     GL_VERSION_1_3 := false;
2036     GL_VERSION_1_4 := false;
2037     GL_VERSION_2_0 := false;
2038     if MajorVersion = 1 then begin
2039       if MinorVersion >= 2 then
2040         GL_VERSION_1_2 := true;
2041
2042       if MinorVersion >= 3 then
2043         GL_VERSION_1_3 := true;
2044
2045       if MinorVersion >= 4 then
2046         GL_VERSION_1_4 := true;
2047     end else if MajorVersion >= 2 then begin
2048       GL_VERSION_1_2 := true;
2049       GL_VERSION_1_3 := true;
2050       GL_VERSION_1_4 := true;
2051       GL_VERSION_2_0 := true;
2052     end;
2053
2054     // Extensions
2055     Buffer := glGetString(GL_EXTENSIONS);
2056     GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');
2057     GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');
2058     GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');
2059     GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');
2060     GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');
2061     GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2062     GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');
2063     GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');
2064     GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');
2065     GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');
2066
2067     if GL_VERSION_1_3 then begin
2068       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');
2069       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');
2070       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2071     end else begin
2072       glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');
2073       glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');
2074       glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2075     end;
2076 {$IFDEF GLB_DELPHI}
2077   end;
2078 {$ENDIF}
2079 end;
2080 {$ENDIF}
2081
2082 (* TODO GLB_DELPHI
2083 {$IFDEF GLB_DELPHI}
2084 function CreateGrayPalette: HPALETTE;
2085 var
2086   Idx: Integer;
2087   Pal: PLogPalette;
2088 begin
2089   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2090
2091   Pal.palVersion := $300;
2092   Pal.palNumEntries := 256;
2093
2094   {$IFOPT R+}
2095     {$DEFINE GLB_TEMPRANGECHECK}
2096     {$R-}
2097   {$ENDIF}
2098
2099   for Idx := 0 to 256 - 1 do begin
2100     Pal.palPalEntry[Idx].peRed   := Idx;
2101     Pal.palPalEntry[Idx].peGreen := Idx;
2102     Pal.palPalEntry[Idx].peBlue  := Idx;
2103     Pal.palPalEntry[Idx].peFlags := 0;
2104   end;
2105
2106   {$IFDEF GLB_TEMPRANGECHECK}
2107     {$UNDEF GLB_TEMPRANGECHECK}
2108     {$R+}
2109   {$ENDIF}
2110
2111   result := CreatePalette(Pal^);
2112
2113   FreeMem(Pal);
2114 end;
2115 {$ENDIF}
2116 *)
2117
2118 {$IFDEF GLB_SDL_IMAGE}
2119 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2120 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2121 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2122 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2123 begin
2124   result := TStream(context^.unknown.data1).Seek(offset, whence);
2125 end;
2126
2127 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2128 begin
2129   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2130 end;
2131
2132 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2133 begin
2134   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2135 end;
2136
2137 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2138 begin
2139   result := 0;
2140 end;
2141
2142 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2143 begin
2144   result := SDL_AllocRW;
2145
2146   if result = nil then
2147     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2148
2149   result^.seek := glBitmapRWseek;
2150   result^.read := glBitmapRWread;
2151   result^.write := glBitmapRWwrite;
2152   result^.close := glBitmapRWclose;
2153   result^.unknown.data1 := Stream;
2154 end;
2155 {$ENDIF}
2156
2157 (* TODO LoadFuncs
2158 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2159 var
2160   glBitmap: TglBitmap2D;
2161 begin
2162   result := false;
2163   Texture := 0;
2164
2165   {$IFDEF GLB_DELPHI}
2166   if Instance = 0 then
2167     Instance := HInstance;
2168
2169   if (LoadFromRes) then
2170     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2171   else
2172   {$ENDIF}
2173     glBitmap := TglBitmap2D.Create(FileName);
2174
2175   try
2176     glBitmap.DeleteTextureOnFree := false;
2177     glBitmap.FreeDataAfterGenTexture := false;
2178     glBitmap.GenTexture(true);
2179     if (glBitmap.ID > 0) then begin
2180       Texture := glBitmap.ID;
2181       result := true;
2182     end;
2183   finally
2184     glBitmap.Free;
2185   end;
2186 end;
2187
2188 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2189 var
2190   CM: TglBitmapCubeMap;
2191 begin
2192   Texture := 0;
2193
2194   {$IFDEF GLB_DELPHI}
2195   if Instance = 0 then
2196     Instance := HInstance;
2197   {$ENDIF}
2198
2199   CM := TglBitmapCubeMap.Create;
2200   try
2201     CM.DeleteTextureOnFree := false;
2202
2203     // Maps
2204     {$IFDEF GLB_DELPHI}
2205     if (LoadFromRes) then
2206       CM.LoadFromResource(Instance, PositiveX)
2207     else
2208     {$ENDIF}
2209       CM.LoadFromFile(PositiveX);
2210     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2211
2212     {$IFDEF GLB_DELPHI}
2213     if (LoadFromRes) then
2214       CM.LoadFromResource(Instance, NegativeX)
2215     else
2216     {$ENDIF}
2217       CM.LoadFromFile(NegativeX);
2218     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2219
2220     {$IFDEF GLB_DELPHI}
2221     if (LoadFromRes) then
2222       CM.LoadFromResource(Instance, PositiveY)
2223     else
2224     {$ENDIF}
2225       CM.LoadFromFile(PositiveY);
2226     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2227
2228     {$IFDEF GLB_DELPHI}
2229     if (LoadFromRes) then
2230       CM.LoadFromResource(Instance, NegativeY)
2231     else
2232     {$ENDIF}
2233       CM.LoadFromFile(NegativeY);
2234     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2235
2236     {$IFDEF GLB_DELPHI}
2237     if (LoadFromRes) then
2238       CM.LoadFromResource(Instance, PositiveZ)
2239     else
2240     {$ENDIF}
2241       CM.LoadFromFile(PositiveZ);
2242     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2243
2244     {$IFDEF GLB_DELPHI}
2245     if (LoadFromRes) then
2246       CM.LoadFromResource(Instance, NegativeZ)
2247     else
2248     {$ENDIF}
2249       CM.LoadFromFile(NegativeZ);
2250     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2251
2252     Texture := CM.ID;
2253     result := true;
2254   finally
2255     CM.Free;
2256   end;
2257 end;
2258
2259 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2260 var
2261   NM: TglBitmapNormalMap;
2262 begin
2263   Texture := 0;
2264
2265   NM := TglBitmapNormalMap.Create;
2266   try
2267     NM.DeleteTextureOnFree := false;
2268     NM.GenerateNormalMap(Size);
2269
2270     Texture := NM.ID;
2271     result := true;
2272   finally
2273     NM.Free;
2274   end;
2275 end;
2276 *)
2277
2278 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2279 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2280 begin
2281   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2282 end;
2283
2284 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2285 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2286 begin
2287   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2288 end;
2289
2290 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2291 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2292 begin
2293   glBitmapDefaultMipmap := aValue;
2294 end;
2295
2296 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2297 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2298 begin
2299   glBitmapDefaultFormat := aFormat;
2300 end;
2301
2302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2303 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2304 begin
2305   glBitmapDefaultFilterMin := aMin;
2306   glBitmapDefaultFilterMag := aMag;
2307 end;
2308
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2311 begin
2312   glBitmapDefaultWrapS := S;
2313   glBitmapDefaultWrapT := T;
2314   glBitmapDefaultWrapR := R;
2315 end;
2316
2317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2318 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2319 begin
2320   result := glBitmapDefaultDeleteTextureOnFree;
2321 end;
2322
2323 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2324 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2325 begin
2326   result := glBitmapDefaultFreeDataAfterGenTextures;
2327 end;
2328
2329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2330 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2331 begin
2332   result := glBitmapDefaultMipmap;
2333 end;
2334
2335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2336 function glBitmapGetDefaultFormat: TglBitmapFormat;
2337 begin
2338   result := glBitmapDefaultFormat;
2339 end;
2340
2341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2342 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2343 begin
2344   aMin := glBitmapDefaultFilterMin;
2345   aMag := glBitmapDefaultFilterMag;
2346 end;
2347
2348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2349 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2350 begin
2351   S := glBitmapDefaultWrapS;
2352   T := glBitmapDefaultWrapT;
2353   R := glBitmapDefaultWrapR;
2354 end;
2355
2356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2357 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2359 function TFormatDescriptor.GetRedMask: QWord;
2360 begin
2361   result := fRange.r shl fShift.r;
2362 end;
2363
2364 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2365 function TFormatDescriptor.GetGreenMask: QWord;
2366 begin
2367   result := fRange.g shl fShift.g;
2368 end;
2369
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 function TFormatDescriptor.GetBlueMask: QWord;
2372 begin
2373   result := fRange.b shl fShift.b;
2374 end;
2375
2376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2377 function TFormatDescriptor.GetAlphaMask: QWord;
2378 begin
2379   result := fRange.a shl fShift.a;
2380 end;
2381
2382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2383 function TFormatDescriptor.GetComponents: Integer;
2384 var
2385   i: Integer;
2386 begin
2387   result := 0;
2388   for i := 0 to 3 do
2389     if (fRange.arr[i] > 0) then
2390       inc(result);
2391 end;
2392
2393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2394 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2395 var
2396   w, h: Integer;
2397 begin
2398   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2399     w := Max(1, aSize.X);
2400     h := Max(1, aSize.Y);
2401     result := GetSize(w, h);
2402   end else
2403     result := 0;
2404 end;
2405
2406 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2407 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2408 begin
2409   result := 0;
2410   if (aWidth <= 0) or (aHeight <= 0) then
2411     exit;
2412   result := Ceil(aWidth * aHeight * fPixelSize);
2413 end;
2414
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 function TFormatDescriptor.CreateMappingData: Pointer;
2417 begin
2418   result := nil;
2419 end;
2420
2421 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2422 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2423 begin
2424   //DUMMY
2425 end;
2426
2427 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2428 function TFormatDescriptor.IsEmpty: Boolean;
2429 begin
2430   result := (fFormat = tfEmpty);
2431 end;
2432
2433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2434 function TFormatDescriptor.HasAlpha: Boolean;
2435 begin
2436   result := (fRange.a > 0);
2437 end;
2438
2439 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2440 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2441 begin
2442   result := false;
2443
2444   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2445     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2446
2447   if (aRedMask   <> RedMask) then
2448     exit;
2449   if (aGreenMask <> GreenMask) then
2450     exit;
2451   if (aBlueMask  <> BlueMask) then
2452     exit;
2453   if (aAlphaMask <> AlphaMask) then
2454     exit;
2455   result := true;
2456 end;
2457
2458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2459 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2460 begin
2461   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2462   aPixel.Data   := fRange;
2463   aPixel.Range  := fRange;
2464   aPixel.Format := fFormat;
2465 end;
2466
2467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2468 constructor TFormatDescriptor.Create;
2469 begin
2470   inherited Create;
2471
2472   fFormat       := tfEmpty;
2473   fWithAlpha    := tfEmpty;
2474   fWithoutAlpha := tfEmpty;
2475   fRGBInverted  := tfEmpty;
2476   fUncompressed := tfEmpty;
2477   fPixelSize    := 0.0;
2478   fIsCompressed := false;
2479
2480   fglFormat         := 0;
2481   fglInternalFormat := 0;
2482   fglDataFormat     := 0;
2483
2484   FillChar(fRange, 0, SizeOf(fRange));
2485   FillChar(fShift, 0, SizeOf(fShift));
2486 end;
2487
2488 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2489 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2490 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2491 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2492 begin
2493   aData^ := aPixel.Data.a;
2494   inc(aData);
2495 end;
2496
2497 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2498 begin
2499   aPixel.Data.r := 0;
2500   aPixel.Data.g := 0;
2501   aPixel.Data.b := 0;
2502   aPixel.Data.a := aData^;
2503   inc(aData^);
2504 end;
2505
2506 constructor TfdAlpha_UB1.Create;
2507 begin
2508   inherited Create;
2509   fPixelSize        := 1.0;
2510   fRange.a          := $FF;
2511   fglFormat         := GL_ALPHA;
2512   fglDataFormat     := GL_UNSIGNED_BYTE;
2513 end;
2514
2515 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2516 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2517 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2518 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2519 begin
2520   aData^ := LuminanceWeight(aPixel);
2521   inc(aData);
2522 end;
2523
2524 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2525 begin
2526   aPixel.Data.r := aData^;
2527   aPixel.Data.g := aData^;
2528   aPixel.Data.b := aData^;
2529   aPixel.Data.a := 0;
2530   inc(aData);
2531 end;
2532
2533 constructor TfdLuminance_UB1.Create;
2534 begin
2535   inherited Create;
2536   fPixelSize        := 1.0;
2537   fRange.r          := $FF;
2538   fRange.g          := $FF;
2539   fRange.b          := $FF;
2540   fglFormat         := GL_LUMINANCE;
2541   fglDataFormat     := GL_UNSIGNED_BYTE;
2542 end;
2543
2544 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2545 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2546 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2547 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2548 var
2549   i: Integer;
2550 begin
2551   aData^ := 0;
2552   for i := 0 to 3 do
2553     if (fRange.arr[i] > 0) then
2554       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2555   inc(aData);
2556 end;
2557
2558 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2559 var
2560   i: Integer;
2561 begin
2562   for i := 0 to 3 do
2563     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2564   inc(aData);
2565 end;
2566
2567 constructor TfdUniversal_UB1.Create;
2568 begin
2569   inherited Create;
2570   fPixelSize := 1.0;
2571 end;
2572
2573 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2574 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2575 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2576 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2577 begin
2578   inherited Map(aPixel, aData, aMapData);
2579   aData^ := aPixel.Data.a;
2580   inc(aData);
2581 end;
2582
2583 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2584 begin
2585   inherited Unmap(aData, aPixel, aMapData);
2586   aPixel.Data.a := aData^;
2587   inc(aData);
2588 end;
2589
2590 constructor TfdLuminanceAlpha_UB2.Create;
2591 begin
2592   inherited Create;
2593   fPixelSize        := 2.0;
2594   fRange.a          := $FF;
2595   fShift.a          :=   8;
2596   fglFormat         := GL_LUMINANCE_ALPHA;
2597   fglDataFormat     := GL_UNSIGNED_BYTE;
2598 end;
2599
2600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2601 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2603 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2604 begin
2605   aData^ := aPixel.Data.r;
2606   inc(aData);
2607   aData^ := aPixel.Data.g;
2608   inc(aData);
2609   aData^ := aPixel.Data.b;
2610   inc(aData);
2611 end;
2612
2613 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2614 begin
2615   aPixel.Data.r := aData^;
2616   inc(aData);
2617   aPixel.Data.g := aData^;
2618   inc(aData);
2619   aPixel.Data.b := aData^;
2620   inc(aData);
2621   aPixel.Data.a := 0;
2622 end;
2623
2624 constructor TfdRGB_UB3.Create;
2625 begin
2626   inherited Create;
2627   fPixelSize        := 3.0;
2628   fRange.r          := $FF;
2629   fRange.g          := $FF;
2630   fRange.b          := $FF;
2631   fShift.r          :=   0;
2632   fShift.g          :=   8;
2633   fShift.b          :=  16;
2634   fglFormat         := GL_RGB;
2635   fglDataFormat     := GL_UNSIGNED_BYTE;
2636 end;
2637
2638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2641 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2642 begin
2643   aData^ := aPixel.Data.b;
2644   inc(aData);
2645   aData^ := aPixel.Data.g;
2646   inc(aData);
2647   aData^ := aPixel.Data.r;
2648   inc(aData);
2649 end;
2650
2651 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2652 begin
2653   aPixel.Data.b := aData^;
2654   inc(aData);
2655   aPixel.Data.g := aData^;
2656   inc(aData);
2657   aPixel.Data.r := aData^;
2658   inc(aData);
2659   aPixel.Data.a := 0;
2660 end;
2661
2662 constructor TfdBGR_UB3.Create;
2663 begin
2664   fPixelSize        := 3.0;
2665   fRange.r          := $FF;
2666   fRange.g          := $FF;
2667   fRange.b          := $FF;
2668   fShift.r          :=  16;
2669   fShift.g          :=   8;
2670   fShift.b          :=   0;
2671   fglFormat         := GL_BGR;
2672   fglDataFormat     := GL_UNSIGNED_BYTE;
2673 end;
2674
2675 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2676 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2678 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2679 begin
2680   inherited Map(aPixel, aData, aMapData);
2681   aData^ := aPixel.Data.a;
2682   inc(aData);
2683 end;
2684
2685 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2686 begin
2687   inherited Unmap(aData, aPixel, aMapData);
2688   aPixel.Data.a := aData^;
2689   inc(aData);
2690 end;
2691
2692 constructor TfdRGBA_UB4.Create;
2693 begin
2694   inherited Create;
2695   fPixelSize        := 4.0;
2696   fRange.a          := $FF;
2697   fShift.a          :=  24;
2698   fglFormat         := GL_RGBA;
2699   fglDataFormat     := GL_UNSIGNED_BYTE;
2700 end;
2701
2702 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2703 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2704 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2705 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2706 begin
2707   inherited Map(aPixel, aData, aMapData);
2708   aData^ := aPixel.Data.a;
2709   inc(aData);
2710 end;
2711
2712 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2713 begin
2714   inherited Unmap(aData, aPixel, aMapData);
2715   aPixel.Data.a := aData^;
2716   inc(aData);
2717 end;
2718
2719 constructor TfdBGRA_UB4.Create;
2720 begin
2721   inherited Create;
2722   fPixelSize        := 4.0;
2723   fRange.a          := $FF;
2724   fShift.a          :=  24;
2725   fglFormat         := GL_BGRA;
2726   fglDataFormat     := GL_UNSIGNED_BYTE;
2727 end;
2728
2729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2730 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2732 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2733 begin
2734   PWord(aData)^ := aPixel.Data.a;
2735   inc(aData, 2);
2736 end;
2737
2738 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2739 begin
2740   aPixel.Data.r := 0;
2741   aPixel.Data.g := 0;
2742   aPixel.Data.b := 0;
2743   aPixel.Data.a := PWord(aData)^;
2744   inc(aData, 2);
2745 end;
2746
2747 constructor TfdAlpha_US1.Create;
2748 begin
2749   inherited Create;
2750   fPixelSize        := 2.0;
2751   fRange.a          := $FFFF;
2752   fglFormat         := GL_ALPHA;
2753   fglDataFormat     := GL_UNSIGNED_SHORT;
2754 end;
2755
2756 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2757 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2758 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2759 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2760 begin
2761   PWord(aData)^ := LuminanceWeight(aPixel);
2762   inc(aData, 2);
2763 end;
2764
2765 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2766 begin
2767   aPixel.Data.r := PWord(aData)^;
2768   aPixel.Data.g := PWord(aData)^;
2769   aPixel.Data.b := PWord(aData)^;
2770   aPixel.Data.a := 0;
2771   inc(aData, 2);
2772 end;
2773
2774 constructor TfdLuminance_US1.Create;
2775 begin
2776   inherited Create;
2777   fPixelSize        := 2.0;
2778   fRange.r          := $FFFF;
2779   fRange.g          := $FFFF;
2780   fRange.b          := $FFFF;
2781   fglFormat         := GL_LUMINANCE;
2782   fglDataFormat     := GL_UNSIGNED_SHORT;
2783 end;
2784
2785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2786 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2788 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2789 var
2790   i: Integer;
2791 begin
2792   PWord(aData)^ := 0;
2793   for i := 0 to 3 do
2794     if (fRange.arr[i] > 0) then
2795       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2796   inc(aData, 2);
2797 end;
2798
2799 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2800 var
2801   i: Integer;
2802 begin
2803   for i := 0 to 3 do
2804     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2805   inc(aData, 2);
2806 end;
2807
2808 constructor TfdUniversal_US1.Create;
2809 begin
2810   inherited Create;
2811   fPixelSize := 2.0;
2812 end;
2813
2814 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2815 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2816 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2817 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2818 begin
2819   PWord(aData)^ := DepthWeight(aPixel);
2820   inc(aData, 2);
2821 end;
2822
2823 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2824 begin
2825   aPixel.Data.r := PWord(aData)^;
2826   aPixel.Data.g := PWord(aData)^;
2827   aPixel.Data.b := PWord(aData)^;
2828   aPixel.Data.a := 0;
2829   inc(aData, 2);
2830 end;
2831
2832 constructor TfdDepth_US1.Create;
2833 begin
2834   inherited Create;
2835   fPixelSize        := 2.0;
2836   fRange.r          := $FFFF;
2837   fRange.g          := $FFFF;
2838   fRange.b          := $FFFF;
2839   fglFormat         := GL_DEPTH_COMPONENT;
2840   fglDataFormat     := GL_UNSIGNED_SHORT;
2841 end;
2842
2843 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2844 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2845 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2846 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2847 begin
2848   inherited Map(aPixel, aData, aMapData);
2849   PWord(aData)^ := aPixel.Data.a;
2850   inc(aData, 2);
2851 end;
2852
2853 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2854 begin
2855   inherited Unmap(aData, aPixel, aMapData);
2856   aPixel.Data.a := PWord(aData)^;
2857   inc(aData, 2);
2858 end;
2859
2860 constructor TfdLuminanceAlpha_US2.Create;
2861 begin
2862   inherited Create;
2863   fPixelSize        :=   4.0;
2864   fRange.a          := $FFFF;
2865   fShift.a          :=    16;
2866   fglFormat         := GL_LUMINANCE_ALPHA;
2867   fglDataFormat     := GL_UNSIGNED_SHORT;
2868 end;
2869
2870 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2871 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2872 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2873 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2874 begin
2875   PWord(aData)^ := aPixel.Data.r;
2876   inc(aData, 2);
2877   PWord(aData)^ := aPixel.Data.g;
2878   inc(aData, 2);
2879   PWord(aData)^ := aPixel.Data.b;
2880   inc(aData, 2);
2881 end;
2882
2883 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2884 begin
2885   aPixel.Data.r := PWord(aData)^;
2886   inc(aData, 2);
2887   aPixel.Data.g := PWord(aData)^;
2888   inc(aData, 2);
2889   aPixel.Data.b := PWord(aData)^;
2890   inc(aData, 2);
2891   aPixel.Data.a := 0;
2892 end;
2893
2894 constructor TfdRGB_US3.Create;
2895 begin
2896   inherited Create;
2897   fPixelSize        :=   6.0;
2898   fRange.r          := $FFFF;
2899   fRange.g          := $FFFF;
2900   fRange.b          := $FFFF;
2901   fShift.r          :=     0;
2902   fShift.g          :=    16;
2903   fShift.b          :=    32;
2904   fglFormat         := GL_RGB;
2905   fglDataFormat     := GL_UNSIGNED_SHORT;
2906 end;
2907
2908 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2909 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2912 begin
2913   PWord(aData)^ := aPixel.Data.b;
2914   inc(aData, 2);
2915   PWord(aData)^ := aPixel.Data.g;
2916   inc(aData, 2);
2917   PWord(aData)^ := aPixel.Data.r;
2918   inc(aData, 2);
2919 end;
2920
2921 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2922 begin
2923   aPixel.Data.b := PWord(aData)^;
2924   inc(aData, 2);
2925   aPixel.Data.g := PWord(aData)^;
2926   inc(aData, 2);
2927   aPixel.Data.r := PWord(aData)^;
2928   inc(aData, 2);
2929   aPixel.Data.a := 0;
2930 end;
2931
2932 constructor TfdBGR_US3.Create;
2933 begin
2934   inherited Create;
2935   fPixelSize        :=   6.0;
2936   fRange.r          := $FFFF;
2937   fRange.g          := $FFFF;
2938   fRange.b          := $FFFF;
2939   fShift.r          :=    32;
2940   fShift.g          :=    16;
2941   fShift.b          :=     0;
2942   fglFormat         := GL_BGR;
2943   fglDataFormat     := GL_UNSIGNED_SHORT;
2944 end;
2945
2946 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2947 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2948 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2949 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2950 begin
2951   inherited Map(aPixel, aData, aMapData);
2952   PWord(aData)^ := aPixel.Data.a;
2953   inc(aData, 2);
2954 end;
2955
2956 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2957 begin
2958   inherited Unmap(aData, aPixel, aMapData);
2959   aPixel.Data.a := PWord(aData)^;
2960   inc(aData, 2);
2961 end;
2962
2963 constructor TfdRGBA_US4.Create;
2964 begin
2965   inherited Create;
2966   fPixelSize        :=   8.0;
2967   fRange.a          := $FFFF;
2968   fShift.a          :=    48;
2969   fglFormat         := GL_RGBA;
2970   fglDataFormat     := GL_UNSIGNED_SHORT;
2971 end;
2972
2973 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2974 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2976 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2977 begin
2978   inherited Map(aPixel, aData, aMapData);
2979   PWord(aData)^ := aPixel.Data.a;
2980   inc(aData, 2);
2981 end;
2982
2983 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2984 begin
2985   inherited Unmap(aData, aPixel, aMapData);
2986   aPixel.Data.a := PWord(aData)^;
2987   inc(aData, 2);
2988 end;
2989
2990 constructor TfdBGRA_US4.Create;
2991 begin
2992   inherited Create;
2993   fPixelSize        :=   8.0;
2994   fRange.a          := $FFFF;
2995   fShift.a          :=    48;
2996   fglFormat         := GL_BGRA;
2997   fglDataFormat     := GL_UNSIGNED_SHORT;
2998 end;
2999
3000 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3001 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3003 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3004 var
3005   i: Integer;
3006 begin
3007   PCardinal(aData)^ := 0;
3008   for i := 0 to 3 do
3009     if (fRange.arr[i] > 0) then
3010       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3011   inc(aData, 4);
3012 end;
3013
3014 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3015 var
3016   i: Integer;
3017 begin
3018   for i := 0 to 3 do
3019     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3020   inc(aData, 2);
3021 end;
3022
3023 constructor TfdUniversal_UI1.Create;
3024 begin
3025   inherited Create;
3026   fPixelSize := 4.0;
3027 end;
3028
3029 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3030 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3031 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3032 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3033 begin
3034   PCardinal(aData)^ := DepthWeight(aPixel);
3035   inc(aData, 4);
3036 end;
3037
3038 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3039 begin
3040   aPixel.Data.r := PCardinal(aData)^;
3041   aPixel.Data.g := PCardinal(aData)^;
3042   aPixel.Data.b := PCardinal(aData)^;
3043   aPixel.Data.a := 0;
3044   inc(aData, 4);
3045 end;
3046
3047 constructor TfdDepth_UI1.Create;
3048 begin
3049   inherited Create;
3050   fPixelSize        := 4.0;
3051   fRange.r          := $FFFFFFFF;
3052   fRange.g          := $FFFFFFFF;
3053   fRange.b          := $FFFFFFFF;
3054   fglFormat         := GL_DEPTH_COMPONENT;
3055   fglDataFormat     := GL_UNSIGNED_INT;
3056 end;
3057
3058 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3059 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3060 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3061 constructor TfdAlpha4.Create;
3062 begin
3063   inherited Create;
3064   fFormat           := tfAlpha4;
3065   fWithAlpha        := tfAlpha4;
3066   fglInternalFormat := GL_ALPHA4;
3067 end;
3068
3069 constructor TfdAlpha8.Create;
3070 begin
3071   inherited Create;
3072   fFormat           := tfAlpha8;
3073   fWithAlpha        := tfAlpha8;
3074   fglInternalFormat := GL_ALPHA8;
3075 end;
3076
3077 constructor TfdAlpha12.Create;
3078 begin
3079   inherited Create;
3080   fFormat           := tfAlpha12;
3081   fWithAlpha        := tfAlpha12;
3082   fglInternalFormat := GL_ALPHA12;
3083 end;
3084
3085 constructor TfdAlpha16.Create;
3086 begin
3087   inherited Create;
3088   fFormat           := tfAlpha16;
3089   fWithAlpha        := tfAlpha16;
3090   fglInternalFormat := GL_ALPHA16;
3091 end;
3092
3093 constructor TfdLuminance4.Create;
3094 begin
3095   inherited Create;
3096   fFormat           := tfLuminance4;
3097   fWithAlpha        := tfLuminance4Alpha4;
3098   fWithoutAlpha     := tfLuminance4;
3099   fglInternalFormat := GL_LUMINANCE4;
3100 end;
3101
3102 constructor TfdLuminance8.Create;
3103 begin
3104   inherited Create;
3105   fFormat           := tfLuminance8;
3106   fWithAlpha        := tfLuminance8Alpha8;
3107   fWithoutAlpha     := tfLuminance8;
3108   fglInternalFormat := GL_LUMINANCE8;
3109 end;
3110
3111 constructor TfdLuminance12.Create;
3112 begin
3113   inherited Create;
3114   fFormat           := tfLuminance12;
3115   fWithAlpha        := tfLuminance12Alpha12;
3116   fWithoutAlpha     := tfLuminance12;
3117   fglInternalFormat := GL_LUMINANCE12;
3118 end;
3119
3120 constructor TfdLuminance16.Create;
3121 begin
3122   inherited Create;
3123   fFormat           := tfLuminance16;
3124   fWithAlpha        := tfLuminance16Alpha16;
3125   fWithoutAlpha     := tfLuminance16;
3126   fglInternalFormat := GL_LUMINANCE16;
3127 end;
3128
3129 constructor TfdLuminance4Alpha4.Create;
3130 begin
3131   inherited Create;
3132   fFormat           := tfLuminance4Alpha4;
3133   fWithAlpha        := tfLuminance4Alpha4;
3134   fWithoutAlpha     := tfLuminance4;
3135   fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3136 end;
3137
3138 constructor TfdLuminance6Alpha2.Create;
3139 begin
3140   inherited Create;
3141   fFormat           := tfLuminance6Alpha2;
3142   fWithAlpha        := tfLuminance6Alpha2;
3143   fWithoutAlpha     := tfLuminance8;
3144   fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3145 end;
3146
3147 constructor TfdLuminance8Alpha8.Create;
3148 begin
3149   inherited Create;
3150   fFormat           := tfLuminance8Alpha8;
3151   fWithAlpha        := tfLuminance8Alpha8;
3152   fWithoutAlpha     := tfLuminance8;
3153   fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3154 end;
3155
3156 constructor TfdLuminance12Alpha4.Create;
3157 begin
3158   inherited Create;
3159   fFormat           := tfLuminance12Alpha4;
3160   fWithAlpha        := tfLuminance12Alpha4;
3161   fWithoutAlpha     := tfLuminance12;
3162   fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3163 end;
3164
3165 constructor TfdLuminance12Alpha12.Create;
3166 begin
3167   inherited Create;
3168   fFormat           := tfLuminance12Alpha12;
3169   fWithAlpha        := tfLuminance12Alpha12;
3170   fWithoutAlpha     := tfLuminance12;
3171   fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3172 end;
3173
3174 constructor TfdLuminance16Alpha16.Create;
3175 begin
3176   inherited Create;
3177   fFormat           := tfLuminance16Alpha16;
3178   fWithAlpha        := tfLuminance16Alpha16;
3179   fWithoutAlpha     := tfLuminance16;
3180   fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3181 end;
3182
3183 constructor TfdR3G3B2.Create;
3184 begin
3185   inherited Create;
3186   fFormat           := tfR3G3B2;
3187   fWithAlpha        := tfRGBA2;
3188   fWithoutAlpha     := tfR3G3B2;
3189   fRange.r          := $7;
3190   fRange.g          := $7;
3191   fRange.b          := $3;
3192   fShift.r          :=  0;
3193   fShift.g          :=  3;
3194   fShift.b          :=  6;
3195   fglFormat         := GL_RGB;
3196   fglInternalFormat := GL_R3_G3_B2;
3197   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;
3198 end;
3199
3200 constructor TfdRGB4.Create;
3201 begin
3202   inherited Create;
3203   fFormat           := tfRGB4;
3204   fWithAlpha        := tfRGBA4;
3205   fWithoutAlpha     := tfRGB4;
3206   fRGBInverted      := tfBGR4;
3207   fRange.r          := $F;
3208   fRange.g          := $F;
3209   fRange.b          := $F;
3210   fShift.r          :=  0;
3211   fShift.g          :=  4;
3212   fShift.b          :=  8;
3213   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3214   fglInternalFormat := GL_RGB4;
3215   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3216 end;
3217
3218 constructor TfdR5G6B5.Create;
3219 begin
3220   inherited Create;
3221   fFormat           := tfR5G6B5;
3222   fWithAlpha        := tfRGBA4;
3223   fWithoutAlpha     := tfR5G6B5;
3224   fRGBInverted      := tfB5G6R5;
3225   fRange.r          := $1F;
3226   fRange.g          := $3F;
3227   fRange.b          := $1F;
3228   fShift.r          :=   0;
3229   fShift.g          :=   5;
3230   fShift.b          :=  11;
3231   fglFormat         := GL_RGB;
3232   fglInternalFormat := GL_RGB565;
3233   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;
3234 end;
3235
3236 constructor TfdRGB5.Create;
3237 begin
3238   inherited Create;
3239   fFormat           := tfRGB5;
3240   fWithAlpha        := tfRGB5A1;
3241   fWithoutAlpha     := tfRGB5;
3242   fRGBInverted      := tfBGR5;
3243   fRange.r          := $1F;
3244   fRange.g          := $1F;
3245   fRange.b          := $1F;
3246   fShift.r          :=   0;
3247   fShift.g          :=   5;
3248   fShift.b          :=  10;
3249   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3250   fglInternalFormat := GL_RGB5;
3251   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3252 end;
3253
3254 constructor TfdRGB8.Create;
3255 begin
3256   inherited Create;
3257   fFormat           := tfRGB8;
3258   fWithAlpha        := tfRGBA8;
3259   fWithoutAlpha     := tfRGB8;
3260   fRGBInverted      := tfBGR8;
3261   fglInternalFormat := GL_RGB8;
3262 end;
3263
3264 constructor TfdRGB10.Create;
3265 begin
3266   inherited Create;
3267   fFormat           := tfRGB10;
3268   fWithAlpha        := tfRGB10A2;
3269   fWithoutAlpha     := tfRGB10;
3270   fRGBInverted      := tfBGR10;
3271   fRange.r          := $3FF;
3272   fRange.g          := $3FF;
3273   fRange.b          := $3FF;
3274   fShift.r          :=    0;
3275   fShift.g          :=   10;
3276   fShift.b          :=   20;
3277   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3278   fglInternalFormat := GL_RGB10;
3279   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3280 end;
3281
3282 constructor TfdRGB12.Create;
3283 begin
3284   inherited Create;
3285   fFormat           := tfRGB12;
3286   fWithAlpha        := tfRGBA12;
3287   fWithoutAlpha     := tfRGB12;
3288   fRGBInverted      := tfBGR12;
3289   fglInternalFormat := GL_RGB12;
3290 end;
3291
3292 constructor TfdRGB16.Create;
3293 begin
3294   inherited Create;
3295   fFormat           := tfRGB16;
3296   fWithAlpha        := tfRGBA16;
3297   fWithoutAlpha     := tfRGB16;
3298   fRGBInverted      := tfBGR16;
3299   fglInternalFormat := GL_RGB16;
3300 end;
3301
3302 constructor TfdRGBA2.Create;
3303 begin
3304   inherited Create;
3305   fFormat           := tfRGBA2;
3306   fWithAlpha        := tfRGBA2;
3307   fWithoutAlpha     := tfR3G3B2;
3308   fRGBInverted      := tfBGRA2;
3309   fglInternalFormat := GL_RGBA2;
3310 end;
3311
3312 constructor TfdRGBA4.Create;
3313 begin
3314   inherited Create;
3315   fFormat           := tfRGBA4;
3316   fWithAlpha        := tfRGBA4;
3317   fWithoutAlpha     := tfRGB4;
3318   fRGBInverted      := tfBGRA4;
3319   fRange.r          := $F;
3320   fRange.g          := $F;
3321   fRange.b          := $F;
3322   fRange.a          := $F;
3323   fShift.r          :=  0;
3324   fShift.g          :=  4;
3325   fShift.b          :=  8;
3326   fShift.a          := 12;
3327   fglFormat         := GL_RGBA;
3328   fglInternalFormat := GL_RGBA4;
3329   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3330 end;
3331
3332 constructor TfdRGB5A1.Create;
3333 begin
3334   inherited Create;
3335   fFormat           := tfRGB5A1;
3336   fWithAlpha        := tfRGB5A1;
3337   fWithoutAlpha     := tfRGB5;
3338   fRGBInverted      := tfBGR5A1;
3339   fRange.r          := $1F;
3340   fRange.g          := $1F;
3341   fRange.b          := $1F;
3342   fRange.a          := $01;
3343   fShift.r          :=   0;
3344   fShift.g          :=   5;
3345   fShift.b          :=  10;
3346   fShift.a          :=  15;
3347   fglFormat         := GL_RGBA;
3348   fglInternalFormat := GL_RGB5_A1;
3349   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3350 end;
3351
3352 constructor TfdRGBA8.Create;
3353 begin
3354   inherited Create;
3355   fFormat           := tfRGBA8;
3356   fWithAlpha        := tfRGBA8;
3357   fWithoutAlpha     := tfRGB8;
3358   fRGBInverted      := tfBGRA8;
3359   fglInternalFormat := GL_RGBA8;
3360 end;
3361
3362 constructor TfdRGB10A2.Create;
3363 begin
3364   inherited Create;
3365   fFormat           := tfRGB10A2;
3366   fWithAlpha        := tfRGB10A2;
3367   fWithoutAlpha     := tfRGB10;
3368   fRGBInverted      := tfBGR10A2;
3369   fRange.r          := $3FF;
3370   fRange.g          := $3FF;
3371   fRange.b          := $3FF;
3372   fRange.a          := $003;
3373   fShift.r          :=    0;
3374   fShift.g          :=   10;
3375   fShift.b          :=   20;
3376   fShift.a          :=   30;
3377   fglFormat         := GL_RGBA;
3378   fglInternalFormat := GL_RGB10_A2;
3379   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3380 end;
3381
3382 constructor TfdRGBA12.Create;
3383 begin
3384   inherited Create;
3385   fFormat           := tfRGBA12;
3386   fWithAlpha        := tfRGBA12;
3387   fWithoutAlpha     := tfRGB12;
3388   fRGBInverted      := tfBGRA12;
3389   fglInternalFormat := GL_RGBA12;
3390 end;
3391
3392 constructor TfdRGBA16.Create;
3393 begin
3394   inherited Create;
3395   fFormat           := tfRGBA16;
3396   fWithAlpha        := tfRGBA16;
3397   fWithoutAlpha     := tfRGB16;
3398   fRGBInverted      := tfBGRA16;
3399   fglInternalFormat := GL_RGBA16;
3400 end;
3401
3402 constructor TfdBGR4.Create;
3403 begin
3404   inherited Create;
3405   fPixelSize        := 2.0;
3406   fFormat           := tfBGR4;
3407   fWithAlpha        := tfBGRA4;
3408   fWithoutAlpha     := tfBGR4;
3409   fRGBInverted      := tfRGB4;
3410   fRange.r          := $F;
3411   fRange.g          := $F;
3412   fRange.b          := $F;
3413   fRange.a          := $0;
3414   fShift.r          :=  8;
3415   fShift.g          :=  4;
3416   fShift.b          :=  0;
3417   fShift.a          :=  0;
3418   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3419   fglInternalFormat := GL_RGB4;
3420   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3421 end;
3422
3423 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3426 constructor TfdB5G6R5.Create;
3427 begin
3428   inherited Create;
3429   fFormat           := tfB5G6R5;
3430   fWithAlpha        := tfBGRA4;
3431   fWithoutAlpha     := tfB5G6R5;
3432   fRGBInverted      := tfR5G6B5;
3433   fRange.r          := $1F;
3434   fRange.g          := $3F;
3435   fRange.b          := $1F;
3436   fShift.r          :=  11;
3437   fShift.g          :=   5;
3438   fShift.b          :=   0;
3439   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3440   fglInternalFormat := GL_RGB8;
3441   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;
3442 end;
3443
3444 constructor TfdBGR5.Create;
3445 begin
3446   inherited Create;
3447   fPixelSize        := 2.0;
3448   fFormat           := tfBGR5;
3449   fWithAlpha        := tfBGR5A1;
3450   fWithoutAlpha     := tfBGR5;
3451   fRGBInverted      := tfRGB5;
3452   fRange.r          := $1F;
3453   fRange.g          := $1F;
3454   fRange.b          := $1F;
3455   fRange.a          := $00;
3456   fShift.r          :=  10;
3457   fShift.g          :=   5;
3458   fShift.b          :=   0;
3459   fShift.a          :=   0;
3460   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3461   fglInternalFormat := GL_RGB5;
3462   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3463 end;
3464
3465 constructor TfdBGR8.Create;
3466 begin
3467   inherited Create;
3468   fFormat           := tfBGR8;
3469   fWithAlpha        := tfBGRA8;
3470   fWithoutAlpha     := tfBGR8;
3471   fRGBInverted      := tfRGB8;
3472   fglInternalFormat := GL_RGB8;
3473 end;
3474
3475 constructor TfdBGR10.Create;
3476 begin
3477   inherited Create;
3478   fFormat           := tfBGR10;
3479   fWithAlpha        := tfBGR10A2;
3480   fWithoutAlpha     := tfBGR10;
3481   fRGBInverted      := tfRGB10;
3482   fRange.r          := $3FF;
3483   fRange.g          := $3FF;
3484   fRange.b          := $3FF;
3485   fRange.a          := $000;
3486   fShift.r          :=   20;
3487   fShift.g          :=   10;
3488   fShift.b          :=    0;
3489   fShift.a          :=    0;
3490   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3491   fglInternalFormat := GL_RGB10;
3492   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3493 end;
3494
3495 constructor TfdBGR12.Create;
3496 begin
3497   inherited Create;
3498   fFormat           := tfBGR12;
3499   fWithAlpha        := tfBGRA12;
3500   fWithoutAlpha     := tfBGR12;
3501   fRGBInverted      := tfRGB12;
3502   fglInternalFormat := GL_RGB12;
3503 end;
3504
3505 constructor TfdBGR16.Create;
3506 begin
3507   inherited Create;
3508   fFormat           := tfBGR16;
3509   fWithAlpha        := tfBGRA16;
3510   fWithoutAlpha     := tfBGR16;
3511   fRGBInverted      := tfRGB16;
3512   fglInternalFormat := GL_RGB16;
3513 end;
3514
3515 constructor TfdBGRA2.Create;
3516 begin
3517   inherited Create;
3518   fFormat           := tfBGRA2;
3519   fWithAlpha        := tfBGRA4;
3520   fWithoutAlpha     := tfBGR4;
3521   fRGBInverted      := tfRGBA2;
3522   fglInternalFormat := GL_RGBA2;
3523 end;
3524
3525 constructor TfdBGRA4.Create;
3526 begin
3527   inherited Create;
3528   fFormat           := tfBGRA4;
3529   fWithAlpha        := tfBGRA4;
3530   fWithoutAlpha     := tfBGR4;
3531   fRGBInverted      := tfRGBA4;
3532   fRange.r          := $F;
3533   fRange.g          := $F;
3534   fRange.b          := $F;
3535   fRange.a          := $F;
3536   fShift.r          :=  8;
3537   fShift.g          :=  4;
3538   fShift.b          :=  0;
3539   fShift.a          := 12;
3540   fglFormat         := GL_BGRA;
3541   fglInternalFormat := GL_RGBA4;
3542   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3543 end;
3544
3545 constructor TfdBGR5A1.Create;
3546 begin
3547   inherited Create;
3548   fFormat           := tfBGR5A1;
3549   fWithAlpha        := tfBGR5A1;
3550   fWithoutAlpha     := tfBGR5;
3551   fRGBInverted      := tfRGB5A1;
3552   fRange.r          := $1F;
3553   fRange.g          := $1F;
3554   fRange.b          := $1F;
3555   fRange.a          := $01;
3556   fShift.r          :=  10;
3557   fShift.g          :=   5;
3558   fShift.b          :=   0;
3559   fShift.a          :=  15;
3560   fglFormat         := GL_BGRA;
3561   fglInternalFormat := GL_RGB5_A1;
3562   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3563 end;
3564
3565 constructor TfdBGRA8.Create;
3566 begin
3567   inherited Create;
3568   fFormat           := tfBGRA8;
3569   fWithAlpha        := tfBGRA8;
3570   fWithoutAlpha     := tfBGR8;
3571   fRGBInverted      := tfRGBA8;
3572   fglInternalFormat := GL_RGBA8;
3573 end;
3574
3575 constructor TfdBGR10A2.Create;
3576 begin
3577   inherited Create;
3578   fFormat           := tfBGR10A2;
3579   fWithAlpha        := tfBGR10A2;
3580   fWithoutAlpha     := tfBGR10;
3581   fRGBInverted      := tfRGB10A2;
3582   fRange.r          := $3FF;
3583   fRange.g          := $3FF;
3584   fRange.b          := $3FF;
3585   fRange.a          := $003;
3586   fShift.r          :=   20;
3587   fShift.g          :=   10;
3588   fShift.b          :=    0;
3589   fShift.a          :=   30;
3590   fglFormat         := GL_BGRA;
3591   fglInternalFormat := GL_RGB10_A2;
3592   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;
3593 end;
3594
3595 constructor TfdBGRA12.Create;
3596 begin
3597   inherited Create;
3598   fFormat           := tfBGRA12;
3599   fWithAlpha        := tfBGRA12;
3600   fWithoutAlpha     := tfBGR12;
3601   fRGBInverted      := tfRGBA12;
3602   fglInternalFormat := GL_RGBA12;
3603 end;
3604
3605 constructor TfdBGRA16.Create;
3606 begin
3607   inherited Create;
3608   fFormat           := tfBGRA16;
3609   fWithAlpha        := tfBGRA16;
3610   fWithoutAlpha     := tfBGR16;
3611   fRGBInverted      := tfRGBA16;
3612   fglInternalFormat := GL_RGBA16;
3613 end;
3614
3615 constructor TfdDepth16.Create;
3616 begin
3617   inherited Create;
3618   fFormat           := tfDepth16;
3619   fWithAlpha        := tfEmpty;
3620   fWithoutAlpha     := tfDepth16;
3621   fglInternalFormat := GL_DEPTH_COMPONENT16;
3622 end;
3623
3624 constructor TfdDepth24.Create;
3625 begin
3626   inherited Create;
3627   fFormat           := tfDepth24;
3628   fWithAlpha        := tfEmpty;
3629   fWithoutAlpha     := tfDepth24;
3630   fglInternalFormat := GL_DEPTH_COMPONENT24;
3631 end;
3632
3633 constructor TfdDepth32.Create;
3634 begin
3635   inherited Create;
3636   fFormat           := tfDepth32;
3637   fWithAlpha        := tfEmpty;
3638   fWithoutAlpha     := tfDepth32;
3639   fglInternalFormat := GL_DEPTH_COMPONENT32;
3640 end;
3641
3642 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3643 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3646 begin
3647   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3648 end;
3649
3650 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3651 begin
3652   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3653 end;
3654
3655 constructor TfdS3tcDtx1RGBA.Create;
3656 begin
3657   inherited Create;
3658   fFormat           := tfS3tcDtx1RGBA;
3659   fWithAlpha        := tfS3tcDtx1RGBA;
3660   fUncompressed     := tfRGB5A1;
3661   fPixelSize        := 0.5;
3662   fIsCompressed     := true;
3663   fglFormat         := GL_COMPRESSED_RGBA;
3664   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3665   fglDataFormat     := GL_UNSIGNED_BYTE;
3666 end;
3667
3668 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3669 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3670 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3671 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3672 begin
3673   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3674 end;
3675
3676 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3677 begin
3678   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3679 end;
3680
3681 constructor TfdS3tcDtx3RGBA.Create;
3682 begin
3683   inherited Create;
3684   fFormat           := tfS3tcDtx3RGBA;
3685   fWithAlpha        := tfS3tcDtx3RGBA;
3686   fUncompressed     := tfRGBA8;
3687   fPixelSize        := 1.0;
3688   fIsCompressed     := true;
3689   fglFormat         := GL_COMPRESSED_RGBA;
3690   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3691   fglDataFormat     := GL_UNSIGNED_BYTE;
3692 end;
3693
3694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3695 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3697 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3698 begin
3699   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3700 end;
3701
3702 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3703 begin
3704   raise EglBitmapException.Create('mapping for compressed formats is not supported');
3705 end;
3706
3707 constructor TfdS3tcDtx5RGBA.Create;
3708 begin
3709   inherited Create;
3710   fFormat           := tfS3tcDtx3RGBA;
3711   fWithAlpha        := tfS3tcDtx3RGBA;
3712   fUncompressed     := tfRGBA8;
3713   fPixelSize        := 1.0;
3714   fIsCompressed     := true;
3715   fglFormat         := GL_COMPRESSED_RGBA;
3716   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3717   fglDataFormat     := GL_UNSIGNED_BYTE;
3718 end;
3719
3720 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3721 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 class procedure TFormatDescriptor.Init;
3724 begin
3725   if not Assigned(FormatDescriptorCS) then
3726     FormatDescriptorCS := TCriticalSection.Create;
3727 end;
3728
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3731 begin
3732   FormatDescriptorCS.Enter;
3733   try
3734     result := FormatDescriptors[aFormat];
3735     if not Assigned(result) then begin
3736       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3737       FormatDescriptors[aFormat] := result;
3738     end;
3739   finally
3740     FormatDescriptorCS.Leave;
3741   end;
3742 end;
3743
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3746 begin
3747   result := Get(Get(aFormat).WithAlpha);
3748 end;
3749
3750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3751 class procedure TFormatDescriptor.Clear;
3752 var
3753   f: TglBitmapFormat;
3754 begin
3755   FormatDescriptorCS.Enter;
3756   try
3757     for f := low(FormatDescriptors) to high(FormatDescriptors) do
3758       FreeAndNil(FormatDescriptors[f]);
3759   finally
3760     FormatDescriptorCS.Leave;
3761   end;
3762 end;
3763
3764 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3765 class procedure TFormatDescriptor.Finalize;
3766 begin
3767   Clear;
3768   FreeAndNil(FormatDescriptorCS);
3769 end;
3770
3771 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3772 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3775 begin
3776   Update(aValue, fRange.r, fShift.r);
3777 end;
3778
3779 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3780 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3781 begin
3782   Update(aValue, fRange.g, fShift.g);
3783 end;
3784
3785 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3786 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3787 begin
3788   Update(aValue, fRange.b, fShift.b);
3789 end;
3790
3791 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3792 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3793 begin
3794   Update(aValue, fRange.a, fShift.a);
3795 end;
3796
3797 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3798 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3799   aShift: Byte);
3800 begin
3801   aShift := 0;
3802   aRange := 0;
3803   if (aMask = 0) then
3804     exit;
3805   while (aMask > 0) and ((aMask and 1) = 0) do begin
3806     inc(aShift);
3807     aMask := aMask shr 1;
3808   end;
3809   aRange := 1;
3810   while (aMask > 0) do begin
3811     aRange := aRange shl 1;
3812     aMask  := aMask  shr 1;
3813   end;
3814   dec(aRange);
3815
3816   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3817 end;
3818
3819 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3820 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3821 var
3822   data: QWord;
3823   s: Integer;
3824 begin
3825   data :=
3826     ((aPixel.Data.r and fRange.r) shl fShift.r) or
3827     ((aPixel.Data.g and fRange.g) shl fShift.g) or
3828     ((aPixel.Data.b and fRange.b) shl fShift.b) or
3829     ((aPixel.Data.a and fRange.a) shl fShift.a);
3830   s := Round(fPixelSize);
3831   case s of
3832     1:           aData^  := data;
3833     2:     PWord(aData)^ := data;
3834     4: PCardinal(aData)^ := data;
3835     8:    PQWord(aData)^ := data;
3836   else
3837     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3838   end;
3839   inc(aData, s);
3840 end;
3841
3842 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3843 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3844 var
3845   data: QWord;
3846   s, i: Integer;
3847 begin
3848   s := Round(fPixelSize);
3849   case s of
3850     1: data :=           aData^;
3851     2: data :=     PWord(aData)^;
3852     4: data := PCardinal(aData)^;
3853     8: data :=    PQWord(aData)^;
3854   else
3855     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3856   end;
3857   for i := 0 to 3 do
3858     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3859   inc(aData, s);
3860 end;
3861
3862 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3863 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3864 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3865 procedure TbmpColorTableFormat.CreateColorTable;
3866 var
3867   i: Integer;
3868 begin
3869   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3870     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3871
3872   if (Format = tfLuminance4) then
3873     SetLength(fColorTable, 16)
3874   else
3875     SetLength(fColorTable, 256);
3876
3877   case Format of
3878     tfLuminance4: begin
3879       for i := 0 to High(fColorTable) do begin
3880         fColorTable[i].r := 16 * i;
3881         fColorTable[i].g := 16 * i;
3882         fColorTable[i].b := 16 * i;
3883         fColorTable[i].a := 0;
3884       end;
3885     end;
3886
3887     tfLuminance8: begin
3888       for i := 0 to High(fColorTable) do begin
3889         fColorTable[i].r := i;
3890         fColorTable[i].g := i;
3891         fColorTable[i].b := i;
3892         fColorTable[i].a := 0;
3893       end;
3894     end;
3895
3896     tfR3G3B2: begin
3897       for i := 0 to High(fColorTable) do begin
3898         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3899         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3900         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3901         fColorTable[i].a := 0;
3902       end;
3903     end;
3904   end;
3905 end;
3906
3907 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3908 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3909 var
3910   d: Byte;
3911 begin
3912   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3913     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3914
3915   case Format of
3916     tfLuminance4: begin
3917       if (aMapData = nil) then
3918         aData^ := 0;
3919       d := LuminanceWeight(aPixel) and Range.r;
3920       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3921       inc(aMapData, 4);
3922       if ({%H-}PtrUInt(aMapData) >= 8) then begin
3923         inc(aData);
3924         aMapData := nil;
3925       end;
3926     end;
3927
3928     tfLuminance8: begin
3929       aData^ := LuminanceWeight(aPixel) and Range.r;
3930       inc(aData);
3931     end;
3932
3933     tfR3G3B2: begin
3934       aData^ := Round(
3935         ((aPixel.Data.r and Range.r) shl Shift.r) or
3936         ((aPixel.Data.g and Range.g) shl Shift.g) or
3937         ((aPixel.Data.b and Range.b) shl Shift.b));
3938       inc(aData);
3939     end;
3940   end;
3941 end;
3942
3943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3944 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3945 var
3946   idx: QWord;
3947   s: Integer;
3948   bits: Byte;
3949   f: Single;
3950 begin
3951   s    := Trunc(fPixelSize);
3952   f    := fPixelSize - s;
3953   bits := Round(8 * f);
3954   case s of
3955     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
3956     1: idx :=           aData^;
3957     2: idx :=     PWord(aData)^;
3958     4: idx := PCardinal(aData)^;
3959     8: idx :=    PQWord(aData)^;
3960   else
3961     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3962   end;
3963   if (idx >= Length(fColorTable)) then
3964     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3965   with fColorTable[idx] do begin
3966     aPixel.Data.r := r;
3967     aPixel.Data.g := g;
3968     aPixel.Data.b := b;
3969     aPixel.Data.a := a;
3970   end;
3971   inc(aMapData, bits);
3972   if ({%H-}PtrUInt(aMapData) >= 8) then begin
3973     inc(aData, 1);
3974     dec(aMapData, 8);
3975   end;
3976   inc(aData, s);
3977 end;
3978
3979 destructor TbmpColorTableFormat.Destroy;
3980 begin
3981   SetLength(fColorTable, 0);
3982   inherited Destroy;
3983 end;
3984
3985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3986 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3988 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3989 var
3990   i: Integer;
3991 begin
3992   for i := 0 to 3 do begin
3993     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3994       if (aSourceFD.Range.arr[i] > 0) then
3995         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3996       else
3997         aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3998     end;
3999   end;
4000 end;
4001
4002 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4003 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4004 begin
4005   with aFuncRec do begin
4006     if (Source.Range.r   > 0) then
4007       Dest.Data.r := Source.Data.r;
4008     if (Source.Range.g > 0) then
4009       Dest.Data.g := Source.Data.g;
4010     if (Source.Range.b  > 0) then
4011       Dest.Data.b := Source.Data.b;
4012     if (Source.Range.a > 0) then
4013       Dest.Data.a := Source.Data.a;
4014   end;
4015 end;
4016
4017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4018 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4019 var
4020   i: Integer;
4021 begin
4022   with aFuncRec do begin
4023     for i := 0 to 3 do
4024       if (Source.Range.arr[i] > 0) then
4025         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4026   end;
4027 end;
4028
4029 type
4030   TShiftData = packed record
4031     case Integer of
4032       0: (r, g, b, a: SmallInt);
4033       1: (arr: array[0..3] of SmallInt);
4034   end;
4035   PShiftData = ^TShiftData;
4036
4037 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4038 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4039 var
4040   i: Integer;
4041 begin
4042   with aFuncRec do
4043     for i := 0 to 3 do
4044       if (Source.Range.arr[i] > 0) then
4045         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4046 end;
4047
4048 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4049 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4050 begin
4051   with aFuncRec do begin
4052     Dest.Data := Source.Data;
4053     if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4054       Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4055       Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4056       Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4057     end;
4058     if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4059       Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4060     end;
4061   end;
4062 end;
4063
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4066 var
4067   i: Integer;
4068 begin
4069   with aFuncRec do begin
4070     for i := 0 to 3 do
4071       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4072   end;
4073 end;
4074
4075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4076 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4077 var
4078   Temp: Single;
4079 begin
4080   with FuncRec do begin
4081     if (FuncRec.Args = nil) then begin //source has no alpha
4082       Temp :=
4083         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4084         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4085         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4086       Dest.Data.a := Round(Dest.Range.a * Temp);
4087     end else
4088       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4089   end;
4090 end;
4091
4092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4093 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4094 type
4095   PglBitmapPixelData = ^TglBitmapPixelData;
4096 begin
4097   with FuncRec do begin
4098     Dest.Data.r := Source.Data.r;
4099     Dest.Data.g := Source.Data.g;
4100     Dest.Data.b := Source.Data.b;
4101
4102     with PglBitmapPixelData(Args)^ do
4103       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4104           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4105           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4106         Dest.Data.a := 0
4107       else
4108         Dest.Data.a := Dest.Range.a;
4109   end;
4110 end;
4111
4112 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4113 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4114 begin
4115   with FuncRec do begin
4116     Dest.Data.r := Source.Data.r;
4117     Dest.Data.g := Source.Data.g;
4118     Dest.Data.b := Source.Data.b;
4119     Dest.Data.a := PCardinal(Args)^;
4120   end;
4121 end;
4122
4123 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4124 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4125 type
4126   PRGBPix = ^TRGBPix;
4127   TRGBPix = array [0..2] of byte;
4128 var
4129   Temp: Byte;
4130 begin
4131   while aWidth > 0 do begin
4132     Temp := PRGBPix(aData)^[0];
4133     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4134     PRGBPix(aData)^[2] := Temp;
4135
4136     if aHasAlpha then
4137       Inc(aData, 4)
4138     else
4139       Inc(aData, 3);
4140     dec(aWidth);
4141   end;
4142 end;
4143
4144 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4145 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4146 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4147 function TglBitmap.GetWidth: Integer;
4148 begin
4149   if (ffX in fDimension.Fields) then
4150     result := fDimension.X
4151   else
4152     result := -1;
4153 end;
4154
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 function TglBitmap.GetHeight: Integer;
4157 begin
4158   if (ffY in fDimension.Fields) then
4159     result := fDimension.Y
4160   else
4161     result := -1;
4162 end;
4163
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 function TglBitmap.GetFileWidth: Integer;
4166 begin
4167   result := Max(1, Width);
4168 end;
4169
4170 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4171 function TglBitmap.GetFileHeight: Integer;
4172 begin
4173   result := Max(1, Height);
4174 end;
4175
4176 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4177 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4178 begin
4179   if fCustomData = aValue then
4180     exit;
4181   fCustomData := aValue;
4182 end;
4183
4184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4185 procedure TglBitmap.SetCustomName(const aValue: String);
4186 begin
4187   if fCustomName = aValue then
4188     exit;
4189   fCustomName := aValue;
4190 end;
4191
4192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4193 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4194 begin
4195   if fCustomNameW = aValue then
4196     exit;
4197   fCustomNameW := aValue;
4198 end;
4199
4200 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4201 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4202 begin
4203   if fDeleteTextureOnFree = aValue then
4204     exit;
4205   fDeleteTextureOnFree := aValue;
4206 end;
4207
4208 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4209 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4210 begin
4211   if fFormat = aValue then
4212     exit;
4213   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4214     raise EglBitmapUnsupportedFormat.Create(Format);
4215   SetDataPointer(Data, aValue, Width, Height);
4216 end;
4217
4218 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4219 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4220 begin
4221   if fFreeDataAfterGenTexture = aValue then
4222     exit;
4223   fFreeDataAfterGenTexture := aValue;
4224 end;
4225
4226 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4227 procedure TglBitmap.SetID(const aValue: Cardinal);
4228 begin
4229   if fID = aValue then
4230     exit;
4231   fID := aValue;
4232 end;
4233
4234 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4235 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4236 begin
4237   if fMipMap = aValue then
4238     exit;
4239   fMipMap := aValue;
4240 end;
4241
4242 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4243 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4244 begin
4245   if fTarget = aValue then
4246     exit;
4247   fTarget := aValue;
4248 end;
4249
4250 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4251 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4252 var
4253   MaxAnisotropic: Integer;
4254 begin
4255   fAnisotropic := aValue;
4256   if (ID > 0) then begin
4257     if GL_EXT_texture_filter_anisotropic then begin
4258       if fAnisotropic > 0 then begin
4259         Bind(false);
4260         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4261         if aValue > MaxAnisotropic then
4262           fAnisotropic := MaxAnisotropic;
4263         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4264       end;
4265     end else begin
4266       fAnisotropic := 0;
4267     end;
4268   end;
4269 end;
4270
4271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4272 procedure TglBitmap.CreateID;
4273 begin
4274   if (ID <> 0) then
4275     glDeleteTextures(1, @fID);
4276   glGenTextures(1, @fID);
4277   Bind(false);
4278 end;
4279
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4282 begin
4283   // Set Up Parameters
4284   SetWrap(fWrapS, fWrapT, fWrapR);
4285   SetFilter(fFilterMin, fFilterMag);
4286   SetAnisotropic(fAnisotropic);
4287   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4288
4289   // Mip Maps Generation Mode
4290   aBuildWithGlu := false;
4291   if (MipMap = mmMipmap) then begin
4292     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4293       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4294     else
4295       aBuildWithGlu := true;
4296   end else if (MipMap = mmMipmapGlu) then
4297     aBuildWithGlu := true;
4298 end;
4299
4300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4301 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4302   const aWidth: Integer; const aHeight: Integer);
4303 var
4304   s: Single;
4305 begin
4306   if (Data <> aData) then begin
4307     if (Assigned(Data)) then
4308       FreeMem(Data);
4309     fData := aData;
4310   end;
4311
4312   FillChar(fDimension, SizeOf(fDimension), 0);
4313   if not Assigned(fData) then begin
4314     fFormat    := tfEmpty;
4315     fPixelSize := 0;
4316     fRowSize   := 0;
4317   end else begin
4318     if aWidth <> -1 then begin
4319       fDimension.Fields := fDimension.Fields + [ffX];
4320       fDimension.X := aWidth;
4321     end;
4322
4323     if aHeight <> -1 then begin
4324       fDimension.Fields := fDimension.Fields + [ffY];
4325       fDimension.Y := aHeight;
4326     end;
4327
4328     s := TFormatDescriptor.Get(aFormat).PixelSize;
4329     fFormat    := aFormat;
4330     fPixelSize := Ceil(s);
4331     fRowSize   := Ceil(s * aWidth);
4332   end;
4333 end;
4334
4335 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4336 function TglBitmap.FlipHorz: Boolean;
4337 begin
4338   result := false;
4339 end;
4340
4341 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4342 function TglBitmap.FlipVert: Boolean;
4343 begin
4344   result := false;
4345 end;
4346
4347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4348 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4349 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4350 procedure TglBitmap.AfterConstruction;
4351 begin
4352   inherited AfterConstruction;
4353
4354   fID         := 0;
4355   fTarget     := 0;
4356   fIsResident := false;
4357
4358   fFormat                  := glBitmapGetDefaultFormat;
4359   fMipMap                  := glBitmapDefaultMipmap;
4360   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4361   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;
4362
4363   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);
4364   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4365 end;
4366
4367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4368 procedure TglBitmap.BeforeDestruction;
4369 begin
4370   SetDataPointer(nil, tfEmpty);
4371   if (fID > 0) and fDeleteTextureOnFree then
4372     glDeleteTextures(1, @fID);
4373   inherited BeforeDestruction;
4374 end;
4375
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TglBitmap.LoadFromFile(const aFilename: String);
4378 var
4379   fs: TFileStream;
4380 begin
4381   if not FileExists(aFilename) then
4382     raise EglBitmapException.Create('file does not exist: ' + aFilename);
4383   fFilename := aFilename;
4384   fs := TFileStream.Create(fFilename, fmOpenRead);
4385   try
4386     fs.Position := 0;
4387     LoadFromStream(fs);
4388   finally
4389     fs.Free;
4390   end;
4391 end;
4392
4393 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4394 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4395 begin
4396   {$IFDEF GLB_SUPPORT_PNG_READ}
4397   if not LoadPNG(aStream) then
4398   {$ENDIF}
4399   {$IFDEF GLB_SUPPORT_JPEG_READ}
4400   if not LoadJPEG(aStream) then
4401   {$ENDIF}
4402   if not LoadDDS(aStream) then
4403   if not LoadTGA(aStream) then
4404   if not LoadBMP(aStream) then
4405     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4406 end;
4407
4408 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4409 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4410   const aFormat: TglBitmapFormat; const aArgs: Pointer);
4411 var
4412   tmpData: PByte;
4413   size: Integer;
4414 begin
4415   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4416   GetMem(tmpData, size);
4417   try
4418     FillChar(tmpData^, size, #$FF);
4419     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4420   except
4421     FreeMem(tmpData);
4422     raise;
4423   end;
4424   AddFunc(Self, aFunc, false, Format, aArgs);
4425 end;
4426
4427 {$IFDEF GLB_DELPHI}
4428 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4429 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4430 var
4431   rs: TResourceStream;
4432   TempPos: Integer;
4433   ResTypeStr: String;
4434   TempResType: PChar;
4435 begin
4436   if not Assigned(ResType) then begin
4437     TempPos     := Pos('.', Resource);
4438     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4439     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));
4440     TempResType := PChar(ResTypeStr);
4441   end else
4442     TempResType := ResType
4443
4444   rs := TResourceStream.Create(Instance, Resource, TempResType);
4445   try
4446     LoadFromStream(rs);
4447   finally
4448     rs.Free;
4449   end;
4450 end;
4451
4452 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4453 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4454 var
4455   rs: TResourceStream;
4456 begin
4457   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4458   try
4459     LoadFromStream(rs);
4460   finally
4461     rs.Free;
4462   end;
4463 end;
4464 {$ENDIF}
4465
4466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4467 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4468 var
4469   fs: TFileStream;
4470 begin
4471   fs := TFileStream.Create(aFileName, fmCreate);
4472   try
4473     fs.Position := 0;
4474     SaveToStream(fs, aFileType);
4475   finally
4476     fs.Free;
4477   end;
4478 end;
4479
4480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4481 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4482 begin
4483   case aFileType of
4484     {$IFDEF GLB_SUPPORT_PNG_WRITE}
4485     ftPNG:  SavePNG(aStream);
4486     {$ENDIF}
4487     {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4488     ftJPEG: SaveJPEG(aStream);
4489     {$ENDIF}
4490     ftDDS:  SaveDDS(aStream);
4491     ftTGA:  SaveTGA(aStream);
4492     ftBMP:  SaveBMP(aStream);
4493   end;
4494 end;
4495
4496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4497 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4498 begin
4499   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4500 end;
4501
4502 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4503 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4504   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4505 var
4506   DestData, TmpData, SourceData: pByte;
4507   TempHeight, TempWidth: Integer;
4508   SourceFD, DestFD: TFormatDescriptor;
4509   SourceMD, DestMD: Pointer;
4510
4511   FuncRec: TglBitmapFunctionRec;
4512 begin
4513   Assert(Assigned(Data));
4514   Assert(Assigned(aSource));
4515   Assert(Assigned(aSource.Data));
4516
4517   result := false;
4518   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4519     SourceFD := TFormatDescriptor.Get(aSource.Format);
4520     DestFD   := TFormatDescriptor.Get(aFormat);
4521
4522     // inkompatible Formats so CreateTemp
4523     if (SourceFD.PixelSize <> DestFD.PixelSize) then
4524       aCreateTemp := true;
4525
4526     // Values
4527     TempHeight := Max(1, aSource.Height);
4528     TempWidth  := Max(1, aSource.Width);
4529
4530     FuncRec.Sender := Self;
4531     FuncRec.Args   := aArgs;
4532
4533     TmpData := nil;
4534     if aCreateTemp then begin
4535       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4536       DestData := TmpData;
4537     end else
4538       DestData := Data;
4539
4540     try
4541       SourceFD.PreparePixel(FuncRec.Source);
4542       DestFD.PreparePixel  (FuncRec.Dest);
4543
4544       SourceMD := SourceFD.CreateMappingData;
4545       DestMD   := DestFD.CreateMappingData;
4546
4547       FuncRec.Size            := aSource.Dimension;
4548       FuncRec.Position.Fields := FuncRec.Size.Fields;
4549
4550       try
4551         SourceData := aSource.Data;
4552         FuncRec.Position.Y := 0;
4553         while FuncRec.Position.Y < TempHeight do begin
4554           FuncRec.Position.X := 0;
4555           while FuncRec.Position.X < TempWidth do begin
4556             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4557             aFunc(FuncRec);
4558             DestFD.Map(FuncRec.Dest, DestData, DestMD);
4559             inc(FuncRec.Position.X);
4560           end;
4561           inc(FuncRec.Position.Y);
4562         end;
4563
4564         // Updating Image or InternalFormat
4565         if aCreateTemp then
4566           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4567         else if (aFormat <> fFormat) then
4568           Format := aFormat;
4569
4570         result := true;
4571       finally
4572         SourceFD.FreeMappingData(SourceMD);
4573         DestFD.FreeMappingData(DestMD);
4574       end;
4575     except
4576       if aCreateTemp then
4577         FreeMem(TmpData);
4578       raise;
4579     end;
4580   end;
4581 end;
4582
4583 {$IFDEF GLB_SDL}
4584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4585 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4586 var
4587   Row, RowSize: Integer;
4588   SourceData, TmpData: PByte;
4589   TempDepth: Integer;
4590   FormatDesc: TFormatDescriptor;
4591
4592   function GetRowPointer(Row: Integer): pByte;
4593   begin
4594     result := aSurface.pixels;
4595     Inc(result, Row * RowSize);
4596   end;
4597
4598 begin
4599   result := false;
4600
4601   FormatDesc := TFormatDescriptor.Get(Format);
4602   if FormatDesc.IsCompressed then
4603     raise EglBitmapUnsupportedFormat.Create(Format);
4604
4605   if Assigned(Data) then begin
4606     case Trunc(FormatDesc.PixelSize) of
4607       1: TempDepth :=  8;
4608       2: TempDepth := 16;
4609       3: TempDepth := 24;
4610       4: TempDepth := 32;
4611     else
4612       raise EglBitmapUnsupportedFormat.Create(Format);
4613     end;
4614
4615     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4616       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4617     SourceData := Data;
4618     RowSize    := FormatDesc.GetSize(FileWidth, 1);
4619
4620     for Row := 0 to FileHeight-1 do begin
4621       TmpData := GetRowPointer(Row);
4622       if Assigned(TmpData) then begin
4623         Move(SourceData^, TmpData^, RowSize);
4624         inc(SourceData, RowSize);
4625       end;
4626     end;
4627     result := true;
4628   end;
4629 end;
4630
4631 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4632 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4633 var
4634   pSource, pData, pTempData: PByte;
4635   Row, RowSize, TempWidth, TempHeight: Integer;
4636   IntFormat: TglBitmapFormat;
4637   FormatDesc: TFormatDescriptor;
4638
4639   function GetRowPointer(Row: Integer): pByte;
4640   begin
4641     result := aSurface^.pixels;
4642     Inc(result, Row * RowSize);
4643   end;
4644
4645 begin
4646   result := false;
4647   if (Assigned(aSurface)) then begin
4648     with aSurface^.format^ do begin
4649       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4650         FormatDesc := TFormatDescriptor.Get(IntFormat);
4651         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4652           break;
4653       end;
4654       if (IntFormat = tfEmpty) then
4655         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4656     end;
4657
4658     TempWidth  := aSurface^.w;
4659     TempHeight := aSurface^.h;
4660     RowSize := FormatDesc.GetSize(TempWidth, 1);
4661     GetMem(pData, TempHeight * RowSize);
4662     try
4663       pTempData := pData;
4664       for Row := 0 to TempHeight -1 do begin
4665         pSource := GetRowPointer(Row);
4666         if (Assigned(pSource)) then begin
4667           Move(pSource^, pTempData^, RowSize);
4668           Inc(pTempData, RowSize);
4669         end;
4670       end;
4671       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4672       result := true;
4673     except
4674       FreeMem(pData);
4675       raise;
4676     end;
4677   end;
4678 end;
4679
4680 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4681 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4682 var
4683   Row, Col, AlphaInterleave: Integer;
4684   pSource, pDest: PByte;
4685
4686   function GetRowPointer(Row: Integer): pByte;
4687   begin
4688     result := aSurface.pixels;
4689     Inc(result, Row * Width);
4690   end;
4691
4692 begin
4693   result := false;
4694   if Assigned(Data) then begin
4695     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4696       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4697
4698       AlphaInterleave := 0;
4699       case Format of
4700         tfLuminance8Alpha8:
4701           AlphaInterleave := 1;
4702         tfBGRA8, tfRGBA8:
4703           AlphaInterleave := 3;
4704       end;
4705
4706       pSource := Data;
4707       for Row := 0 to Height -1 do begin
4708         pDest := GetRowPointer(Row);
4709         if Assigned(pDest) then begin
4710           for Col := 0 to Width -1 do begin
4711             Inc(pSource, AlphaInterleave);
4712             pDest^ := pSource^;
4713             Inc(pDest);
4714             Inc(pSource);
4715           end;
4716         end;
4717       end;
4718       result := true;
4719     end;
4720   end;
4721 end;
4722
4723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4724 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4725 var
4726   bmp: TglBitmap2D;
4727 begin
4728   bmp := TglBitmap2D.Create;
4729   try
4730     bmp.AssignFromSurface(aSurface);
4731     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4732   finally
4733     bmp.Free;
4734   end;
4735 end;
4736 {$ENDIF}
4737
4738 {$IFDEF GLB_DELPHI}
4739 //TODO rework & test
4740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4741 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4742 var
4743   Row: Integer;
4744   pSource, pData: PByte;
4745 begin
4746   result := false;
4747   if Assigned(Data) then begin
4748     if Assigned(aBitmap) then begin
4749       aBitmap.Width  := Width;
4750       aBitmap.Height := Height;
4751
4752       case Format of
4753         tfAlpha8, ifLuminance, ifDepth8:
4754           begin
4755             Bitmap.PixelFormat := pf8bit;
4756             Bitmap.Palette := CreateGrayPalette;
4757           end;
4758         ifRGB5A1:
4759           Bitmap.PixelFormat := pf15bit;
4760         ifR5G6B5:
4761           Bitmap.PixelFormat := pf16bit;
4762         ifRGB8, ifBGR8:
4763           Bitmap.PixelFormat := pf24bit;
4764         ifRGBA8, ifBGRA8:
4765           Bitmap.PixelFormat := pf32bit;
4766         else
4767           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4768       end;
4769
4770       pSource := Data;
4771       for Row := 0 to FileHeight -1 do begin
4772         pData := Bitmap.Scanline[Row];
4773
4774         Move(pSource^, pData^, fRowSize);
4775         Inc(pSource, fRowSize);
4776
4777         // swap RGB(A) to BGR(A)
4778         if InternalFormat in [ifRGB8, ifRGBA8] then
4779           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4780       end;
4781
4782       result := true;
4783     end;
4784   end;
4785 end;
4786
4787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4788 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4789 var
4790   pSource, pData, pTempData: PByte;
4791   Row, RowSize, TempWidth, TempHeight: Integer;
4792   IntFormat: TglBitmapInternalFormat;
4793 begin
4794   result := false;
4795
4796   if (Assigned(Bitmap)) then begin
4797     case Bitmap.PixelFormat of
4798       pf8bit:
4799         IntFormat := ifLuminance;
4800       pf15bit:
4801         IntFormat := ifRGB5A1;
4802       pf16bit:
4803         IntFormat := ifR5G6B5;
4804       pf24bit:
4805         IntFormat := ifBGR8;
4806       pf32bit:
4807         IntFormat := ifBGRA8;
4808       else
4809         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4810     end;
4811
4812     TempWidth := Bitmap.Width;
4813     TempHeight := Bitmap.Height;
4814
4815     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4816
4817     GetMem(pData, TempHeight * RowSize);
4818     try
4819       pTempData := pData;
4820
4821       for Row := 0 to TempHeight -1 do begin
4822         pSource := Bitmap.Scanline[Row];
4823
4824         if (Assigned(pSource)) then begin
4825           Move(pSource^, pTempData^, RowSize);
4826           Inc(pTempData, RowSize);
4827         end;
4828       end;
4829
4830       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4831
4832       result := true;
4833     except
4834       FreeMem(pData);
4835       raise;
4836     end;
4837   end;
4838 end;
4839
4840 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4841 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4842 var
4843   Row, Col, AlphaInterleave: Integer;
4844   pSource, pDest: PByte;
4845 begin
4846   result := false;
4847
4848   if Assigned(Data) then begin
4849     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4850       if Assigned(Bitmap) then begin
4851         Bitmap.PixelFormat := pf8bit;
4852         Bitmap.Palette := CreateGrayPalette;
4853         Bitmap.Width := Width;
4854         Bitmap.Height := Height;
4855
4856         case InternalFormat of
4857           ifLuminanceAlpha:
4858             AlphaInterleave := 1;
4859           ifRGBA8, ifBGRA8:
4860             AlphaInterleave := 3;
4861           else
4862             AlphaInterleave := 0;
4863         end;
4864
4865         // Copy Data
4866         pSource := Data;
4867
4868         for Row := 0 to Height -1 do begin
4869           pDest := Bitmap.Scanline[Row];
4870
4871           if Assigned(pDest) then begin
4872             for Col := 0 to Width -1 do begin
4873               Inc(pSource, AlphaInterleave);
4874               pDest^ := pSource^;
4875               Inc(pDest);
4876               Inc(pSource);
4877             end;
4878           end;
4879         end;
4880
4881         result := true;
4882       end;
4883     end;
4884   end;
4885 end;
4886
4887 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4888 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4889 var
4890   tex: TglBitmap2D;
4891 begin
4892   tex := TglBitmap2D.Create;
4893   try
4894     tex.AssignFromBitmap(Bitmap);
4895     result := AddAlphaFromglBitmap(tex, Func, CustomData);
4896   finally
4897     tex.Free;
4898   end;
4899 end;
4900
4901 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4902 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4903   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4904 var
4905   RS: TResourceStream;
4906   TempPos: Integer;
4907   ResTypeStr: String;
4908   TempResType: PChar;
4909 begin
4910   if Assigned(ResType) then
4911     TempResType := ResType
4912   else
4913     begin
4914       TempPos := Pos('.', Resource);
4915       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4916       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));
4917       TempResType := PChar(ResTypeStr);
4918     end;
4919
4920   RS := TResourceStream.Create(Instance, Resource, TempResType);
4921   try
4922     result := AddAlphaFromStream(RS, Func, CustomData);
4923   finally
4924     RS.Free;
4925   end;
4926 end;
4927
4928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4929 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4930   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4931 var
4932   RS: TResourceStream;
4933 begin
4934   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4935   try
4936     result := AddAlphaFromStream(RS, Func, CustomData);
4937   finally
4938     RS.Free;
4939   end;
4940 end;
4941 {$ENDIF}
4942
4943 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4944 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4945 begin
4946   if TFormatDescriptor.Get(Format).IsCompressed then
4947     raise EglBitmapUnsupportedFormat.Create(Format);
4948   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4949 end;
4950
4951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4952 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4953 var
4954   FS: TFileStream;
4955 begin
4956   FS := TFileStream.Create(FileName, fmOpenRead);
4957   try
4958     result := AddAlphaFromStream(FS, aFunc, aArgs);
4959   finally
4960     FS.Free;
4961   end;
4962 end;
4963
4964 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4965 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4966 var
4967   tex: TglBitmap2D;
4968 begin
4969   tex := TglBitmap2D.Create(aStream);
4970   try
4971     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4972   finally
4973     tex.Free;
4974   end;
4975 end;
4976
4977 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4978 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4979 var
4980   DestData, DestData2, SourceData: pByte;
4981   TempHeight, TempWidth: Integer;
4982   SourceFD, DestFD: TFormatDescriptor;
4983   SourceMD, DestMD, DestMD2: Pointer;
4984
4985   FuncRec: TglBitmapFunctionRec;
4986 begin
4987   result := false;
4988
4989   Assert(Assigned(Data));
4990   Assert(Assigned(aBitmap));
4991   Assert(Assigned(aBitmap.Data));
4992
4993   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
4994     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
4995
4996     SourceFD := TFormatDescriptor.Get(aBitmap.Format);
4997     DestFD   := TFormatDescriptor.Get(Format);
4998
4999     if not Assigned(aFunc) then begin
5000       aFunc        := glBitmapAlphaFunc;
5001       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5002     end else
5003       FuncRec.Args := aArgs;
5004
5005     // Values
5006     TempHeight := aBitmap.FileHeight;
5007     TempWidth  := aBitmap.FileWidth;
5008
5009     FuncRec.Sender          := Self;
5010     FuncRec.Size            := Dimension;
5011     FuncRec.Position.Fields := FuncRec.Size.Fields;
5012
5013     DestData   := Data;
5014     DestData2  := Data;
5015     SourceData := aBitmap.Data;
5016
5017     // Mapping
5018     SourceFD.PreparePixel(FuncRec.Source);
5019     DestFD.PreparePixel  (FuncRec.Dest);
5020
5021     SourceMD := SourceFD.CreateMappingData;
5022     DestMD   := DestFD.CreateMappingData;
5023     DestMD2  := DestFD.CreateMappingData;
5024     try
5025       FuncRec.Position.Y := 0;
5026       while FuncRec.Position.Y < TempHeight do begin
5027         FuncRec.Position.X := 0;
5028         while FuncRec.Position.X < TempWidth do begin
5029           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5030           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);
5031           aFunc(FuncRec);
5032           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5033           inc(FuncRec.Position.X);
5034         end;
5035         inc(FuncRec.Position.Y);
5036       end;
5037     finally
5038       SourceFD.FreeMappingData(SourceMD);
5039       DestFD.FreeMappingData(DestMD);
5040       DestFD.FreeMappingData(DestMD2);
5041     end;
5042   end;
5043 end;
5044
5045 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5046 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5047 begin
5048   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5049 end;
5050
5051 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5052 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5053 var
5054   PixelData: TglBitmapPixelData;
5055 begin
5056   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5057   result := AddAlphaFromColorKeyFloat(
5058     aRed   / PixelData.Range.r,
5059     aGreen / PixelData.Range.g,
5060     aBlue  / PixelData.Range.b,
5061     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5062 end;
5063
5064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5065 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5066 var
5067   values: array[0..2] of Single;
5068   tmp: Cardinal;
5069   i: Integer;
5070   PixelData: TglBitmapPixelData;
5071 begin
5072   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5073   with PixelData do begin
5074     values[0] := aRed;
5075     values[1] := aGreen;
5076     values[2] := aBlue;
5077
5078     for i := 0 to 2 do begin
5079       tmp          := Trunc(Range.arr[i] * aDeviation);
5080       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5081       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));
5082     end;
5083     Data.a  := 0;
5084     Range.a := 0;
5085   end;
5086   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5087 end;
5088
5089 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5090 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5091 begin
5092   result := AddAlphaFromValueFloat(aAlpha / $FF);
5093 end;
5094
5095 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5096 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5097 var
5098   PixelData: TglBitmapPixelData;
5099 begin
5100   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5101   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5102 end;
5103
5104 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5105 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5106 var
5107   PixelData: TglBitmapPixelData;
5108 begin
5109   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5110   with PixelData do
5111     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5112   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5113 end;
5114
5115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5116 function TglBitmap.RemoveAlpha: Boolean;
5117 var
5118   FormatDesc: TFormatDescriptor;
5119 begin
5120   result := false;
5121   FormatDesc := TFormatDescriptor.Get(Format);
5122   if Assigned(Data) then begin
5123     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5124       raise EglBitmapUnsupportedFormat.Create(Format);
5125     result := ConvertTo(FormatDesc.WithoutAlpha);
5126   end;
5127 end;
5128
5129 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5130 function TglBitmap.Clone: TglBitmap;
5131 var
5132   Temp: TglBitmap;
5133   TempPtr: PByte;
5134   Size: Integer;
5135 begin
5136   result := nil;
5137   Temp := (ClassType.Create as TglBitmap);
5138   try
5139     // copy texture data if assigned
5140     if Assigned(Data) then begin
5141       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5142       GetMem(TempPtr, Size);
5143       try
5144         Move(Data^, TempPtr^, Size);
5145         Temp.SetDataPointer(TempPtr, Format, Width, Height);
5146       except
5147         FreeMem(TempPtr);
5148         raise;
5149       end;
5150     end else
5151       Temp.SetDataPointer(nil, Format, Width, Height);
5152
5153         // copy properties
5154     Temp.fID                      := ID;
5155     Temp.fTarget                  := Target;
5156     Temp.fFormat                  := Format;
5157     Temp.fMipMap                  := MipMap;
5158     Temp.fAnisotropic             := Anisotropic;
5159     Temp.fBorderColor             := fBorderColor;
5160     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;
5161     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5162     Temp.fFilterMin               := fFilterMin;
5163     Temp.fFilterMag               := fFilterMag;
5164     Temp.fWrapS                   := fWrapS;
5165     Temp.fWrapT                   := fWrapT;
5166     Temp.fWrapR                   := fWrapR;
5167     Temp.fFilename                := fFilename;
5168     Temp.fCustomName              := fCustomName;
5169     Temp.fCustomNameW             := fCustomNameW;
5170     Temp.fCustomData              := fCustomData;
5171
5172     result := Temp;
5173   except
5174     FreeAndNil(Temp);
5175     raise;
5176   end;
5177 end;
5178
5179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5180 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5181 var
5182   SourceFD, DestFD: TFormatDescriptor;
5183   SourcePD, DestPD: TglBitmapPixelData;
5184   ShiftData: TShiftData;
5185
5186   function CanCopyDirect: Boolean;
5187   begin
5188     result :=
5189       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5190       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5191       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5192       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5193   end;
5194
5195   function CanShift: Boolean;
5196   begin
5197     result :=
5198       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5199       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5200       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5201       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5202   end;
5203
5204   function GetShift(aSource, aDest: Cardinal) : ShortInt;
5205   begin
5206     result := 0;
5207     while (aSource > aDest) and (aSource > 0) do begin
5208       inc(result);
5209       aSource := aSource shr 1;
5210     end;
5211   end;
5212
5213 begin
5214   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5215     SourceFD := TFormatDescriptor.Get(Format);
5216     DestFD   := TFormatDescriptor.Get(aFormat);
5217
5218     SourceFD.PreparePixel(SourcePD);
5219     DestFD.PreparePixel  (DestPD);
5220
5221     if CanCopyDirect then
5222       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5223     else if CanShift then begin
5224       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5225       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5226       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5227       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5228       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5229     end else
5230       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5231   end else
5232     result := true;
5233 end;
5234
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5237 begin
5238   if aUseRGB or aUseAlpha then
5239     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5240       ((PtrInt(aUseAlpha) and 1) shl 1) or
5241        (PtrInt(aUseRGB)   and 1)      ));
5242 end;
5243
5244 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5245 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5246 begin
5247   fBorderColor[0] := aRed;
5248   fBorderColor[1] := aGreen;
5249   fBorderColor[2] := aBlue;
5250   fBorderColor[3] := aAlpha;
5251   if (ID > 0) then begin
5252     Bind(false);
5253     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5254   end;
5255 end;
5256
5257 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5258 procedure TglBitmap.FreeData;
5259 begin
5260   SetDataPointer(nil, tfEmpty);
5261 end;
5262
5263 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5264 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5265   const aAlpha: Byte);
5266 begin
5267   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5268 end;
5269
5270 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5271 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5272 var
5273   PixelData: TglBitmapPixelData;
5274 begin
5275   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5276   FillWithColorFloat(
5277     aRed   / PixelData.Range.r,
5278     aGreen / PixelData.Range.g,
5279     aBlue  / PixelData.Range.b,
5280     aAlpha / PixelData.Range.a);
5281 end;
5282
5283 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5284 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5285 var
5286   PixelData: TglBitmapPixelData;
5287 begin
5288   TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5289   with PixelData do begin
5290     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5291     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5292     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5293     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5294   end;
5295   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5296 end;
5297
5298 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5299 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5300 begin
5301   //check MIN filter
5302   case aMin of
5303     GL_NEAREST:
5304       fFilterMin := GL_NEAREST;
5305     GL_LINEAR:
5306       fFilterMin := GL_LINEAR;
5307     GL_NEAREST_MIPMAP_NEAREST:
5308       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5309     GL_LINEAR_MIPMAP_NEAREST:
5310       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5311     GL_NEAREST_MIPMAP_LINEAR:
5312       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5313     GL_LINEAR_MIPMAP_LINEAR:
5314       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5315     else
5316       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5317   end;
5318
5319   //check MAG filter
5320   case aMag of
5321     GL_NEAREST:
5322       fFilterMag := GL_NEAREST;
5323     GL_LINEAR:
5324       fFilterMag := GL_LINEAR;
5325     else
5326       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5327   end;
5328
5329   //apply filter
5330   if (ID > 0) then begin
5331     Bind(false);
5332     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5333
5334     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5335       case fFilterMin of
5336         GL_NEAREST, GL_LINEAR:
5337           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5338         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5339           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5340         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5341           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5342       end;
5343     end else
5344       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5345   end;
5346 end;
5347
5348 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5349 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5350
5351   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5352   begin
5353     case aValue of
5354       GL_CLAMP:
5355         aTarget := GL_CLAMP;
5356
5357       GL_REPEAT:
5358         aTarget := GL_REPEAT;
5359
5360       GL_CLAMP_TO_EDGE: begin
5361         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5362           aTarget := GL_CLAMP_TO_EDGE
5363         else
5364           aTarget := GL_CLAMP;
5365       end;
5366
5367       GL_CLAMP_TO_BORDER: begin
5368         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5369           aTarget := GL_CLAMP_TO_BORDER
5370         else
5371           aTarget := GL_CLAMP;
5372       end;
5373
5374       GL_MIRRORED_REPEAT: begin
5375         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5376           aTarget := GL_MIRRORED_REPEAT
5377         else
5378           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5379       end;
5380     else
5381       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5382     end;
5383   end;
5384
5385 begin
5386   CheckAndSetWrap(S, fWrapS);
5387   CheckAndSetWrap(T, fWrapT);
5388   CheckAndSetWrap(R, fWrapR);
5389
5390   if (ID > 0) then begin
5391     Bind(false);
5392     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5393     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5394     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5395   end;
5396 end;
5397
5398 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5399 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5400 begin
5401   if aEnableTextureUnit then
5402     glEnable(Target);
5403   if (ID > 0) then
5404     glBindTexture(Target, ID);
5405 end;
5406
5407 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5408 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5409 begin
5410   if aDisableTextureUnit then
5411     glDisable(Target);
5412   glBindTexture(Target, 0);
5413 end;
5414
5415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5416 constructor TglBitmap.Create;
5417 begin
5418 {$IFDEF GLB_NATIVE_OGL}
5419   glbReadOpenGLExtensions;
5420 {$ENDIF}
5421   if (ClassType = TglBitmap) then
5422     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5423   inherited Create;
5424 end;
5425
5426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5427 constructor TglBitmap.Create(const aFileName: String);
5428 begin
5429   Create;
5430   LoadFromFile(FileName);
5431 end;
5432
5433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5434 constructor TglBitmap.Create(const aStream: TStream);
5435 begin
5436   Create;
5437   LoadFromStream(aStream);
5438 end;
5439
5440 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5441 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5442 var
5443   Image: PByte;
5444   ImageSize: Integer;
5445 begin
5446   Create;
5447   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5448   GetMem(Image, ImageSize);
5449   try
5450     FillChar(Image^, ImageSize, #$FF);
5451     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5452   except
5453     FreeMem(Image);
5454     raise;
5455   end;
5456 end;
5457
5458 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5459 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5460   const aFunc: TglBitmapFunction; const aArgs: Pointer);
5461 begin
5462   Create;
5463   LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5464 end;
5465
5466 {$IFDEF GLB_DELPHI}
5467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5468 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5469 begin
5470   Create;
5471   LoadFromResource(aInstance, aResource, aResType);
5472 end;
5473
5474 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5475 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5476 begin
5477   Create;
5478   LoadFromResourceID(aInstance, aResourceID, aResType);
5479 end;
5480 {$ENDIF}
5481
5482 {$IFDEF GLB_SUPPORT_PNG_READ}
5483 {$IF DEFINED(GLB_SDL_IMAGE)}
5484 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5485 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5486 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5487 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5488 var
5489   Surface: PSDL_Surface;
5490   RWops: PSDL_RWops;
5491 begin
5492   result := false;
5493   RWops := glBitmapCreateRWops(aStream);
5494   try
5495     if IMG_isPNG(RWops) > 0 then begin
5496       Surface := IMG_LoadPNG_RW(RWops);
5497       try
5498         AssignFromSurface(Surface);
5499         result := true;
5500       finally
5501         SDL_FreeSurface(Surface);
5502       end;
5503     end;
5504   finally
5505     SDL_FreeRW(RWops);
5506   end;
5507 end;
5508
5509 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5510 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5511 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5512 begin
5513   TStream(png_get_io_ptr(png)).Read(buffer^, size);
5514 end;
5515
5516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5517 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5518 var
5519   StreamPos: Int64;
5520   signature: array [0..7] of byte;
5521   png: png_structp;
5522   png_info: png_infop;
5523
5524   TempHeight, TempWidth: Integer;
5525   Format: TglBitmapFormat;
5526
5527   png_data: pByte;
5528   png_rows: array of pByte;
5529   Row, LineSize: Integer;
5530 begin
5531   result := false;
5532
5533   if not init_libPNG then
5534     raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5535
5536   try
5537     // signature
5538     StreamPos := aStream.Position;
5539     aStream.Read(signature{%H-}, 8);
5540     aStream.Position := StreamPos;
5541
5542     if png_check_sig(@signature, 8) <> 0 then begin
5543       // png read struct
5544       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5545       if png = nil then
5546         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5547
5548       // png info
5549       png_info := png_create_info_struct(png);
5550       if png_info = nil then begin
5551         png_destroy_read_struct(@png, nil, nil);
5552         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5553       end;
5554
5555       // set read callback
5556       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5557
5558       // read informations
5559       png_read_info(png, png_info);
5560
5561       // size 
5562       TempHeight := png_get_image_height(png, png_info);
5563       TempWidth := png_get_image_width(png, png_info);
5564
5565       // format
5566       case png_get_color_type(png, png_info) of
5567         PNG_COLOR_TYPE_GRAY:
5568           Format := tfLuminance8;
5569         PNG_COLOR_TYPE_GRAY_ALPHA:
5570           Format := tfLuminance8Alpha8;
5571         PNG_COLOR_TYPE_RGB:
5572           Format := tfRGB8;
5573         PNG_COLOR_TYPE_RGB_ALPHA:
5574           Format := tfRGBA8;
5575         else
5576           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5577       end;
5578
5579       // cut upper 8 bit from 16 bit formats
5580       if png_get_bit_depth(png, png_info) > 8 then
5581         png_set_strip_16(png);
5582
5583       // expand bitdepth smaller than 8
5584       if png_get_bit_depth(png, png_info) < 8 then
5585         png_set_expand(png);
5586
5587       // allocating mem for scanlines
5588       LineSize := png_get_rowbytes(png, png_info);
5589       GetMem(png_data, TempHeight * LineSize);
5590       try
5591         SetLength(png_rows, TempHeight);
5592         for Row := Low(png_rows) to High(png_rows) do begin
5593           png_rows[Row] := png_data;
5594           Inc(png_rows[Row], Row * LineSize);
5595         end;
5596
5597         // read complete image into scanlines
5598         png_read_image(png, @png_rows[0]);
5599
5600         // read end
5601         png_read_end(png, png_info);
5602
5603         // destroy read struct
5604         png_destroy_read_struct(@png, @png_info, nil);
5605
5606         SetLength(png_rows, 0);
5607
5608         // set new data
5609         SetDataPointer(png_data, Format, TempWidth, TempHeight);
5610
5611         result := true;
5612       except
5613         FreeMem(png_data);
5614         raise;
5615       end;
5616     end;
5617   finally
5618     quit_libPNG;
5619   end;
5620 end;
5621
5622 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5623 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5624 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5625 var
5626   StreamPos: Int64;
5627   Png: TPNGObject;
5628   Header: Array[0..7] of Byte;
5629   Row, Col, PixSize, LineSize: Integer;
5630   NewImage, pSource, pDest, pAlpha: pByte;
5631   Format: TglBitmapInternalFormat;
5632
5633 const
5634   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5635
5636 begin
5637   result := false;
5638
5639   StreamPos := Stream.Position;
5640   Stream.Read(Header[0], SizeOf(Header));
5641   Stream.Position := StreamPos;
5642
5643   {Test if the header matches}
5644   if Header = PngHeader then begin
5645     Png := TPNGObject.Create;
5646     try
5647       Png.LoadFromStream(Stream);
5648
5649       case Png.Header.ColorType of
5650         COLOR_GRAYSCALE:
5651           Format := ifLuminance;
5652         COLOR_GRAYSCALEALPHA:
5653           Format := ifLuminanceAlpha;
5654         COLOR_RGB:
5655           Format := ifBGR8;
5656         COLOR_RGBALPHA:
5657           Format := ifBGRA8;
5658         else
5659           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5660       end;
5661
5662       PixSize := Trunc(FormatGetSize(Format));
5663       LineSize := Integer(Png.Header.Width) * PixSize;
5664
5665       GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5666       try
5667         pDest := NewImage;
5668
5669         case Png.Header.ColorType of
5670           COLOR_RGB, COLOR_GRAYSCALE:
5671             begin
5672               for Row := 0 to Png.Height -1 do begin
5673                 Move (Png.Scanline[Row]^, pDest^, LineSize);
5674                 Inc(pDest, LineSize);
5675               end;
5676             end;
5677           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5678             begin
5679               PixSize := PixSize -1;
5680
5681               for Row := 0 to Png.Height -1 do begin
5682                 pSource := Png.Scanline[Row];
5683                 pAlpha := pByte(Png.AlphaScanline[Row]);
5684
5685                 for Col := 0 to Png.Width -1 do begin
5686                   Move (pSource^, pDest^, PixSize);
5687                   Inc(pSource, PixSize);
5688                   Inc(pDest, PixSize);
5689
5690                   pDest^ := pAlpha^;
5691                   inc(pAlpha);
5692                   Inc(pDest);
5693                 end;
5694               end;
5695             end;
5696           else
5697             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5698         end;
5699
5700         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5701
5702         result := true;
5703       except
5704         FreeMem(NewImage);
5705         raise;
5706       end;
5707     finally
5708       Png.Free;
5709     end;
5710   end;
5711 end;
5712 {$IFEND}
5713 {$ENDIF}
5714
5715 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5716 {$IFDEF GLB_LIB_PNG}
5717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5718 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5719 begin
5720   TStream(png_get_io_ptr(png)).Write(buffer^, size);
5721 end;
5722 {$ENDIF}
5723
5724 {$IF DEFINED(GLB_LIB_PNG)}
5725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5726 procedure TglBitmap.SavePNG(const aStream: TStream);
5727 var
5728   png: png_structp;
5729   png_info: png_infop;
5730   png_rows: array of pByte;
5731   LineSize: Integer;
5732   ColorType: Integer;
5733   Row: Integer;
5734   FormatDesc: TFormatDescriptor;
5735 begin
5736   if not (ftPNG in FormatGetSupportedFiles(Format)) then
5737     raise EglBitmapUnsupportedFormat.Create(Format);
5738
5739   if not init_libPNG then
5740     raise Exception.Create('unable to initialize libPNG.');
5741
5742   try
5743     case Format of
5744       tfAlpha8, tfLuminance8:
5745         ColorType := PNG_COLOR_TYPE_GRAY;
5746       tfLuminance8Alpha8:
5747         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5748       tfBGR8, tfRGB8:
5749         ColorType := PNG_COLOR_TYPE_RGB;
5750       tfBGRA8, tfRGBA8:
5751         ColorType := PNG_COLOR_TYPE_RGBA;
5752       else
5753         raise EglBitmapUnsupportedFormat.Create(Format);
5754     end;
5755
5756     FormatDesc := TFormatDescriptor.Get(Format);
5757     LineSize := FormatDesc.GetSize(Width, 1);
5758
5759     // creating array for scanline
5760     SetLength(png_rows, Height);
5761     try
5762       for Row := 0 to Height - 1 do begin
5763         png_rows[Row] := Data;
5764         Inc(png_rows[Row], Row * LineSize)
5765       end;
5766
5767       // write struct
5768       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5769       if png = nil then
5770         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5771
5772       // create png info
5773       png_info := png_create_info_struct(png);
5774       if png_info = nil then begin
5775         png_destroy_write_struct(@png, nil);
5776         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5777       end;
5778
5779       // set read callback
5780       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5781
5782       // set compression
5783       png_set_compression_level(png, 6);
5784
5785       if Format in [tfBGR8, tfBGRA8] then
5786         png_set_bgr(png);
5787
5788       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5789       png_write_info(png, png_info);
5790       png_write_image(png, @png_rows[0]);
5791       png_write_end(png, png_info);
5792       png_destroy_write_struct(@png, @png_info);
5793     finally
5794       SetLength(png_rows, 0);
5795     end;
5796   finally
5797     quit_libPNG;
5798   end;
5799 end;
5800
5801 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5802 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5803 procedure TglBitmap.SavePNG(const aStream: TStream);
5804 var
5805   Png: TPNGObject;
5806
5807   pSource, pDest: pByte;
5808   X, Y, PixSize: Integer;
5809   ColorType: Cardinal;
5810   Alpha: Boolean;
5811
5812   pTemp: pByte;
5813   Temp: Byte;
5814 begin
5815   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5816     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5817
5818   case FInternalFormat of
5819     ifAlpha, ifLuminance, ifDepth8: begin
5820       ColorType := COLOR_GRAYSCALE;
5821       PixSize := 1;
5822       Alpha := false;
5823     end;
5824     ifLuminanceAlpha: begin
5825       ColorType := COLOR_GRAYSCALEALPHA;
5826       PixSize := 1;
5827       Alpha := true;
5828     end;
5829     ifBGR8, ifRGB8: begin
5830       ColorType := COLOR_RGB;
5831       PixSize := 3;
5832       Alpha := false;
5833     end;
5834     ifBGRA8, ifRGBA8: begin
5835       ColorType := COLOR_RGBALPHA;
5836       PixSize := 3;
5837       Alpha := true
5838     end;
5839   else
5840     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5841   end;
5842
5843   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5844   try
5845     // Copy ImageData
5846     pSource := Data;
5847     for Y := 0 to Height -1 do begin
5848       pDest := png.ScanLine[Y];
5849       for X := 0 to Width -1 do begin
5850         Move(pSource^, pDest^, PixSize);
5851         Inc(pDest, PixSize);
5852         Inc(pSource, PixSize);
5853         if Alpha then begin
5854           png.AlphaScanline[Y]^[X] := pSource^;
5855           Inc(pSource);
5856         end;
5857       end;
5858
5859       // convert RGB line to BGR
5860       if InternalFormat in [ifRGB8, ifRGBA8] then begin
5861         pTemp := png.ScanLine[Y];
5862         for X := 0 to Width -1 do begin
5863           Temp := pByteArray(pTemp)^[0];
5864           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5865           pByteArray(pTemp)^[2] := Temp;
5866           Inc(pTemp, 3);
5867         end;
5868       end;
5869     end;
5870
5871     // Save to Stream
5872     Png.CompressionLevel := 6;
5873     Png.SaveToStream(Stream);
5874   finally
5875     FreeAndNil(Png);
5876   end;
5877 end;
5878 {$IFEND}
5879 {$ENDIF}
5880
5881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5882 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5883 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5884 {$IFDEF GLB_LIB_JPEG}
5885 type
5886   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5887   glBitmap_libJPEG_source_mgr = record
5888     pub: jpeg_source_mgr;
5889
5890     SrcStream: TStream;
5891     SrcBuffer: array [1..4096] of byte;
5892   end;
5893
5894   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5895   glBitmap_libJPEG_dest_mgr = record
5896     pub: jpeg_destination_mgr;
5897
5898     DestStream: TStream;
5899     DestBuffer: array [1..4096] of byte;
5900   end;
5901
5902 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5903 begin
5904   //DUMMY
5905 end;
5906
5907
5908 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5909 begin
5910   //DUMMY
5911 end;
5912
5913
5914 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5915 begin
5916   //DUMMY
5917 end;
5918
5919 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5920 begin
5921   //DUMMY
5922 end;
5923
5924
5925 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5926 begin
5927   //DUMMY
5928 end;
5929
5930
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5933 var
5934   src: glBitmap_libJPEG_source_mgr_ptr;
5935   bytes: integer;
5936 begin
5937   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5938
5939   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5940         if (bytes <= 0) then begin
5941                 src^.SrcBuffer[1] := $FF;
5942                 src^.SrcBuffer[2] := JPEG_EOI;
5943                 bytes := 2;
5944         end;
5945
5946         src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5947         src^.pub.bytes_in_buffer := bytes;
5948
5949   result := true;
5950 end;
5951
5952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5953 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5954 var
5955   src: glBitmap_libJPEG_source_mgr_ptr;
5956 begin
5957   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5958
5959   if num_bytes > 0 then begin
5960     // wanted byte isn't in buffer so set stream position and read buffer
5961     if num_bytes > src^.pub.bytes_in_buffer then begin
5962       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5963       src^.pub.fill_input_buffer(cinfo);
5964     end else begin
5965       // wanted byte is in buffer so only skip
5966                 inc(src^.pub.next_input_byte, num_bytes);
5967                 dec(src^.pub.bytes_in_buffer, num_bytes);
5968     end;
5969   end;
5970 end;
5971
5972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5973 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5974 var
5975   dest: glBitmap_libJPEG_dest_mgr_ptr;
5976 begin
5977   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5978
5979   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5980     // write complete buffer
5981     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5982
5983     // reset buffer
5984     dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5985     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5986   end;
5987
5988   result := true;
5989 end;
5990
5991 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5992 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5993 var
5994   Idx: Integer;
5995   dest: glBitmap_libJPEG_dest_mgr_ptr;
5996 begin
5997   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5998
5999   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6000     // check for endblock
6001     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6002       // write endblock
6003       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6004
6005       // leave
6006       break;
6007     end else
6008       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6009   end;
6010 end;
6011 {$ENDIF}
6012
6013 {$IFDEF GLB_SUPPORT_JPEG_READ}
6014 {$IF DEFINED(GLB_SDL_IMAGE)}
6015 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6016 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6017 var
6018   Surface: PSDL_Surface;
6019   RWops: PSDL_RWops;
6020 begin
6021   result := false;
6022
6023   RWops := glBitmapCreateRWops(aStream);
6024   try
6025     if IMG_isJPG(RWops) > 0 then begin
6026       Surface := IMG_LoadJPG_RW(RWops);
6027       try
6028         AssignFromSurface(Surface);
6029         result := true;
6030       finally
6031         SDL_FreeSurface(Surface);
6032       end;
6033     end;
6034   finally
6035     SDL_FreeRW(RWops);
6036   end;
6037 end;
6038
6039 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6041 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6042 var
6043   StreamPos: Int64;
6044   Temp: array[0..1]of Byte;
6045
6046   jpeg: jpeg_decompress_struct;
6047   jpeg_err: jpeg_error_mgr;
6048
6049   IntFormat: TglBitmapFormat;
6050   pImage: pByte;
6051   TempHeight, TempWidth: Integer;
6052
6053   pTemp: pByte;
6054   Row: Integer;
6055
6056   FormatDesc: TFormatDescriptor;
6057 begin
6058   result := false;
6059
6060   if not init_libJPEG then
6061     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6062
6063   try
6064     // reading first two bytes to test file and set cursor back to begin
6065     StreamPos := aStream.Position;
6066     aStream.Read({%H-}Temp[0], 2);
6067     aStream.Position := StreamPos;
6068
6069     // if Bitmap then read file.
6070     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6071       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6072       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6073
6074       // error managment
6075       jpeg.err := jpeg_std_error(@jpeg_err);
6076       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6077       jpeg_err.output_message := glBitmap_libJPEG_output_message;
6078
6079       // decompression struct
6080       jpeg_create_decompress(@jpeg);
6081
6082       // allocation space for streaming methods
6083       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6084
6085       // seeting up custom functions
6086       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6087         pub.init_source       := glBitmap_libJPEG_init_source;
6088         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6089         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;
6090         pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6091         pub.term_source       := glBitmap_libJPEG_term_source;
6092
6093         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read
6094         pub.next_input_byte := nil;   // until buffer loaded
6095
6096         SrcStream := aStream;
6097       end;
6098
6099       // set global decoding state
6100       jpeg.global_state := DSTATE_START;
6101
6102       // read header of jpeg
6103       jpeg_read_header(@jpeg, false);
6104
6105       // setting output parameter
6106       case jpeg.jpeg_color_space of
6107         JCS_GRAYSCALE:
6108           begin
6109             jpeg.out_color_space := JCS_GRAYSCALE;
6110             IntFormat := tfLuminance8;
6111           end;
6112         else
6113           jpeg.out_color_space := JCS_RGB;
6114           IntFormat := tfRGB8;
6115       end;
6116
6117       // reading image
6118       jpeg_start_decompress(@jpeg);
6119
6120       TempHeight := jpeg.output_height;
6121       TempWidth := jpeg.output_width;
6122
6123       FormatDesc := TFormatDescriptor.Get(IntFormat);
6124
6125       // creating new image
6126       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6127       try
6128         pTemp := pImage;
6129
6130         for Row := 0 to TempHeight -1 do begin
6131           jpeg_read_scanlines(@jpeg, @pTemp, 1);
6132           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6133         end;
6134
6135         // finish decompression
6136         jpeg_finish_decompress(@jpeg);
6137
6138         // destroy decompression
6139         jpeg_destroy_decompress(@jpeg);
6140
6141         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6142
6143         result := true;
6144       except
6145         FreeMem(pImage);
6146         raise;
6147       end;
6148     end;
6149   finally
6150     quit_libJPEG;
6151   end;
6152 end;
6153
6154 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6156 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6157 var
6158   bmp: TBitmap;
6159   jpg: TJPEGImage;
6160   StreamPos: Int64;
6161   Temp: array[0..1]of Byte;
6162 begin
6163   result := false;
6164
6165   // reading first two bytes to test file and set cursor back to begin
6166   StreamPos := Stream.Position;
6167   Stream.Read(Temp[0], 2);
6168   Stream.Position := StreamPos;
6169
6170   // if Bitmap then read file.
6171   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6172     bmp := TBitmap.Create;
6173     try
6174       jpg := TJPEGImage.Create;
6175       try
6176         jpg.LoadFromStream(Stream);
6177         bmp.Assign(jpg);
6178         result := AssignFromBitmap(bmp);
6179       finally
6180         jpg.Free;
6181       end;
6182     finally
6183       bmp.Free;
6184     end;
6185   end;
6186 end;
6187 {$IFEND}
6188 {$ENDIF}
6189
6190 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6191 {$IF DEFINED(GLB_LIB_JPEG)}
6192 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6193 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6194 var
6195   jpeg: jpeg_compress_struct;
6196   jpeg_err: jpeg_error_mgr;
6197   Row: Integer;
6198   pTemp, pTemp2: pByte;
6199
6200   procedure CopyRow(pDest, pSource: pByte);
6201   var
6202     X: Integer;
6203   begin
6204     for X := 0 to Width - 1 do begin
6205       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6206       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6207       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6208       Inc(pDest, 3);
6209       Inc(pSource, 3);
6210     end;
6211   end;
6212
6213 begin
6214   if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6215     raise EglBitmapUnsupportedFormat.Create(Format);
6216
6217   if not init_libJPEG then
6218     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6219
6220   try
6221     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6222     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6223
6224     // error managment
6225     jpeg.err := jpeg_std_error(@jpeg_err);
6226     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;
6227     jpeg_err.output_message := glBitmap_libJPEG_output_message;
6228
6229     // compression struct
6230     jpeg_create_compress(@jpeg);
6231
6232     // allocation space for streaming methods
6233     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6234
6235     // seeting up custom functions
6236     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6237       pub.init_destination    := glBitmap_libJPEG_init_destination;
6238       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6239       pub.term_destination    := glBitmap_libJPEG_term_destination;
6240
6241       pub.next_output_byte  := @DestBuffer[1];
6242       pub.free_in_buffer    := Length(DestBuffer);
6243
6244       DestStream := aStream;
6245     end;
6246
6247     // very important state
6248     jpeg.global_state := CSTATE_START;
6249     jpeg.image_width  := Width;
6250     jpeg.image_height := Height;
6251     case Format of
6252       tfAlpha8, tfLuminance8: begin
6253         jpeg.input_components := 1;
6254         jpeg.in_color_space   := JCS_GRAYSCALE;
6255       end;
6256       tfRGB8, tfBGR8: begin
6257         jpeg.input_components := 3;
6258         jpeg.in_color_space   := JCS_RGB;
6259       end;
6260     end;
6261
6262     jpeg_set_defaults(@jpeg);
6263     jpeg_set_quality(@jpeg, 95, true);
6264     jpeg_start_compress(@jpeg, true);
6265     pTemp := Data;
6266
6267     if Format = tfBGR8 then
6268       GetMem(pTemp2, fRowSize)
6269     else
6270       pTemp2 := pTemp;
6271
6272     try
6273       for Row := 0 to jpeg.image_height -1 do begin
6274         // prepare row
6275         if Format = tfBGR8 then
6276           CopyRow(pTemp2, pTemp)
6277         else
6278           pTemp2 := pTemp;
6279
6280         // write row
6281         jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6282         inc(pTemp, fRowSize);
6283       end;
6284     finally
6285       // free memory
6286       if Format = tfBGR8 then
6287         FreeMem(pTemp2);
6288     end;
6289     jpeg_finish_compress(@jpeg);
6290     jpeg_destroy_compress(@jpeg);
6291   finally
6292     quit_libJPEG;
6293   end;
6294 end;
6295
6296 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6298 procedure TglBitmap.SaveJPEG(Stream: TStream);
6299 var
6300   Bmp: TBitmap;
6301   Jpg: TJPEGImage;
6302 begin
6303   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6304     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6305
6306   Bmp := TBitmap.Create;
6307   try
6308     Jpg := TJPEGImage.Create;
6309     try
6310       AssignToBitmap(Bmp);
6311       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6312         Jpg.Grayscale := true;
6313         Jpg.PixelFormat := jf8Bit;
6314       end;
6315       Jpg.Assign(Bmp);
6316       Jpg.SaveToStream(Stream);
6317     finally
6318       FreeAndNil(Jpg);
6319     end;
6320   finally
6321     FreeAndNil(Bmp);
6322   end;
6323 end;
6324 {$ENDIF}
6325 {$ENDIF}
6326
6327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6328 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6329 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6330 const
6331   BMP_MAGIC          = $4D42;
6332
6333   BMP_COMP_RGB       = 0;
6334   BMP_COMP_RLE8      = 1;
6335   BMP_COMP_RLE4      = 2;
6336   BMP_COMP_BITFIELDS = 3;
6337
6338 type
6339   TBMPHeader = packed record
6340     bfType: Word;
6341     bfSize: Cardinal;
6342     bfReserved1: Word;
6343     bfReserved2: Word;
6344     bfOffBits: Cardinal;
6345   end;
6346
6347   TBMPInfo = packed record
6348     biSize: Cardinal;
6349     biWidth: Longint;
6350     biHeight: Longint;
6351     biPlanes: Word;
6352     biBitCount: Word;
6353     biCompression: Cardinal;
6354     biSizeImage: Cardinal;
6355     biXPelsPerMeter: Longint;
6356     biYPelsPerMeter: Longint;
6357     biClrUsed: Cardinal;
6358     biClrImportant: Cardinal;
6359   end;
6360
6361 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6362 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6363
6364   //////////////////////////////////////////////////////////////////////////////////////////////////
6365   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6366   begin
6367     result := tfEmpty;
6368     aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6369     FillChar(aMask{%H-}, SizeOf(aMask), 0);
6370
6371     //Read Compression
6372     case aInfo.biCompression of
6373       BMP_COMP_RLE4,
6374       BMP_COMP_RLE8: begin
6375         raise EglBitmapException.Create('RLE compression is not supported');
6376       end;
6377       BMP_COMP_BITFIELDS: begin
6378         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6379           aStream.Read(aMask.r, SizeOf(aMask.r));
6380           aStream.Read(aMask.g, SizeOf(aMask.g));
6381           aStream.Read(aMask.b, SizeOf(aMask.b));
6382           aStream.Read(aMask.a, SizeOf(aMask.a));
6383         end else
6384           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6385       end;
6386     end;
6387
6388     //get suitable format
6389     case aInfo.biBitCount of
6390        8: result := tfLuminance8;
6391       16: result := tfBGR5;
6392       24: result := tfBGR8;
6393       32: result := tfBGRA8;
6394     end;
6395   end;
6396
6397   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6398   var
6399     i, c: Integer;
6400     ColorTable: TbmpColorTable;
6401   begin
6402     result := nil;
6403     if (aInfo.biBitCount >= 16) then
6404       exit;
6405     aFormat := tfLuminance8;
6406     c := aInfo.biClrUsed;
6407     if (c = 0) then
6408       c := 1 shl aInfo.biBitCount;
6409     SetLength(ColorTable, c);
6410     for i := 0 to c-1 do begin
6411       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6412       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6413         aFormat := tfRGB8;
6414     end;
6415
6416     result := TbmpColorTableFormat.Create;
6417     result.PixelSize  := aInfo.biBitCount / 8;
6418     result.ColorTable := ColorTable;
6419     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);
6420   end;
6421
6422   //////////////////////////////////////////////////////////////////////////////////////////////////
6423   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6424     const aInfo: TBMPInfo): TbmpBitfieldFormat;
6425   var
6426     TmpFormat: TglBitmapFormat;
6427     FormatDesc: TFormatDescriptor;
6428   begin
6429     result := nil;
6430     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6431       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6432         FormatDesc := TFormatDescriptor.Get(TmpFormat);
6433         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6434           aFormat := FormatDesc.Format;
6435           exit;
6436         end;
6437       end;
6438
6439       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6440         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6441       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6442         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6443
6444       result := TbmpBitfieldFormat.Create;
6445       result.PixelSize := aInfo.biBitCount / 8;
6446       result.RedMask   := aMask.r;
6447       result.GreenMask := aMask.g;
6448       result.BlueMask  := aMask.b;
6449       result.AlphaMask := aMask.a;
6450     end;
6451   end;
6452
6453 var
6454   //simple types
6455   StartPos: Int64;
6456   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6457   PaddingBuff: Cardinal;
6458   LineBuf, ImageData, TmpData: PByte;
6459   SourceMD, DestMD: Pointer;
6460   BmpFormat: TglBitmapFormat;
6461
6462   //records
6463   Mask: TglBitmapColorRec;
6464   Header: TBMPHeader;
6465   Info: TBMPInfo;
6466
6467   //classes
6468   SpecialFormat: TFormatDescriptor;
6469   FormatDesc: TFormatDescriptor;
6470
6471   //////////////////////////////////////////////////////////////////////////////////////////////////
6472   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6473   var
6474     i: Integer;
6475     Pixel: TglBitmapPixelData;
6476   begin
6477     aStream.Read(aLineBuf^, rbLineSize);
6478     SpecialFormat.PreparePixel(Pixel);
6479     for i := 0 to Info.biWidth-1 do begin
6480       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6481       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6482       FormatDesc.Map(Pixel, aData, DestMD);
6483     end;
6484   end;
6485
6486 begin
6487   result        := false;
6488   BmpFormat     := tfEmpty;
6489   SpecialFormat := nil;
6490   LineBuf       := nil;
6491   SourceMD      := nil;
6492   DestMD        := nil;
6493
6494   // Header
6495   StartPos := aStream.Position;
6496   aStream.Read(Header{%H-}, SizeOf(Header));
6497
6498   if Header.bfType = BMP_MAGIC then begin
6499     try try
6500       BmpFormat        := ReadInfo(Info, Mask);
6501       SpecialFormat    := ReadColorTable(BmpFormat, Info);
6502       if not Assigned(SpecialFormat) then
6503         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);
6504       aStream.Position := StartPos + Header.bfOffBits;
6505
6506       if (BmpFormat <> tfEmpty) then begin
6507         FormatDesc := TFormatDescriptor.Get(BmpFormat);
6508         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6509         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6510         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6511
6512         //get Memory
6513         DestMD    := FormatDesc.CreateMappingData;
6514         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6515         GetMem(ImageData, ImageSize);
6516         if Assigned(SpecialFormat) then begin
6517           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6518           SourceMD := SpecialFormat.CreateMappingData;
6519         end;
6520
6521         //read Data
6522         try try
6523           FillChar(ImageData^, ImageSize, $FF);
6524           TmpData := ImageData;
6525           if (Info.biHeight > 0) then
6526             Inc(TmpData, wbLineSize * (Info.biHeight-1));
6527           for i := 0 to Abs(Info.biHeight)-1 do begin
6528             if Assigned(SpecialFormat) then
6529               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data
6530             else
6531               aStream.Read(TmpData^, wbLineSize);   //else only read data
6532             if (Info.biHeight > 0) then
6533               dec(TmpData, wbLineSize)
6534             else
6535               inc(TmpData, wbLineSize);
6536             aStream.Read(PaddingBuff{%H-}, Padding);
6537           end;
6538           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6539           result := true;
6540         finally
6541           if Assigned(LineBuf) then
6542             FreeMem(LineBuf);
6543           if Assigned(SourceMD) then
6544             SpecialFormat.FreeMappingData(SourceMD);
6545           FormatDesc.FreeMappingData(DestMD);
6546         end;
6547         except
6548           FreeMem(ImageData);
6549           raise;
6550         end;
6551       end else
6552         raise EglBitmapException.Create('LoadBMP - No suitable format found');
6553     except
6554       aStream.Position := StartPos;
6555       raise;
6556     end;
6557     finally
6558       FreeAndNil(SpecialFormat);
6559     end;
6560   end
6561     else aStream.Position := StartPos;
6562 end;
6563
6564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6565 procedure TglBitmap.SaveBMP(const aStream: TStream);
6566 var
6567   Header: TBMPHeader;
6568   Info: TBMPInfo;
6569   Converter: TbmpColorTableFormat;
6570   FormatDesc: TFormatDescriptor;
6571   SourceFD, DestFD: Pointer;
6572   pData, srcData, dstData, ConvertBuffer: pByte;
6573
6574   Pixel: TglBitmapPixelData;
6575   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6576   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6577
6578   PaddingBuff: Cardinal;
6579
6580   function GetLineWidth : Integer;
6581   begin
6582     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6583   end;
6584
6585 begin
6586   if not (ftBMP in FormatGetSupportedFiles(Format)) then
6587     raise EglBitmapUnsupportedFormat.Create(Format);
6588
6589   Converter  := nil;
6590   FormatDesc := TFormatDescriptor.Get(Format);
6591   ImageSize  := FormatDesc.GetSize(Dimension);
6592
6593   FillChar(Header{%H-}, SizeOf(Header), 0);
6594   Header.bfType      := BMP_MAGIC;
6595   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;
6596   Header.bfReserved1 := 0;
6597   Header.bfReserved2 := 0;
6598   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);
6599
6600   FillChar(Info{%H-}, SizeOf(Info), 0);
6601   Info.biSize        := SizeOf(Info);
6602   Info.biWidth       := Width;
6603   Info.biHeight      := Height;
6604   Info.biPlanes      := 1;
6605   Info.biCompression := BMP_COMP_RGB;
6606   Info.biSizeImage   := ImageSize;
6607
6608   try
6609     case Format of
6610       tfLuminance4: begin
6611         Info.biBitCount  := 4;
6612         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);
6613         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6614         Converter           := TbmpColorTableFormat.Create;
6615         Converter.PixelSize := 0.5;
6616         Converter.Format    := Format;
6617         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);
6618         Converter.CreateColorTable;
6619       end;
6620
6621       tfR3G3B2, tfLuminance8: begin
6622         Info.biBitCount  :=  8;
6623         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);
6624         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6625         Converter           := TbmpColorTableFormat.Create;
6626         Converter.PixelSize := 1;
6627         Converter.Format    := Format;
6628         if (Format = tfR3G3B2) then begin
6629           Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6630           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6631         end else
6632           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6633         Converter.CreateColorTable;
6634       end;
6635
6636       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6637       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6638         Info.biBitCount    := 16;
6639         Info.biCompression := BMP_COMP_BITFIELDS;
6640       end;
6641
6642       tfBGR8, tfRGB8: begin
6643         Info.biBitCount := 24;
6644       end;
6645
6646       tfRGB10, tfRGB10A2, tfRGBA8,
6647       tfBGR10, tfBGR10A2, tfBGRA8: begin
6648         Info.biBitCount    := 32;
6649         Info.biCompression := BMP_COMP_BITFIELDS;
6650       end;
6651     else
6652       raise EglBitmapUnsupportedFormat.Create(Format);
6653     end;
6654     Info.biXPelsPerMeter := 2835;
6655     Info.biYPelsPerMeter := 2835;
6656
6657     // prepare bitmasks
6658     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6659       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);
6660       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6661
6662       RedMask    := FormatDesc.RedMask;
6663       GreenMask  := FormatDesc.GreenMask;
6664       BlueMask   := FormatDesc.BlueMask;
6665       AlphaMask  := FormatDesc.AlphaMask;
6666     end;
6667
6668     // headers
6669     aStream.Write(Header, SizeOf(Header));
6670     aStream.Write(Info, SizeOf(Info));
6671
6672     // colortable
6673     if Assigned(Converter) then
6674       aStream.Write(Converter.ColorTable[0].b,
6675         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6676
6677     // bitmasks
6678     if Info.biCompression = BMP_COMP_BITFIELDS then begin
6679       aStream.Write(RedMask,   SizeOf(Cardinal));
6680       aStream.Write(GreenMask, SizeOf(Cardinal));
6681       aStream.Write(BlueMask,  SizeOf(Cardinal));
6682       aStream.Write(AlphaMask, SizeOf(Cardinal));
6683     end;
6684
6685     // image data
6686     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);
6687     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);
6688     Padding     := GetLineWidth - wbLineSize;
6689     PaddingBuff := 0;
6690
6691     pData := Data;
6692     inc(pData, (Height-1) * rbLineSize);
6693
6694     // prepare row buffer. But only for RGB because RGBA supports color masks
6695     // so it's possible to change color within the image.
6696     if Assigned(Converter) then begin
6697       FormatDesc.PreparePixel(Pixel);
6698       GetMem(ConvertBuffer, wbLineSize);
6699       SourceFD := FormatDesc.CreateMappingData;
6700       DestFD   := Converter.CreateMappingData;
6701     end else
6702       ConvertBuffer := nil;
6703
6704     try
6705       for LineIdx := 0 to Height - 1 do begin
6706         // preparing row
6707         if Assigned(Converter) then begin
6708           srcData := pData;
6709           dstData := ConvertBuffer;
6710           for PixelIdx := 0 to Info.biWidth-1 do begin
6711             FormatDesc.Unmap(srcData, Pixel, SourceFD);
6712             glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6713             Converter.Map(Pixel, dstData, DestFD);
6714           end;
6715           aStream.Write(ConvertBuffer^, wbLineSize);
6716         end else begin
6717           aStream.Write(pData^, rbLineSize);
6718         end;
6719         dec(pData, rbLineSize);
6720         if (Padding > 0) then
6721           aStream.Write(PaddingBuff, Padding);
6722       end;
6723     finally
6724       // destroy row buffer
6725       if Assigned(ConvertBuffer) then begin
6726         FormatDesc.FreeMappingData(SourceFD);
6727         Converter.FreeMappingData(DestFD);
6728         FreeMem(ConvertBuffer);
6729       end;
6730     end;
6731   finally
6732     if Assigned(Converter) then
6733       Converter.Free;
6734   end;
6735 end;
6736
6737 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6738 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6739 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6740 type
6741   TTGAHeader = packed record
6742     ImageID: Byte;
6743     ColorMapType: Byte;
6744     ImageType: Byte;
6745     //ColorMapSpec: Array[0..4] of Byte;
6746     ColorMapStart: Word;
6747     ColorMapLength: Word;
6748     ColorMapEntrySize: Byte;
6749     OrigX: Word;
6750     OrigY: Word;
6751     Width: Word;
6752     Height: Word;
6753     Bpp: Byte;
6754     ImageDesc: Byte;
6755   end;
6756
6757 const
6758   TGA_UNCOMPRESSED_RGB  =  2;
6759   TGA_UNCOMPRESSED_GRAY =  3;
6760   TGA_COMPRESSED_RGB    = 10;
6761   TGA_COMPRESSED_GRAY   = 11;
6762
6763   TGA_NONE_COLOR_TABLE  = 0;
6764
6765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6766 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6767 var
6768   Header: TTGAHeader;
6769   ImageData: System.PByte;
6770   StartPosition: Int64;
6771   PixelSize, LineSize: Integer;
6772   tgaFormat: TglBitmapFormat;
6773   FormatDesc: TFormatDescriptor;
6774   Counter: packed record
6775     X, Y: packed record
6776       low, high, dir: Integer;
6777     end;
6778   end;
6779
6780 const
6781   CACHE_SIZE = $4000;
6782
6783   ////////////////////////////////////////////////////////////////////////////////////////
6784   procedure ReadUncompressed;
6785   var
6786     i, j: Integer;
6787     buf, tmp1, tmp2: System.PByte;
6788   begin
6789     buf := nil;
6790     if (Counter.X.dir < 0) then
6791       buf := GetMem(LineSize);
6792     try
6793       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6794         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6795         if (Counter.X.dir < 0) then begin               //flip X
6796           aStream.Read(buf^, LineSize);
6797           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line
6798           for i := 0 to Header.Width-1 do begin         //for all pixels in line
6799             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel
6800               tmp1^ := tmp2^;
6801               inc(tmp1);
6802               inc(tmp2);
6803             end;
6804             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward
6805           end;
6806         end else
6807           aStream.Read(tmp1^, LineSize);
6808         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index
6809       end;
6810     finally
6811       if Assigned(buf) then
6812         FreeMem(buf);
6813     end;
6814   end;
6815
6816   ////////////////////////////////////////////////////////////////////////////////////////
6817   procedure ReadCompressed;
6818
6819     /////////////////////////////////////////////////////////////////
6820     var
6821       TmpData: System.PByte;
6822       LinePixelsRead: Integer;
6823     procedure CheckLine;
6824     begin
6825       if (LinePixelsRead >= Header.Width) then begin
6826         LinePixelsRead := 0;
6827         inc(Counter.Y.low, Counter.Y.dir);                //next line index
6828         TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6829         if (Counter.X.dir < 0) then                       //if x flipped then
6830           TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6831       end;
6832     end;
6833
6834     /////////////////////////////////////////////////////////////////
6835     var
6836       Cache: PByte;
6837       CacheSize, CachePos: Integer;
6838     procedure CachedRead(out Buffer; Count: Integer);
6839     var
6840       BytesRead: Integer;
6841     begin
6842       if (CachePos + Count > CacheSize) then begin
6843         //if buffer overflow save non read bytes
6844         BytesRead := 0;
6845         if (CacheSize - CachePos > 0) then begin
6846           BytesRead := CacheSize - CachePos;
6847           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6848           inc(CachePos, BytesRead);
6849         end;
6850
6851         //load cache from file
6852         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6853         aStream.Read(Cache^, CacheSize);
6854         CachePos := 0;
6855
6856         //read rest of requested bytes
6857         if (Count - BytesRead > 0) then begin
6858           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6859           inc(CachePos, Count - BytesRead);
6860         end;
6861       end else begin
6862         //if no buffer overflow just read the data
6863         Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6864         inc(CachePos, Count);
6865       end;
6866     end;
6867
6868     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6869     begin
6870       case PixelSize of
6871         1: begin
6872           aBuffer^ := aData^;
6873           inc(aBuffer, Counter.X.dir);
6874         end;
6875         2: begin
6876           PWord(aBuffer)^ := PWord(aData)^;
6877           inc(aBuffer, 2 * Counter.X.dir);
6878         end;
6879         3: begin
6880           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6881           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6882           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6883           inc(aBuffer, 3 * Counter.X.dir);
6884         end;
6885         4: begin
6886           PCardinal(aBuffer)^ := PCardinal(aData)^;
6887           inc(aBuffer, 4 * Counter.X.dir);
6888         end;
6889       end;
6890     end;
6891
6892   var
6893     TotalPixelsToRead, TotalPixelsRead: Integer;
6894     Temp: Byte;
6895     buf: array [0..3] of Byte; //1 pixel is max 32bit long
6896     PixelRepeat: Boolean;
6897     PixelsToRead, PixelCount: Integer;
6898   begin
6899     CacheSize := 0;
6900     CachePos  := 0;
6901
6902     TotalPixelsToRead := Header.Width * Header.Height;
6903     TotalPixelsRead   := 0;
6904     LinePixelsRead    := 0;
6905
6906     GetMem(Cache, CACHE_SIZE);
6907     try
6908       TmpData := ImageData + Counter.Y.low * LineSize;  //set line
6909       if (Counter.X.dir < 0) then                       //if x flipped then
6910         TmpData := TmpData + LineSize - PixelSize;      //set last pixel
6911
6912       repeat
6913         //read CommandByte
6914         CachedRead(Temp, 1);
6915         PixelRepeat  := (Temp and $80) > 0;
6916         PixelsToRead := (Temp and $7F) + 1;
6917         inc(TotalPixelsRead, PixelsToRead);
6918
6919         if PixelRepeat then
6920           CachedRead(buf[0], PixelSize);
6921         while (PixelsToRead > 0) do begin
6922           CheckLine;
6923           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6924           while (PixelCount > 0) do begin
6925             if not PixelRepeat then
6926               CachedRead(buf[0], PixelSize);
6927             PixelToBuffer(@buf[0], TmpData);
6928             inc(LinePixelsRead);
6929             dec(PixelsToRead);
6930             dec(PixelCount);
6931           end;
6932         end;
6933       until (TotalPixelsRead >= TotalPixelsToRead);
6934     finally
6935       FreeMem(Cache);
6936     end;
6937   end;
6938
6939   function IsGrayFormat: Boolean;
6940   begin
6941     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6942   end;
6943
6944 begin
6945   result := false;
6946
6947   // reading header to test file and set cursor back to begin
6948   StartPosition := aStream.Position;
6949   aStream.Read(Header{%H-}, SizeOf(Header));
6950
6951   // no colormapped files
6952   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6953     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6954   begin
6955     try
6956       if Header.ImageID <> 0 then       // skip image ID
6957         aStream.Position := aStream.Position + Header.ImageID;
6958
6959       case Header.Bpp of
6960          8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6961                0: tgaFormat := tfLuminance8;
6962                8: tgaFormat := tfAlpha8;
6963             end;
6964
6965         16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6966                0: tgaFormat := tfLuminance16;
6967                8: tgaFormat := tfLuminance8Alpha8;
6968             end else case (Header.ImageDesc and $F) of
6969                0: tgaFormat := tfBGR5;
6970                1: tgaFormat := tfBGR5A1;
6971                4: tgaFormat := tfBGRA4;
6972             end;
6973
6974         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6975                0: tgaFormat := tfBGR8;
6976             end;
6977
6978         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6979                2: tgaFormat := tfBGR10A2;
6980                8: tgaFormat := tfBGRA8;
6981             end;
6982       end;
6983
6984       if (tgaFormat = tfEmpty) then
6985         raise EglBitmapException.Create('LoadTga - unsupported format');
6986
6987       FormatDesc := TFormatDescriptor.Get(tgaFormat);
6988       PixelSize  := FormatDesc.GetSize(1, 1);
6989       LineSize   := FormatDesc.GetSize(Header.Width, 1);
6990
6991       GetMem(ImageData, LineSize * Header.Height);
6992       try
6993         //column direction
6994         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6995           Counter.X.low  := Header.Height-1;;
6996           Counter.X.high := 0;
6997           Counter.X.dir  := -1;
6998         end else begin
6999           Counter.X.low  := 0;
7000           Counter.X.high := Header.Height-1;
7001           Counter.X.dir  := 1;
7002         end;
7003
7004         // Row direction
7005         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7006           Counter.Y.low  := 0;
7007           Counter.Y.high := Header.Height-1;
7008           Counter.Y.dir  := 1;
7009         end else begin
7010           Counter.Y.low  := Header.Height-1;;
7011           Counter.Y.high := 0;
7012           Counter.Y.dir  := -1;
7013         end;
7014
7015         // Read Image
7016         case Header.ImageType of
7017           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7018             ReadUncompressed;
7019           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7020             ReadCompressed;
7021         end;
7022
7023         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7024         result := true;
7025       except
7026         FreeMem(ImageData);
7027         raise;
7028       end;
7029     finally
7030       aStream.Position := StartPosition;
7031     end;
7032   end
7033     else aStream.Position := StartPosition;
7034 end;
7035
7036 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7037 procedure TglBitmap.SaveTGA(const aStream: TStream);
7038 var
7039   Header: TTGAHeader;
7040   LineSize, Size, x, y: Integer;
7041   Pixel: TglBitmapPixelData;
7042   LineBuf, SourceData, DestData: PByte;
7043   SourceMD, DestMD: Pointer;
7044   FormatDesc: TFormatDescriptor;
7045   Converter: TFormatDescriptor;
7046 begin
7047   if not (ftTGA in FormatGetSupportedFiles(Format)) then
7048     raise EglBitmapUnsupportedFormat.Create(Format);
7049
7050   //prepare header
7051   FillChar(Header{%H-}, SizeOf(Header), 0);
7052
7053   //set ImageType
7054   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7055                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7056     Header.ImageType := TGA_UNCOMPRESSED_GRAY
7057   else
7058     Header.ImageType := TGA_UNCOMPRESSED_RGB;
7059
7060   //set BitsPerPixel
7061   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7062     Header.Bpp := 8
7063   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7064                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7065     Header.Bpp := 16
7066   else if (Format in [tfBGR8, tfRGB8]) then
7067     Header.Bpp := 24
7068   else
7069     Header.Bpp := 32;
7070
7071   //set AlphaBitCount
7072   case Format of
7073     tfRGB5A1, tfBGR5A1:
7074       Header.ImageDesc := 1 and $F;
7075     tfRGB10A2, tfBGR10A2:
7076       Header.ImageDesc := 2 and $F;
7077     tfRGBA4, tfBGRA4:
7078       Header.ImageDesc := 4 and $F;
7079     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7080       Header.ImageDesc := 8 and $F;
7081   end;
7082
7083   Header.Width     := Width;
7084   Header.Height    := Height;
7085   Header.ImageDesc := Header.ImageDesc or $20; //flip y
7086   aStream.Write(Header, SizeOf(Header));
7087
7088   // convert RGB(A) to BGR(A)
7089   Converter  := nil;
7090   FormatDesc := TFormatDescriptor.Get(Format);
7091   Size       := FormatDesc.GetSize(Dimension);
7092   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7093     if (FormatDesc.RGBInverted = tfEmpty) then
7094       raise EglBitmapException.Create('inverted RGB format is empty');
7095     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7096     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7097        (Converter.PixelSize <> FormatDesc.PixelSize) then
7098       raise EglBitmapException.Create('invalid inverted RGB format');
7099   end;
7100
7101   if Assigned(Converter) then begin
7102     LineSize := FormatDesc.GetSize(Width, 1);
7103     LineBuf  := GetMem(LineSize);
7104     SourceMD := FormatDesc.CreateMappingData;
7105     DestMD   := Converter.CreateMappingData;
7106     try
7107       SourceData := Data;
7108       for y := 0 to Height-1 do begin
7109         DestData := LineBuf;
7110         for x := 0 to Width-1 do begin
7111           FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7112           Converter.Map(Pixel, DestData, DestMD);
7113         end;
7114         aStream.Write(LineBuf^, LineSize);
7115       end;
7116     finally
7117       FreeMem(LineBuf);
7118       FormatDesc.FreeMappingData(SourceMD);
7119       FormatDesc.FreeMappingData(DestMD);
7120     end;
7121   end else
7122     aStream.Write(Data^, Size);
7123 end;
7124
7125 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7126 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7127 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7128 const
7129   DDS_MAGIC: Cardinal         = $20534444;
7130
7131   // DDS_header.dwFlags
7132   DDSD_CAPS                   = $00000001;
7133   DDSD_HEIGHT                 = $00000002;
7134   DDSD_WIDTH                  = $00000004;
7135   DDSD_PIXELFORMAT            = $00001000;
7136
7137   // DDS_header.sPixelFormat.dwFlags
7138   DDPF_ALPHAPIXELS            = $00000001;
7139   DDPF_ALPHA                  = $00000002;
7140   DDPF_FOURCC                 = $00000004;
7141   DDPF_RGB                    = $00000040;
7142   DDPF_LUMINANCE              = $00020000;
7143
7144   // DDS_header.sCaps.dwCaps1
7145   DDSCAPS_TEXTURE             = $00001000;
7146
7147   // DDS_header.sCaps.dwCaps2
7148   DDSCAPS2_CUBEMAP            = $00000200;
7149
7150   D3DFMT_DXT1                 = $31545844;
7151   D3DFMT_DXT3                 = $33545844;
7152   D3DFMT_DXT5                 = $35545844;
7153
7154 type
7155   TDDSPixelFormat = packed record
7156     dwSize: Cardinal;
7157     dwFlags: Cardinal;
7158     dwFourCC: Cardinal;
7159     dwRGBBitCount: Cardinal;
7160     dwRBitMask: Cardinal;
7161     dwGBitMask: Cardinal;
7162     dwBBitMask: Cardinal;
7163     dwABitMask: Cardinal;
7164   end;
7165
7166   TDDSCaps = packed record
7167     dwCaps1: Cardinal;
7168     dwCaps2: Cardinal;
7169     dwDDSX: Cardinal;
7170     dwReserved: Cardinal;
7171   end;
7172
7173   TDDSHeader = packed record
7174     dwSize: Cardinal;
7175     dwFlags: Cardinal;
7176     dwHeight: Cardinal;
7177     dwWidth: Cardinal;
7178     dwPitchOrLinearSize: Cardinal;
7179     dwDepth: Cardinal;
7180     dwMipMapCount: Cardinal;
7181     dwReserved: array[0..10] of Cardinal;
7182     PixelFormat: TDDSPixelFormat;
7183     Caps: TDDSCaps;
7184     dwReserved2: Cardinal;
7185   end;
7186
7187 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7188 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7189 var
7190   Header: TDDSHeader;
7191   Converter: TbmpBitfieldFormat;
7192
7193   function GetDDSFormat: TglBitmapFormat;
7194   var
7195     fd: TFormatDescriptor;
7196     i: Integer;
7197     Range: TglBitmapColorRec;
7198     match: Boolean;
7199   begin
7200     result := tfEmpty;
7201     with Header.PixelFormat do begin
7202       // Compresses
7203       if ((dwFlags and DDPF_FOURCC) > 0) then begin
7204         case Header.PixelFormat.dwFourCC of
7205           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7206           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7207           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7208         end;
7209       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7210
7211         //find matching format
7212         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7213           fd := TFormatDescriptor.Get(result);
7214           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7215              (8 * fd.PixelSize = dwRGBBitCount) then
7216             exit;
7217         end;
7218
7219         //find format with same Range
7220         Range.r := dwRBitMask;
7221         Range.g := dwGBitMask;
7222         Range.b := dwBBitMask;
7223         Range.a := dwABitMask;
7224         for i := 0 to 3 do begin
7225           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7226             Range.arr[i] := Range.arr[i] shr 1;
7227         end;
7228         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7229           fd := TFormatDescriptor.Get(result);
7230           match := true;
7231           for i := 0 to 3 do
7232             if (fd.Range.arr[i] <> Range.arr[i]) then begin
7233               match := false;
7234               break;
7235             end;
7236           if match then
7237             break;
7238         end;
7239
7240         //no format with same range found -> use default
7241         if (result = tfEmpty) then begin
7242           if (dwABitMask > 0) then
7243             result := tfBGRA8
7244           else
7245             result := tfBGR8;
7246         end;
7247
7248         Converter := TbmpBitfieldFormat.Create;
7249         Converter.RedMask   := dwRBitMask;
7250         Converter.GreenMask := dwGBitMask;
7251         Converter.BlueMask  := dwBBitMask;
7252         Converter.AlphaMask := dwABitMask;
7253         Converter.PixelSize := dwRGBBitCount / 8;
7254       end;
7255     end;
7256   end;
7257
7258 var
7259   StreamPos: Int64;
7260   x, y, LineSize, RowSize, Magic: Cardinal;
7261   NewImage, TmpData, RowData, SrcData: System.PByte;
7262   SourceMD, DestMD: Pointer;
7263   Pixel: TglBitmapPixelData;
7264   ddsFormat: TglBitmapFormat;
7265   FormatDesc: TFormatDescriptor;
7266
7267 begin
7268   result    := false;
7269   Converter := nil;
7270   StreamPos := aStream.Position;
7271
7272   // Magic
7273   aStream.Read(Magic{%H-}, sizeof(Magic));
7274   if (Magic <> DDS_MAGIC) then begin
7275     aStream.Position := StreamPos;
7276     exit;
7277   end;
7278
7279   //Header
7280   aStream.Read(Header{%H-}, sizeof(Header));
7281   if (Header.dwSize <> SizeOf(Header)) or
7282      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7283         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7284   begin
7285     aStream.Position := StreamPos;
7286     exit;
7287   end;
7288
7289   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7290     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7291
7292   ddsFormat := GetDDSFormat;
7293   try
7294     if (ddsFormat = tfEmpty) then
7295       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7296
7297     FormatDesc := TFormatDescriptor.Get(ddsFormat);
7298     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7299     GetMem(NewImage, Header.dwHeight * LineSize);
7300     try
7301       TmpData := NewImage;
7302
7303       //Converter needed
7304       if Assigned(Converter) then begin
7305         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7306         GetMem(RowData, RowSize);
7307         SourceMD := Converter.CreateMappingData;
7308         DestMD   := FormatDesc.CreateMappingData;
7309         try
7310           for y := 0 to Header.dwHeight-1 do begin
7311             TmpData := NewImage + y * LineSize;
7312             SrcData := RowData;
7313             aStream.Read(SrcData^, RowSize);
7314             for x := 0 to Header.dwWidth-1 do begin
7315               Converter.Unmap(SrcData, Pixel, SourceMD);
7316               glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7317               FormatDesc.Map(Pixel, TmpData, DestMD);
7318             end;
7319           end;
7320         finally
7321           Converter.FreeMappingData(SourceMD);
7322           FormatDesc.FreeMappingData(DestMD);
7323           FreeMem(RowData);
7324         end;
7325       end else
7326
7327       // Compressed
7328       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7329         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7330         for Y := 0 to Header.dwHeight-1 do begin
7331           aStream.Read(TmpData^, RowSize);
7332           Inc(TmpData, LineSize);
7333         end;
7334       end else
7335
7336       // Uncompressed
7337       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7338         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7339         for Y := 0 to Header.dwHeight-1 do begin
7340           aStream.Read(TmpData^, RowSize);
7341           Inc(TmpData, LineSize);
7342         end;
7343       end else
7344         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7345
7346       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7347       result := true;
7348     except
7349       FreeMem(NewImage);
7350       raise;
7351     end;
7352   finally
7353     FreeAndNil(Converter);
7354   end;
7355 end;
7356
7357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7358 procedure TglBitmap.SaveDDS(const aStream: TStream);
7359 var
7360   Header: TDDSHeader;
7361   FormatDesc: TFormatDescriptor;
7362 begin
7363   if not (ftDDS in FormatGetSupportedFiles(Format)) then
7364     raise EglBitmapUnsupportedFormat.Create(Format);
7365
7366   FormatDesc := TFormatDescriptor.Get(Format);
7367
7368   // Generell
7369   FillChar(Header{%H-}, SizeOf(Header), 0);
7370   Header.dwSize  := SizeOf(Header);
7371   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7372
7373   Header.dwWidth  := Max(1, Width);
7374   Header.dwHeight := Max(1, Height);
7375
7376   // Caps
7377   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7378
7379   // Pixelformat
7380   Header.PixelFormat.dwSize := sizeof(Header);
7381   if (FormatDesc.IsCompressed) then begin
7382     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7383     case Format of
7384       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7385       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7386       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7387     end;
7388   end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7389     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7390     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7391     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7392   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7393     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7394     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7395     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7396     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7397   end else begin
7398     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7399     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7400     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;
7401     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;
7402     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;
7403     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;
7404   end;
7405
7406   if (FormatDesc.HasAlpha) then
7407     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7408
7409   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7410   aStream.Write(Header, SizeOf(Header));
7411   aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7412 end;
7413
7414 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7415 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7416 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7417 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7418 begin
7419   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7420     result := fLines[aIndex]
7421   else
7422     result := nil;
7423 end;
7424
7425 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7426 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7427   const aWidth: Integer; const aHeight: Integer);
7428 var
7429   Idx, LineWidth: Integer;
7430 begin
7431   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7432
7433   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7434     (* TODO PixelFuncs
7435     fGetPixelFunc := GetPixel2DUnmap;
7436     fSetPixelFunc := SetPixel2DUnmap;
7437     *)
7438     // Assigning Data
7439     if Assigned(Data) then begin
7440       SetLength(fLines, GetHeight);
7441       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7442
7443       for Idx := 0 to GetHeight -1 do begin
7444         fLines[Idx] := Data;
7445         Inc(fLines[Idx], Idx * LineWidth);
7446       end;
7447     end
7448       else SetLength(fLines, 0);
7449   end else begin
7450     SetLength(fLines, 0);
7451     (*
7452     fSetPixelFunc := nil;
7453
7454     case Format of
7455       ifDXT1:
7456         fGetPixelFunc := GetPixel2DDXT1;
7457       ifDXT3:
7458         fGetPixelFunc := GetPixel2DDXT3;
7459       ifDXT5:
7460         fGetPixelFunc := GetPixel2DDXT5;
7461       else
7462         fGetPixelFunc := nil;
7463     end;
7464     *)
7465   end;
7466 end;
7467
7468 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7469 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7470 var
7471   FormatDesc: TFormatDescriptor;
7472 begin
7473   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7474
7475   FormatDesc := TFormatDescriptor.Get(Format);
7476   if FormatDesc.IsCompressed then begin
7477     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7478   end else if aBuildWithGlu then begin
7479     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7480       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7481   end else begin
7482     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7483       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7484   end;
7485
7486   // Freigeben
7487   if (FreeDataAfterGenTexture) then
7488     FreeData;
7489 end;
7490
7491 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7492 procedure TglBitmap2D.AfterConstruction;
7493 begin
7494   inherited;
7495   Target := GL_TEXTURE_2D;
7496 end;
7497
7498 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7499 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7500 var
7501   Temp: pByte;
7502   Size, w, h: Integer;
7503   FormatDesc: TFormatDescriptor;
7504 begin
7505   FormatDesc := TFormatDescriptor.Get(Format);
7506   if FormatDesc.IsCompressed then
7507     raise EglBitmapUnsupportedFormat.Create(Format);
7508
7509   w    := aRight  - aLeft;
7510   h    := aBottom - aTop;
7511   Size := FormatDesc.GetSize(w, h);
7512   GetMem(Temp, Size);
7513   try
7514     glPixelStorei(GL_PACK_ALIGNMENT, 1);
7515     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7516     SetDataPointer(Temp, Format, w, h);
7517     FlipVert;
7518   except
7519     FreeMem(Temp);
7520     raise;
7521   end;
7522 end;
7523
7524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7525 procedure TglBitmap2D.GetDataFromTexture;
7526 var
7527   Temp: PByte;
7528   TempWidth, TempHeight: Integer;
7529   TempIntFormat: Cardinal;
7530   IntFormat, f: TglBitmapFormat;
7531   FormatDesc: TFormatDescriptor;
7532 begin
7533   Bind;
7534
7535   // Request Data
7536   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);
7537   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);
7538   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7539
7540   IntFormat := tfEmpty;
7541   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7542     FormatDesc := TFormatDescriptor.Get(f);
7543     if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7544       IntFormat := FormatDesc.Format;
7545       break;
7546     end;
7547   end;
7548
7549   // Getting data from OpenGL
7550   FormatDesc := TFormatDescriptor.Get(IntFormat);
7551   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7552   try
7553     if FormatDesc.IsCompressed then
7554       glGetCompressedTexImage(Target, 0, Temp)
7555     else
7556      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7557     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7558   except
7559     FreeMem(Temp);
7560     raise;
7561   end;
7562 end;
7563
7564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7565 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7566 var
7567   BuildWithGlu, PotTex, TexRec: Boolean;
7568   TexSize: Integer;
7569 begin
7570   if Assigned(Data) then begin
7571     // Check Texture Size
7572     if (aTestTextureSize) then begin
7573       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7574
7575       if ((Height > TexSize) or (Width > TexSize)) then
7576         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7577
7578       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7579       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7580
7581       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7582         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7583     end;
7584
7585     CreateId;
7586     SetupParameters(BuildWithGlu);
7587     UploadData(Target, BuildWithGlu);
7588     glAreTexturesResident(1, @fID, @fIsResident);
7589   end;
7590 end;
7591
7592 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7593 function TglBitmap2D.FlipHorz: Boolean;
7594 var
7595   Col, Row: Integer;
7596   TempDestData, DestData, SourceData: PByte;
7597   ImgSize: Integer;
7598 begin
7599   result := inherited FlipHorz;
7600   if Assigned(Data) then begin
7601     SourceData := Data;
7602     ImgSize := Height * fRowSize;
7603     GetMem(DestData, ImgSize);
7604     try
7605       TempDestData := DestData;
7606       Dec(TempDestData, fRowSize + fPixelSize);
7607       for Row := 0 to Height -1 do begin
7608         Inc(TempDestData, fRowSize * 2);
7609         for Col := 0 to Width -1 do begin
7610           Move(SourceData^, TempDestData^, fPixelSize);
7611           Inc(SourceData, fPixelSize);
7612           Dec(TempDestData, fPixelSize);
7613         end;
7614       end;
7615       SetDataPointer(DestData, Format);
7616       result := true;
7617     except
7618       FreeMem(DestData);
7619       raise;
7620     end;
7621   end;
7622 end;
7623
7624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7625 function TglBitmap2D.FlipVert: Boolean;
7626 var
7627   Row: Integer;
7628   TempDestData, DestData, SourceData: PByte;
7629 begin
7630   result := inherited FlipVert;
7631   if Assigned(Data) then begin
7632     SourceData := Data;
7633     GetMem(DestData, Height * fRowSize);
7634     try
7635       TempDestData := DestData;
7636       Inc(TempDestData, Width * (Height -1) * fPixelSize);
7637       for Row := 0 to Height -1 do begin
7638         Move(SourceData^, TempDestData^, fRowSize);
7639         Dec(TempDestData, fRowSize);
7640         Inc(SourceData, fRowSize);
7641       end;
7642       SetDataPointer(DestData, Format);
7643       result := true;
7644     except
7645       FreeMem(DestData);
7646       raise;
7647     end;
7648   end;
7649 end;
7650
7651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7652 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7654 type
7655   TMatrixItem = record
7656     X, Y: Integer;
7657     W: Single;
7658   end;
7659
7660   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7661   TglBitmapToNormalMapRec = Record
7662     Scale: Single;
7663     Heights: array of Single;
7664     MatrixU : array of TMatrixItem;
7665     MatrixV : array of TMatrixItem;
7666   end;
7667
7668 const
7669   ONE_OVER_255 = 1 / 255;
7670
7671   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7672 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7673 var
7674   Val: Single;
7675 begin
7676   with FuncRec do begin
7677     Val :=
7678       Source.Data.r * LUMINANCE_WEIGHT_R +
7679       Source.Data.g * LUMINANCE_WEIGHT_G +
7680       Source.Data.b * LUMINANCE_WEIGHT_B;
7681     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7682   end;
7683 end;
7684
7685 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7686 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7687 begin
7688   with FuncRec do
7689     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7690 end;
7691
7692 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7693 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7694 type
7695   TVec = Array[0..2] of Single;
7696 var
7697   Idx: Integer;
7698   du, dv: Double;
7699   Len: Single;
7700   Vec: TVec;
7701
7702   function GetHeight(X, Y: Integer): Single;
7703   begin
7704     with FuncRec do begin
7705       X := Max(0, Min(Size.X -1, X));
7706       Y := Max(0, Min(Size.Y -1, Y));
7707       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7708     end;
7709   end;
7710
7711 begin
7712   with FuncRec do begin
7713     with PglBitmapToNormalMapRec(Args)^ do begin
7714       du := 0;
7715       for Idx := Low(MatrixU) to High(MatrixU) do
7716         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7717
7718       dv := 0;
7719       for Idx := Low(MatrixU) to High(MatrixU) do
7720         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7721
7722       Vec[0] := -du * Scale;
7723       Vec[1] := -dv * Scale;
7724       Vec[2] := 1;
7725     end;
7726
7727     // Normalize
7728     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7729     if Len <> 0 then begin
7730       Vec[0] := Vec[0] * Len;
7731       Vec[1] := Vec[1] * Len;
7732       Vec[2] := Vec[2] * Len;
7733     end;
7734
7735     // Farbe zuweisem
7736     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7737     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7738     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7739   end;
7740 end;
7741
7742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7743 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7744 var
7745   Rec: TglBitmapToNormalMapRec;
7746
7747   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7748   begin
7749     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7750       Matrix[Index].X := X;
7751       Matrix[Index].Y := Y;
7752       Matrix[Index].W := W;
7753     end;
7754   end;
7755
7756 begin
7757   if TFormatDescriptor.Get(Format).IsCompressed then
7758     raise EglBitmapUnsupportedFormat.Create(Format);
7759
7760   if aScale > 100 then
7761     Rec.Scale := 100
7762   else if aScale < -100 then
7763     Rec.Scale := -100
7764   else
7765     Rec.Scale := aScale;
7766
7767   SetLength(Rec.Heights, Width * Height);
7768   try
7769     case aFunc of
7770       nm4Samples: begin
7771         SetLength(Rec.MatrixU, 2);
7772         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);
7773         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);
7774
7775         SetLength(Rec.MatrixV, 2);
7776         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);
7777         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);
7778       end;
7779
7780       nmSobel: begin
7781         SetLength(Rec.MatrixU, 6);
7782         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);
7783         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);
7784         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7785         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);
7786         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);
7787         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);
7788
7789         SetLength(Rec.MatrixV, 6);
7790         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);
7791         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);
7792         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);
7793         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7794         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);
7795         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);
7796       end;
7797
7798       nm3x3: begin
7799         SetLength(Rec.MatrixU, 6);
7800         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);
7801         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);
7802         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7803         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);
7804         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);
7805         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);
7806
7807         SetLength(Rec.MatrixV, 6);
7808         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);
7809         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);
7810         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);
7811         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7812         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);
7813         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);
7814       end;
7815
7816       nm5x5: begin
7817         SetLength(Rec.MatrixU, 20);
7818         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);
7819         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);
7820         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);
7821         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);
7822         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);
7823         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);
7824         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);
7825         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);
7826         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);
7827         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);
7828         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);
7829         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);
7830         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7831         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);
7832         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);
7833         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);
7834         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7835         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7836         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);
7837         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);
7838
7839         SetLength(Rec.MatrixV, 20);
7840         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);
7841         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);
7842         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);
7843         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);
7844         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);
7845         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);
7846         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);
7847         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);
7848         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);
7849         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);
7850         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7851         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);
7852         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);
7853         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);
7854         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);
7855         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7856         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7857         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);
7858         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);
7859         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);
7860       end;
7861     end;
7862
7863     // Daten Sammeln
7864     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7865       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7866     else
7867       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7868     AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7869   finally
7870     SetLength(Rec.Heights, 0);
7871   end;
7872 end;
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882 (*
7883 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7884 var
7885   pTemp: pByte;
7886   Size: Integer;
7887 begin
7888   if Height > 1 then begin
7889     // extract first line of the data
7890     Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7891     GetMem(pTemp, Size);
7892
7893     Move(Data^, pTemp^, Size);
7894
7895     FreeMem(Data);
7896   end else
7897     pTemp := Data;
7898
7899   // set data pointer
7900   inherited SetDataPointer(pTemp, Format, Width);
7901
7902   if FormatIsUncompressed(Format) then begin
7903     fUnmapFunc := FormatGetUnMapFunc(Format);
7904     fGetPixelFunc := GetPixel1DUnmap;
7905   end;
7906 end;
7907
7908
7909 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7910 var
7911   pTemp: pByte;
7912 begin
7913   pTemp := Data;
7914   Inc(pTemp, Pos.X * fPixelSize);
7915
7916   fUnmapFunc(pTemp, Pixel);
7917 end;
7918
7919
7920 function TglBitmap1D.FlipHorz: Boolean;
7921 var
7922   Col: Integer;
7923   pTempDest, pDest, pSource: pByte;
7924 begin
7925   result := inherited FlipHorz;
7926
7927   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7928     pSource := Data;
7929
7930     GetMem(pDest, fRowSize);
7931     try
7932       pTempDest := pDest;
7933
7934       Inc(pTempDest, fRowSize);
7935       for Col := 0 to Width -1 do begin
7936         Move(pSource^, pTempDest^, fPixelSize);
7937
7938         Inc(pSource, fPixelSize);
7939         Dec(pTempDest, fPixelSize);
7940       end;
7941
7942       SetDataPointer(pDest, InternalFormat);
7943
7944       result := true;
7945     finally
7946       FreeMem(pDest);
7947     end;
7948   end;
7949 end;
7950
7951
7952 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7953 begin
7954   // Upload data
7955   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7956     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7957   else
7958
7959   // Upload data
7960   if BuildWithGlu then
7961     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7962   else
7963     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7964
7965   // Freigeben
7966   if (FreeDataAfterGenTexture) then
7967     FreeData;
7968 end;
7969
7970
7971 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7972 var
7973   BuildWithGlu, TexRec: Boolean;
7974   glFormat, glInternalFormat, glType: Cardinal;
7975   TexSize: Integer;
7976 begin
7977   if Assigned(Data) then begin
7978     // Check Texture Size
7979     if (TestTextureSize) then begin
7980       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7981
7982       if (Width > TexSize) then
7983         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7984
7985       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7986                 (Target = GL_TEXTURE_RECTANGLE_ARB);
7987
7988       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7989         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7990     end;
7991
7992     CreateId;
7993
7994     SetupParameters(BuildWithGlu);
7995     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7996
7997     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7998
7999     // Infos sammeln
8000     glAreTexturesResident(1, @fID, @fIsResident);
8001   end;
8002 end;
8003
8004
8005 procedure TglBitmap1D.AfterConstruction;
8006 begin
8007   inherited;
8008
8009   Target := GL_TEXTURE_1D;
8010 end;
8011
8012
8013 { TglBitmapCubeMap }
8014
8015 procedure TglBitmapCubeMap.AfterConstruction;
8016 begin
8017   inherited;
8018
8019   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8020     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8021
8022   SetWrap; // set all to GL_CLAMP_TO_EDGE
8023   Target := GL_TEXTURE_CUBE_MAP;
8024   fGenMode := GL_REFLECTION_MAP;
8025 end;
8026
8027
8028 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8029 begin
8030   inherited Bind (EnableTextureUnit);
8031
8032   if EnableTexCoordsGen then begin
8033     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8034     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8035     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8036     glEnable(GL_TEXTURE_GEN_S);
8037     glEnable(GL_TEXTURE_GEN_T);
8038     glEnable(GL_TEXTURE_GEN_R);
8039   end;
8040 end;
8041
8042
8043 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8044 var
8045   glFormat, glInternalFormat, glType: Cardinal;
8046   BuildWithGlu: Boolean;
8047   TexSize: Integer;
8048 begin
8049   // Check Texture Size
8050   if (TestTextureSize) then begin
8051     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8052
8053     if ((Height > TexSize) or (Width > TexSize)) then
8054       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8055
8056     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8057       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8058   end;
8059
8060   // create Texture
8061   if ID = 0 then begin
8062     CreateID;
8063     SetupParameters(BuildWithGlu);
8064   end;
8065
8066   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8067
8068   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8069 end;
8070
8071
8072 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8073 begin
8074   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8075 end;
8076
8077
8078 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8079   DisableTextureUnit: Boolean);
8080 begin
8081   inherited Unbind (DisableTextureUnit);
8082
8083   if DisableTexCoordsGen then begin
8084     glDisable(GL_TEXTURE_GEN_S);
8085     glDisable(GL_TEXTURE_GEN_T);
8086     glDisable(GL_TEXTURE_GEN_R);
8087   end;
8088 end;
8089
8090
8091 { TglBitmapNormalMap }
8092
8093 type
8094   TVec = Array[0..2] of Single;
8095   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8096
8097   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8098   TglBitmapNormalMapRec = record
8099     HalfSize : Integer;
8100     Func: TglBitmapNormalMapGetVectorFunc;
8101   end;
8102
8103
8104 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8105 begin
8106   Vec[0] := HalfSize;
8107   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8108   Vec[2] := - (Position.X + 0.5 - HalfSize);
8109 end;
8110
8111
8112 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8113 begin
8114   Vec[0] := - HalfSize;
8115   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8116   Vec[2] := Position.X + 0.5 - HalfSize;
8117 end;
8118
8119
8120 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8121 begin
8122   Vec[0] := Position.X + 0.5 - HalfSize;
8123   Vec[1] := HalfSize;
8124   Vec[2] := Position.Y + 0.5 - HalfSize;
8125 end;
8126
8127
8128 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8129 begin
8130   Vec[0] := Position.X + 0.5 - HalfSize;
8131   Vec[1] := - HalfSize;
8132   Vec[2] := - (Position.Y + 0.5 - HalfSize);
8133 end;
8134
8135
8136 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8137 begin
8138   Vec[0] := Position.X + 0.5 - HalfSize;
8139   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8140   Vec[2] := HalfSize;
8141 end;
8142
8143
8144 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8145 begin
8146   Vec[0] := - (Position.X + 0.5 - HalfSize);
8147   Vec[1] := - (Position.Y + 0.5 - HalfSize);
8148   Vec[2] := - HalfSize;
8149 end;
8150
8151
8152 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8153 var
8154   Vec : TVec;
8155   Len: Single;
8156 begin
8157   with FuncRec do begin
8158     with PglBitmapNormalMapRec (CustomData)^ do begin
8159       Func(Vec, Position, HalfSize);
8160
8161       // Normalize
8162       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8163       if Len <> 0 then begin
8164         Vec[0] := Vec[0] * Len;
8165         Vec[1] := Vec[1] * Len;
8166         Vec[2] := Vec[2] * Len;
8167       end;
8168
8169       // Scale Vector and AddVectro
8170       Vec[0] := Vec[0] * 0.5 + 0.5;
8171       Vec[1] := Vec[1] * 0.5 + 0.5;
8172       Vec[2] := Vec[2] * 0.5 + 0.5;
8173     end;
8174
8175     // Set Color
8176     Dest.Red   := Round(Vec[0] * 255);
8177     Dest.Green := Round(Vec[1] * 255);
8178     Dest.Blue  := Round(Vec[2] * 255);
8179   end;
8180 end;
8181
8182
8183 procedure TglBitmapNormalMap.AfterConstruction;
8184 begin
8185   inherited;
8186
8187   fGenMode := GL_NORMAL_MAP;
8188 end;
8189
8190
8191 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8192   TestTextureSize: Boolean);
8193 var
8194   Rec: TglBitmapNormalMapRec;
8195   SizeRec: TglBitmapPixelPosition;
8196 begin
8197   Rec.HalfSize := Size div 2;
8198
8199   FreeDataAfterGenTexture := false;
8200
8201   SizeRec.Fields := [ffX, ffY];
8202   SizeRec.X := Size;
8203   SizeRec.Y := Size;
8204
8205   // Positive X
8206   Rec.Func := glBitmapNormalMapPosX;
8207   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8208   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8209
8210   // Negative X
8211   Rec.Func := glBitmapNormalMapNegX;
8212   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8213   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8214
8215   // Positive Y
8216   Rec.Func := glBitmapNormalMapPosY;
8217   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8218   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8219
8220   // Negative Y
8221   Rec.Func := glBitmapNormalMapNegY;
8222   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8223   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8224
8225   // Positive Z
8226   Rec.Func := glBitmapNormalMapPosZ;
8227   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8228   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8229
8230   // Negative Z
8231   Rec.Func := glBitmapNormalMapNegZ;
8232   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8233   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8234 end;
8235 *)
8236
8237 initialization
8238   glBitmapSetDefaultFormat(tfEmpty);
8239   glBitmapSetDefaultMipmap(mmMipmap);
8240   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8241   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8242
8243   glBitmapSetDefaultFreeDataAfterGenTexture(true);
8244   glBitmapSetDefaultDeleteTextureOnFree    (true);
8245
8246   TFormatDescriptor.Init;
8247
8248 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8249   OpenGLInitialized := false;
8250   InitOpenGLCS := TCriticalSection.Create;
8251 {$ENDIF}
8252
8253 finalization
8254   TFormatDescriptor.Finalize;
8255
8256 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8257   FreeAndNil(InitOpenGLCS);
8258 {$ENDIF}
8259
8260 end.
8261